;;; Coding-standards assistance from emacs. ;;; $Id: devhelp.el,v 1.14 1996/12/11 11:06:07 waider Exp $ ;;; ; $Log: devhelp.el,v $ ; Revision 1.14 1996/12/11 11:06:07 waider ; * Fixed some other functions that depended on the old ; C-func-regexp. It's now C-funcname-regexp. ; ; Revision 1.13 1996/12/11 11:03:00 waider ; * fixed insert-function-name and renamed it with a devhelp- prefix ; ; Revision 1.12 1996/12/10 11:00:01 waider ; * Function header update prompts for description if none exists. ; * Fixed bug introduced to function header update by previous hacking. ; ; Revision 1.11 1996/12/10 10:28:14 waider ; * Made file-header-update more robust, although it now depends on the ; CAUTIONS: field following the FUNCTIONS DEFINED: field. ; ; Revision 1.10 1996/12/09 16:40:18 waider ; * Changed all occurences of datagen to devhelp. ; * Made function-finding a little better. ; ; Revision 1.9 1996/12/09 15:58:53 waider ; * No idea what changed, if anything. I've lost track! ; ; Revision 1.8 1996/08/15 12:30:55 waider ; Fixed C indentation. Added devhelp-check-lines. ; ; Revision 1.7 1996/08/14 12:53:04 waider ; Function headers cope better with existing function headers. Did ; some work on file headers also. ; ; Revision 1.6 1996/08/13 16:53:07 waider ; Function headers now working. See caveats on ; devhelp-function-header-update. ; ; Revision 1.5 1996/08/13 11:47:26 waider ; Block comment insert works. Reordered revision history. Renamed some ; bits. ; ; Revision 1.4 1996/08/08 10:51:09 waider ; Source file header now works (mostly) for new files ; ; Revision 1.3 1996/08/08 10:12:06 waider ; Changed template directory name. Maybe I should leave it at nil ; ; Revision 1.2 1996/08/08 10:00:47 waider ; Renamed ; ;;; Dec 95 More comment tweaking - now uses indent-rigidly rather than a ;;; series of (forward-line)(c-indent-line). ;;; Nov 95 Set up a hacked version of c-mode which does the right thing with ;;; comment indenting. Transferred loadup stuff to it. ;;; Added function to figure out the name of the current project ;;; Added sccs history hacker ;;; Oct 95 Add some random coding standards-related functions ;;; Hacked some more of the comment stuff ;;; Sep 95 Initial attempt derived from prepress.el ;;; Dispensed with TAGS method of doing file headers ;;; Modified header formats ;;; Started: Waider, Sept. 95 ;;; based on prepress.el by Johnathan Vail from 1995. ;;; which was based on some other stuff by Constantine Rasmussen from 1987. ;;; ;;; BUGS (as listed by JV & CR) ;;; ;;; * Macros and parenthesis in comments sometimes look like C functions ;;; ;;; * forward-list and backward-list assume that we ;;; are in C mode to properly move around `{' and `}' ;;; ;;; Waider's bugs: ;;; ;;; COMMENTS ;;; * Inserting a block comment into an existing comment shouldn't work ;;; * filling doesn't work fully - specifically ESC-q on a block comment ;;; * need a comment 'mode' of some sort ;;; * should have a convert-block-comment function ;;; ;;; HEADERS ;;; * Could do more auto-filling in headers ;;; * revision-history function ;;; * header update should fix copyright if it can ;;; ;;; INDENTING ;;; * continued-line indent within parens isn't fixed yet ;;; (require 'compile) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Define some constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; These guys are used to generate file headers. They could be made ;;; better, since currently they get faked out by things like macro ;;; definitions and prototypes. ;;; (defconst C-funcname-regexp "[a-zA-Z_][a-zA-Z0-9_]+\\([ \t\n]*\(\\)" "Used to look for a C function's name") (defconst C-func-regexp "^[ \t\n]*[a-zA-Z_][a-zA-Z0-9*_ \t\n]*\(\\(.*\\)\)[^;{]{" "Used to look for a C function definition") (defconst C-func-definition-regexp "^[ \t\n]*[a-zA-Z_][a-zA-Z0-9*_ \t\n]*\(\\(\\([ \t\n]*\\)[^)]*\\)\)[^{]*" "Used to parse the formal paramaters of a C function") (defvar devhelp-templates-dir "/dev/templates/" "Directory where templates are stored") (defconst callback-caution "Function parameters and type are standard for an X callback. DO NOT CHANGE THE NUMBER OF PARAMETERS OR GIVE THE FUNCTION A TYPE." "Standard caution for an X callback function") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; This defines the things that look like functions but really aren't as ;;; well as the functions that we don't want to see listed. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar devhelp-null-functions (quote ("if" "while" "return" "for" "switch" "sizeof" ;; Here are the functions that we don't want to know about: ;; Mostly these are library I/O functions "printf" "sprintf" "strlen" "putchar" "putc" )) "*List of functions that should not be on list of functions used" ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Hook function called when we start up C mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c-mode-devhelp-stuff() "Hook function to do devhelp things to a source file" (and (= (buffer-size) 0) (devhelp-document-header t)) ;; Key mapping (local-set-key "\C-c\C-f" 'devhelp-function-header-update) (local-set-key "\C-c\C-h" 'devhelp-document-header) (local-set-key "\C-c\C-c" 'devhelp-insert-comment) (local-set-key "\C-c\C-u" 'devhelp-file-header-update) (local-set-key "\C-c\C-i" 'devhelp-insert-function-name) (local-set-key "\C-c\C-x" 'insert-callback-caution) ;; This is to make dabbrev expand replace tags-expand (local-set-key "\e\C-i" 'dabbrev-expand) ;; Compiler stuff (make-local-variable 'compile-command) (let ((proj (current-project))) (if proj (setq compile-command (concat "dex " proj " make -k")) (message "Can't figure out what project you're working on"))) ;; Stuff (setq fill-column 77) (c-add-style "waider" '((c-basic-offset . 4) (c-comment-only-line-offset . (0 . 0)) (c-offsets-alist . ((statement-block-intro . +) (knr-argdecl-intro . 4) (substatement-open . 0) (label . 0) (statement-case-open . +) (statement-cont . +) (arglist-intro . c-lineup-arglist-intro-after-paren) (arglist-close . c-lineup-arglist) ))) t) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Insert a block comment. Leaves cursor ready to add comment text. ;;; Complains if you've too many levels of indent as defined in coding std. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun devhelp-insert-comment() "Add a comment" (interactive) (beginning-of-line) (save-excursion (insert-file (concat devhelp-templates-dir "cmt1"))) ;; Indent the comment template (save-excursion (c-indent-line) (forward-line 1) (c-indent-line) (forward-line 1) (c-indent-line)) ;; Now we need to trim the comment start/end lines (let ((beg)) (beginning-of-line) (setq beg (point)) (skip-chars-forward " \t") (if (= (current-column) 0) ; Level -1 indent (progn (end-of-line) (insert "****") (forward-line 2) (end-of-line) (forward-char -1) (insert "****")) ;; ELSE (if (= (current-column) 4) ; Level 0 indent () (if (< (current-column) 75) ; All other indents (progn (forward-char (- 75 (current-column))) (kill-line) (forward-line 2) (beginning-of-line) (skip-chars-forward " \t") (forward-char (- 75 (current-column))) (kill-line) (delete-char -1) (insert "/")) ;; ELSE (error "Too many levels of indent!")))) (goto-char beg)) (forward-line 1) ; Puts the cursor in the right place (end-of-line) (insert " ") ; vi compatibility... (end-of-line)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; This function inserts at point all of the functions that are used in ;;; the following C function. Each function is listed on a separate line ;;; with a `*' on the left. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun list-functions-used () "Generate a list of C functions used in the current function" (interactive) (let (function-list) (save-excursion (save-restriction (skip-chars-forward "^{") (beginning-of-line) (forward-list) (let ((end (point))) (backward-list) (narrow-to-region (point) end) (setq function-list (find-C-functions))))) (insert-functions-used function-list))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; This guy does the work of actually doing the inserting ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun insert-functions-used (functions) (cond ((null functions) nil) (t (insert-starred-lines (car functions)) (insert-functions-used (cdr functions))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Return a list of functions used, sorted alphabetically and ignoring ;;; most library functions. ;;; ;;; 22 Jun 1989 JV - made iterative ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun find-C-functions () (let (functions) (setq functions nil) (while (re-search-forward C-funcname-regexp nil t) (setq functions (sort-add-to-list (buffer-substring (match-beginning 0) (match-beginning 1)) functions))) functions)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Add to the list, insertion sort ;;; ;;; 16 May 1990 JV - OK, split it into two for efficiency, ;;; also check to make sure that the thing we think ;;; we want to add is not in a comment or a string. ;;; ;;; If the thing is on our *hit list then don't add it ;;; If list is empty then return a list of thing ;;; If the thing is already in list then don't add it again ;;; If thing comes before whats at the beginning of the list then add thing ;;; otherwise cdr down the list... ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun sort-add-to-list (thing list) (cond ((string-memberp thing devhelp-null-functions) list) ;; if we are in a comment or string then do not add thing ((let (state func-point) (save-excursion (setq func-point (point)) (beginning-of-defun) (setq state (parse-partial-sexp (point) func-point 0)) (or (nth 3 state) (nth 4 state)))) list) ;; yes, we actually want to insert it (t (insert-to-list thing list)))) (defun insert-to-list (thing list) (cond ((null list) (cons thing nil)) ((string-equal thing (car list)) list) ((string-lessp thing (car list)) (cons thing list)) (t (cons (car list) (insert-to-list thing (cdr list)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; I couldn't find a member function for strings anywhere else... ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun string-memberp (thing list) (cond ((null list) nil) ((string-equal thing (car list)) t) (t (string-memberp thing (cdr list))))) ;; -------------------- end of list-functions-used --------------------------- ;; -------------------- stuff to play with function headers ------------------ ;; ;; Take a string and insert the lines in the string as a header comment, ;; with a star on the left margin and a single tab before the text. ;; (defun insert-starred-lines (text) (let ((fill-prefix "* ")) (cond ((string-equal text "") "* \n") ((string-match "[ \t\n]*\\(.*\\)\n" text) (insert (format "* %s\n" (substring text (match-beginning 1) (match-end 1)))) (insert-starred-lines (substring text (match-end 0) nil))) (t (string-match (purecopy "[ \t]*\\(.*\\)$") text) (insert (format "* %s\n" (substring text (match-beginning 1) (match-end 1)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; FUNCTION NAME: devhelp-function-header-update ;;; ;;; INPUTS/OUTPUTS: ;;; ;;; None. ;;; ;;; VALUE RETURNED: ;;; ;;; None. ;;; ;;; DESCRIPTION: ;;; ;;; Update the details in the function header for the next available ;;; function. ;;; ;;; CAUTIONS: ;;; ;;; (1) Can't cope with brackets embedded in the parameter list. ;;; (2) Needs to be more cautious about replacing strings, esp. retcode ;;; (3) Should replace existing header if it doesn't conform. ;;; (4) Should fill the INPUTS/OUTPUTS block. ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun devhelp-function-header-update() "Insert or update a function header." (interactive) (save-excursion (let (definition name input value fnstart vvalue) ;; First, see if we've got a function header: (beginning-of-line) (if (re-search-forward C-func-definition-regexp nil t) () (error "No function found to document, try backing up a little.")) ;; We have a function definition. Process it into useful bits (setq definition (buffer-substring (match-beginning 0) (match-end 0))) (setq input (buffer-substring (match-beginning 1) (match-end 1))) (if (string-match "^[ \t\n]*void[ \t\n]*$\\|^[ \t\n]*$" input) (setq input "None.")) (if (string-match C-funcname-regexp definition) (setq name (substring definition (match-beginning 0) (match-beginning 1)))) (setq value (substring definition 0 (match-beginning 0))) (if (string-match "\\([a-zA-Z0-9_]+\\)" value) (setq vvalue (substring value (match-beginning 1) (match-end 1))) (error "Function has no explicit type!")) (if (string-equal vvalue "void") (setq value "None.")) (if (or (string-equal vvalue "static") (string-equal vvalue "extern")) (setq value (substring value (match-end 1)))) ;; Backup & save the start of function point - doesn't work on ;; functions which take functions as parameters. (re-search-backward C-func-definition-regexp nil t) (setq fnstart (point)) ;; Now we search backwards for the end of the preceding function. ;; This doesn't check that you've a "}" in your comments. FIXME (if (re-search-backward "}" (point-min) t) (forward-char 1) (goto-char (point-min))) (narrow-to-region (point) fnstart) ;; See if there's *any* comments here, then search for the ;; headers in the order we expect to find them. (goto-char (point-min)) (save-excursion (if (and (re-search-forward "/\\*" (point-max) t) (search-forward "FUNCTION NAME:" (point-max) t) (search-forward "INPUTS/OUTPUTS:" (point-max) t) (search-forward "VALUE RETURNED:" (point-max) t) (search-forward "DESCRIPTION:" (point-max) t)) (message "Found existing header, trying to update") ;; No header, let's add one. preserves existing header. (progn (goto-char (point-max)) (insert-file (concat devhelp-templates-dir "func")) (goto-char (point-min))))) ;; Update the header with the info we got at the top of the function (if (search-forward "FUNCTION NAME:" nil t) (let ((beg (point))) (end-of-line) (delete-region beg (point)) (insert (concat " " name))) (progn (widen) (error "Can't find FUNCTION NAME:"))) (if (search-forward "INPUTS/OUTPUTS:" nil t) (progn (forward-line 1) (beginning-of-line) (let ((beg (point))) (if (search-forward "VALUE RETURNED:" nil t) (progn (forward-line -1) (end-of-line) (delete-region beg (point)) (insert "* \n") (insert-starred-lines (concat input )) (insert "* ")) (progn (error "Can't find VALUE RETURNED:") (widen))))) (progn (widen) (error "Can't find INPUTS/OUTPUTS:"))) (if (search-forward "VALUE RETURNED:" nil t) (progn (forward-line 1) (beginning-of-line) (let ((beg (point))) (if (search-forward "DESCRIPTION:") (progn (forward-line -1) (end-of-line) (delete-region beg (point)) (insert "* \n") (insert-starred-lines (concat value)) (insert "* ")) (progn (widen) (error "Can't find DESCRIPTION:"))))) (progn (widen) (error "Can't find VALUE RETURNED:"))) (if (search-forward "DESCRIPTION:" nil t) (progn (forward-line 1) (beginning-of-line) (let ((beg (point))) (if (search-forward "CAUTIONS:" nil t) (progn (forward-line -1) (end-of-line) (let ((end (point))) (goto-char beg) (if (re-search-forward "[^ \r\n*]" end t) () ;; fine, there's a description (let ((desc (read-string (concat "Enter a short description for " name "(): ")))) (or (string-equal desc "") (progn (delete-region beg end) (goto-char beg) (insert "* \n") (insert-starred-lines desc) (insert "* "))) )))) (widen) (error "Can't find CAUTIONS:")))) (widen) (error "Can't find DESCRIPTION:")) ;; Finally, open out the area again. (widen) ) ;; let ) ;; save-excursion ) ;; defun ;; ------------------ End of function header stuff --------------------------- ;; ------------------------- file headers ------------------------------------ ;; ;; 21 Jun 1989 JV - Created ;; (defun devhelp-document-header (&optional new) "Create a new file header in Devhelp format and fill out as many fields as we can" (interactive) (save-excursion (let (name funcs) (setq name (file-name-nondirectory buffer-file-name)) (setq funcs (devhelp-find-functions)) (devhelp-new-header new name (cdr funcs) (car funcs))))) (defun devhelp-get-history () "Get a list of programmers and a creation date from the sccs history for this file. Defaults to my username and today's date" (interactive) (if (and (current-project) (buffer-file-name)) ;; Set up local variables (let ((prog-list nil) (buf-name (buffer-file-name)) (old-buf (current-buffer)) (prog-str nil) (create-date nil) (creator nil)) (set-buffer (get-buffer-create "*devhelp-shell*")) (erase-buffer) ;; Run the SCCS command (shell-command (concat "dex " (current-project) " sccs prs " (file-name-nondirectory buf-name)) t) ;; Parse the buffer (goto-char (point-min)) (while (re-search-forward "^D " nil t) (progn (skip-chars-forward "0-9 \t./:") ; skip version, date, time (let ((beg (point))) (skip-chars-forward "a-zA-Z") (let ((newname (buffer-substring beg (point)))) (and (not (member newname prog-list)) (progn (setq prog-list (append (list newname) prog-list)) (and prog-str (setq prog-str (concat ", " prog-str))) (setq prog-str (concat (real-name newname) prog-str)) ) ) ) ) ) ) ; end-while ; Add me to the list (let ((newname (user-real-login-name))) (and (not (member newname prog-list)) (progn (setq prog-list (append (list newname) prog-list)) (and prog-str (setq prog-str (concat prog-str ", "))) (setq prog-str (concat prog-str (real-name newname)))))) ;; prog-str contains a comma-separated list of names ;; prog-list contains the usernames ;; Next, we need the creation date and author (goto-char (point-min)) (if (re-search-forward "^date and time created ") (progn (save-excursion (end-of-line) (let ((beg (point))) (goto-char (point-max)) (delete-region beg (point)))) (looking-at "[0-9]") (let ((tmp-str (buffer-substring (point) (point-max)))) (setq create-date (concat (substring tmp-str 6 8) "/" (substring tmp-str 3 5) "/" (substring tmp-str 0 2))) (setq creator (substring tmp-str 21))))) ;; Now go play with the header! (set-buffer old-buf) (save-excursion (goto-char (point-min)) (and (re-search-forward "PROGRAMMER(S)[ ]*:[ ]*" nil t) (progn (or (looking-at "[ ]*$") (kill-line)) (insert prog-str))) (and (re-search-forward "DATE[ ]*CREATED[ ]*:[ ]*" nil t) (progn (or (looking-at "[ ]*$") (kill-line)) (if create-date (insert create-date) (progn (shell-command "date +%d/%m/%y" t) (end-of-line) (delete-char 1))))) (and (re-search-forward "Date[ ]*Person" nil t) (progn (forward-line 2) (beginning-of-line) (let ((beg (point))) (skip-chars-forward "\\* \t") (delete-region beg (point))) (insert "* ") (and (looking-at "$") (insert (concat create-date " " (or creator (user-real-login-name)) " Created\n* ")))))) (message "") ))) (defun devhelp-file-header-update () "Update the Functions Defined: field in a file header" (interactive) (save-excursion (beginning-of-buffer) (let (name funcs start) (setq name (file-name-nondirectory buffer-file-name)) (setq funcs (devhelp-find-functions)) (goto-char 0) (re-search-forward "^\\* FUNCTIONS DEFINED:") (forward-line) (beginning-of-line) (setq start (point)) ; start of functions region ;; search for the next header (if (re-search-forward "^\\* CAUTIONS:") (progn (beginning-of-line) (delete-region start (point)) (devhelp-insert-functions (cdr funcs) (car funcs))) (error "No end of header found"))))) ;; ;; This function, if called by M-x inserts a mostly blank header ;; If called from another function the fields are properly filled ;; in. It inserts at the current point. ;; ;; 21 Jun 1989 JV - Create ;; (defun devhelp-new-header (&optional new name global local) "Insert a header for a new C module in Devhelp format" (interactive) ;; Get the file type (let ((ftype "") (ftypes nil) (fdefault "source")) ;; Set up list of file types (setq ftypes (cons (list "source") ftypes)) (setq ftypes (cons (list "header") ftypes)) (setq ftypes (cons (list "multifunction") ftypes)) (setq ftypes (cons (list "data") ftypes)) ;; make a guess at file type for default (and (string-match "\\.h$" buffer-file-name) (setq fdefault "header")) ;; Ask for file type (make-local-variable 'completion-ignore-case) (setq completion-ignore-case t) (while (string-equal "" ftype) (setq ftype (completing-read "Enter file type for this file: " ftypes nil 0 fdefault))) ;; Load the appropriate file (beginning-of-buffer) (cond ((string-equal ftype "source") (insert-file (concat devhelp-templates-dir "src_file"))) ((string-equal ftype "header") (insert-file (concat devhelp-templates-dir "hdr_file"))) ((string-equal ftype "multifunction") (insert-file (concat devhelp-templates-dir "multi_file"))) ((string-equal ftype "data") (insert-file (concat devhelp-templates-dir "data_file"))) (t (progn (insert (concat "/* Unknown file type " ftype " */\n")) (insert-file (concat devhelp-templates-dir "src_file"))))) (if new (progn (search-forward "User full name") (replace-match (user-full-name)) (search-forward "--/--/--") (replace-match "") (insert (devhelp-datestamp))) ;; ELSE (devhelp-get-history)) ;; Add in functions defined in this file (if (string-equal ftype "header") (let ((ifdef-name)) (string-match "\\([^/\\.]*\\)\\.\\(.*\\)$" buffer-file-name) (setq ifdef-name (upcase (concat (substring buffer-file-name (match-beginning 1) (match-end 1)) "_" (substring buffer-file-name (match-beginning 2) (match-end 2))))) ;; (beginning-of-buffer) (search-forward "ifndef" (point-max) t) (insert " " ifdef-name) (search-forward "define" (point-max) t) (insert " " ifdef-name) (search-forward "endif" (point-max) t) (insert " /* " ifdef-name " */ ") (beginning-of-line) (let ((beg)) (setq beg (point)) (end-of-line) (kill-region beg (point)) (end-of-buffer) (yank))) ;; ELSE (and (or (string-equal ftype "source") (string-equal ftype "multifunction")) (let ((beg)) (search-forward "FUNCTION") (forward-line) (setq beg (point)) (re-search-forward "^\\*[ \t]+DESCRIPTION") (forward-line -1) (delete-region beg (point)) (devhelp-insert-functions global local)))))) (defun devhelp-insert-functions (global local) "Insert at point the global and local functions" (if (null global) () (insert "* \n") (insert-starred-lines "GLOBAL FUNCTIONS") (insert "* \n") (insert-functions-used global) (insert "* \n")) (if (null local) () (insert-starred-lines "LOCAL FUNCTIONS") (insert "* \n") (insert-functions-used local) (insert "* \n"))) ;; ------------------------------- utilities ---------------------------------- ;;; ;;; NOTE: If you want, hack THIS function to taste, since other ;;; Devhelp utilities will depend on this. ;;; (defun devhelp-datestamp () "Return the current datestamp, Devhelp format" (concat (devhelp-date (current-time-string)) " " (initials-only (strip-aux-GCOS-info (user-full-name))) "\t- " )) (defun strip-aux-GCOS-info (fullname) (substring fullname 0 (string-match " *[-:]" fullname))) (defun initials-only (fullname) (cond ((string-equal fullname "") "") (t (concat (substring fullname 0 1) (initials-only (substring fullname (next-word fullname) nil)))))) (defun next-word (string) (string-match "[^ ]* *" string) (match-end 0)) (defun devhelp-date (time) "Returns date string in the format of 3 Jan 89" (concat (substring time 8 11) (substring time 4 8) (substring time -2 nil))) (defun devhelp-datestamp () "Today's date in DD/MM/YY format. emacs 19.x only?" (let* ((datelist (decode-time (current-time))) (sec (nth 0 datelist)) (min (nth 1 datelist)) (hour (nth 2 datelist)) (day (nth 3 datelist)) (mon (nth 4 datelist)) (year (nth 5 datelist))) (format "%02d/%02d/%02d" day mon year))) (defun find-function-call() (interactive) (re-search-forward C-funcname-regexp nil t) (narrow-to-region (match-beginning 0) (match-end 0))) (defun reequals() "redo equals signs" (interactive) (message "Not working!") ;; (replace-regexp "^\\(\\([ ]*[^ \n=]+\\)\\)+[ ]*=\\(=\\)*[ ]*" ;; "\\1 =\\2 ") ) (defun rebracket() "redo brackets" (interactive) (replace-regexp "\\((\\)+[ ]*\\([ ]*[^) ]+\\)+[ ]*)" "\\1 \\2 )" nil)) (defun close-bracket() "close bracket" (interactive) (insert ")") (beginning-of-line) (rebracket)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Insert at point the name of the function we're sitting in. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun devhelp-insert-function-name() "Insert the name of this function" (interactive) (let (( mydefn )) (if (save-excursion (beginning-of-defun) (re-search-backward C-func-definition-regexp nil t)) (progn (setq mydefn (buffer-substring (match-beginning 0) (match-end 0))) (and (string-match C-funcname-regexp mydefn) (insert (substring mydefn (match-beginning 0) (match-beginning 1))))) ;; ELSE (error "Not in a function!")))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Motorola relic ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun current-project() "Return as a string the current Devhelp project name" (if (string-match "^.*/dev/\\([^/]+\\)/compile" default-directory) (substring default-directory (match-beginning 1) (match-end 1)) nil)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; devhelp-find-functions - non-tags version ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun devhelp-find-functions () (let (local global func-name) (setq local nil global nil) (while (re-search-forward C-func-regexp nil t) (setq func-name (buffer-substring (match-beginning 0) (+ 1 (match-end 1)))) (if (string-match "^[ \r\t\n]+" func-name) (setq func-name (substring func-name (match-end 0)))) (if (not (string-match "^extern[ \r\t\n]+" func-name)) (if (string-match "^static[ \r\t\n]+" func-name) (setq local (sort-add-to-list func-name local)) (setq global (sort-add-to-list func-name global)))) (end-of-defun)) (cons local global))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; convert a username into a real name ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun real-name (username) "Return a real name corresponding to USERNAME" ;; Should really ask yellow pages or similar, but who gives a monkeys? (cond ((string-equal username "waider") "Ronan Waide") (t username) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Look for lines that are too long. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun devhelp-check-lines() "Check line length wraps at 77 chars." (interactive) (let ((here (point))) (goto-char (point-min)) (while (= 0 (forward-line)) (end-of-line) (if (> (current-column) 78) (error "Line too long."))) (goto-char here))) ;; We're done, provide the package (provide 'devhelp)