[comp.emacs] useful C functions

nz@hotlg.UUCP (02/02/87)

	Below is a copy of some Elisp code that I hacked out late last
	year, useful for the C programmer who uses GNU Emacs.  I hope
	that some of you GNUsers out there will find it useful.  Of
	course, it is given away free, no warranty, etc...
	The functions there are:

		top-of-defun-and-track : go to top of defuns, stack prior points
		end-of-defun-and-track : go to bot of defuns, stack prior points
		middle-of-defun :  pop stack, go back to middle of defuns 
		c-make-prolog   :  make (and maybe populate) a C comment block
		get-heading-text : prompt for text in window, return text string
	
	These functions were written, and work, under GNU Emacs 17.64.  
	I think they are portable, but you never can tell...
		

	Now for the small request: Could somebody at the Free Software
	Foundation please mail me a copy of the latest FSF order form?
	I have an old one, but I want to make sure I have the latest and
	most accurate version so that I can order v18 sans hassles.
	In case the heading of this posting gets mangled, my address
	is {ihnp4,allegra,genesis}!hotl[gd]!nz, or nz@hotld.ATT.
	Thanks.

============== cut here ================

;; Define some special C-mode functions 
;; Copyright (C) 1987 Neal Ziring and Richard M. Stallman. (?)

;; Permission is granted to anybody to do whatever they wish
;; with this software, provided that this notice is maintained.
;; This software is provided AS IS, under the same condition
;; as GNU Emacs itself.

;; This file is, in some ways, part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.

;; This file contains two blocks of Elisp functionality.

;; Part 1 is several function and declarations for C and Lisp mode
;; that allow the user to jump up and down by function definitions,
;; and then go back to where he was.  This is particularly useful
;; for jumping up to the top of a defun, fixing some declarations or
;; comments, then jumping back to the middle or end and continuing 
;; interrupted work there.  It is nice to define the three functions
;; as three mnemonic key sequences defined in the same way.  A trio
;; of key definitions is provided, but commented out.  If you like
;; the definitions there, just uncomment the code and use them, or
;; change them to whatever you like (the author uses three clustered
;; function keys, f6-f8 on an AT&T 4425 terminal).

;; Part 2 is several function and declarations for C mode, to help a
;; user put a comment block at the top of a routine.  The code in 
;; part 2 is newer than that in part 1, and is not polished.  For 
;; more information, see the comment block before the function 
;; c-make-prolog.

(defvar middle-of-defun-mark nil
  "list of marks left behind by top-of-defun and bottom-of-defun commands.")

(defun top-of-defun-and-track (cnt)
  "Move backward to next beginning defun, leave spot-mark behind.
With argument, do this that many times.
Return t unless search stops due to end of buffer."
  (interactive "p")
  (cond ((null cnt) (setq cnt 1)) ((eq cnt 0) (setq cnt 1)) (t t))
  (let ((herenow (point-marker)))
    (make-local-variable 'middle-of-defun-mark)
    (if (beginning-of-defun cnt) 
	(setq middle-of-defun-mark (cons herenow middle-of-defun-mark)))
))

(defun end-of-defun-and-track (cnt)
  "Move forward to next end of defun, leave spot-mark behind.
With argument, do this that several times.
Return t unless search stops due to end of buffer."
  (interactive "p")
  (cond ((null cnt) (setq cnt 1)) ((eq cnt 0) (setq cnt 1)) (t t))
  (let ((herenow (point-marker)))
    (make-local-variable 'middle-of-defun-mark)
    (end-of-defun cnt)
    (setq middle-of-defun-mark (cons herenow middle-of-defun-mark))
))

(defun middle-of-defun (arg)
  "Move back to last place where a ..defun-and-track was done.
If no defun and track was ever done, or if an argument is given,
then go to the exact center of the current defun."
  (interactive "P")
  (make-local-variable 'middle-of-defun-mark)
  (let (top1 bot1)
    (cond ((or (null middle-of-defun-mark) arg)
	   (cond  ((null (beginning-of-defun))
		   (end-of-defun 1)
		   (setq bot1 (point))
		   (beginning-of-defun 1)
		   (setq top1 (point)))
		  (t
		   (setq top1 (point))
		   (end-of-defun 1)
		   (setq bot1 (point)))
		  )
	   (goto-char (/ (+ top1 bot1) 2))
	   )
	  (t
	   (goto-char (car middle-of-defun-mark))
	   (set-marker (car middle-of-defun-mark) nil)
	   (setq middle-of-defun-mark (cdr middle-of-defun-mark))
	   )
	  )
    )
  )

;;(define-key ctl-x-map "N" 'top-of-defun-and-track)    ;; top =  C-X T
;;(define-key ctl-x-map "P" 'bottom-of-defun-and-track) ;; bottom =  C-X B
;;(define-key ctl-x-map "R" 'middle-of-defun)           ;; middle = C-X R
	
;; 

;; Make a Function comment block (specific to C, could be re-written for
;; other block-structured languages, or maybe Lisp)
;; The comment block structure given here is similar to that proposed
;; in "DACSII and DACS3 Software Standards", R. Luk, 1987.  
;;

(defvar c-prolog-headings-alist
  '( ("HISTORY" .  1)
     ("FUNCTION" . 1)
     ("INPUTS" . 1)
     ("OUTPUTS" . 1)
     ("RETURN CODES" . 1)
     ("GLOBALS USED" . 1)
     ("PROCEDURE" . nil)  
     ( "NOTES" . 1) )
  "*List of heading strings for a C module prolog, in order of appearance.
the structure of this list is dot-pairs, the first member being the name
of the section, the second being a flag.  If the flag is non-nil, then
c-make-prolog may ask for a value for that field.  If the flag is
explicitly t then c-make-prolog will always ask.  If the flag is nil,
then c-make-prolog will never ask.")

(defvar c-defun-start-last "^[a-zA-Z_].*("
  "*Regexp that matches the last line of the header of a function declaration")

(defvar c-defun-line-start "^[a-zA-Z_]" 
  "Regexp that matches lines preceding c-defun-start-last but which are
still part of the declaration header")

(defvar c-prolog-start "PROLOGUE" "*header word of a C prolog")
(defvar c-prolog-end   "ENDP"     "*trailer word of a C prolog")
(defvar c-prolog-end-marker "* ***" "marker bfor line before c-prolog-end")
(defvar get-heading-window-hgt 7
  "*maximum height for a c-prolog-entry Text Entry window")
(defvar c-prolog-first-at-point-min  t
  "*if non-nil, place prolog for first function at very top of file.
  Otherwise, first function gets its prolog just above declaration like
  all the other functions in the file.")

(defvar c-prolog-fill-column (- fill-column 12)
  "*maximum column for C prologues")

(defun c-make-prolog (arg)
  "Make up nice software development-type prologue for the
C routine near point.  If ARG is non-nil, then ask for various
parameters, each in its own buffer (see doc for c-prolog-headings-alist).
Note: this function has the side effect of putting its own buffer on the
entire screen.  Leaves point at top of C defun.  Leaves mark at prologue."
  (interactive "P")
  (let (prolog-top defun-top-rev-offset heading-prefix defun-decl
	preceeding-defun-top this-1st-defun  headings-text-temp defun-name
	headings-list-temp defun-decl-rev-offset prolog-temp)
    (setq heading-prefix " *   ")
    (save-excursion
      (end-of-defun 1)
      (beginning-of-defun 1)
      (if (eq (point) (point-min))
	(error "Cannot find a C function on which to base a Prologue.")
	(setq defun-top-rev-offset (- (point-max) (point))))
      (save-excursion
	(previous-line 1)
	(beginning-of-defun 1)
	(setq this-1st-defun (eq (point) (point-min))))
      (setq defun-name "")
      (if (null (re-search-backward c-defun-start-last (point-min) t))
	  (error "Cannot find the declaration for this function.")
	(save-excursion
	  (if (null (search-forward "(" (point-max) t))
	      (setq defun-name "")
	    (backward-char 1)
	    (set-mark (point))
	    (backward-sexp 1)
	    (copy-region-as-kill (point) (mark))
	    (setq defun-name (car kill-ring))
	    (setq kill-ring (cdr kill-ring)))))
      (let ( (foo-temp (point)))
	(search-forward "(")
	(backward-char 1)
	(forward-sexp 1)
	(set-mark (point))
	(goto-char foo-temp))
      (beginning-of-line 1)
      (while (looking-at c-defun-line-start)
	(previous-line 1))
      (next-line 1)
      (setq defun-decl-rev-offset (- (point-max) (point)))
      (copy-region-as-kill (point) (mark))
      (setq defun-decl (car kill-ring))
      (setq kill-ring  (cdr kill-ring))
      (if (and c-prolog-first-at-point-min this-1st-defun)
	  (goto-char (point-min))
	(open-line 1) (next-line 1))
      (open-line 2)
      (setq prolog-top (point))
      (insert comment-start "\n * " c-prolog-start "  " defun-name "\n *")
      (let ( (ndex (current-column)) (starline "") )
	(while (< ndex fill-column)
	  (setq starline (concat starline "*"))
	  (setq ndex (+ 1 ndex)))
	(insert starline "\n *\n *\n *" starline "\n *\n"))
      (previous-line 3)
      ;; okay, now we are in the middle of the banner header, ready
      ;; to put in the declaration header
      (insert heading-prefix defun-decl "\n")
      (setq prolog-temp (- (point) 1))
      ;; now do a primitive fill on the declaration 
      (backward-char (+ 1 (length defun-decl)))
      (end-of-line 1)
      (while (> prolog-temp (point))
	(delete-char 1)
	(insert " ")
	(end-of-line 1))
      (while (> (current-column) fill-column)
	(backward-char (- (current-column) fill-column))
	(backward-word 1)
	(insert "\n" heading-prefix "     ")
	(end-of-line 1))
      ;; now put in the various headers 
      (next-line 4)
      (setq headings-list-temp c-prolog-headings-alist)
      (while headings-list-temp
	(insert heading-prefix (car (car headings-list-temp)) "\n")
	(if (or (and (cdr (car headings-list-temp)) arg)
		(eq  (cdr (car headings-list-temp))  t ))
	    (progn
	      (setq headings-text-temp (get-heading-text
					(car (car headings-list-temp))))
	      (cond ((or
		      (null headings-text-temp)
		      (eq (length headings-text-temp) 0))
		     (message "ok, no entry for %s heading."
			      (car (car headings-list-temp)))
		     (insert " *\n"))
		    (t (insert headings-text-temp)
		       (narrow-to-region
			(- (point) (length headings-text-temp))
			(point))
		       (goto-char (point-min))
		       (replace-regexp "^"
				       (concat heading-prefix "      ")
				       nil)
		       (insert "\n")
		       (widen))))
	  (insert " *\n"))
	(setq headings-list-temp (cdr headings-list-temp)))
      (insert " *\n " c-prolog-end-marker
	      "\n * " c-prolog-end "  "  defun-name  "\n" comment-end "\n"))
    (set-mark prolog-top)
    (goto-char (- (point-max) defun-top-rev-offset))))



(defun text-entry-exit-ok ()
  "exit text entry with ok status"
  (interactive)
  (setq text-entry-exit t)
  (message "text entry ok.")
  (throw 'exit nil))

(defun text-entry-exit-abort ()
  "exit text entry with abort status"
  (interactive)
  (setq text-entry-exit nil)
  (message "text entry abort!")
  (throw 'exit nil))


(defun get-heading-text (name)
  "Get some text in a buffer, the name for the text is NAME.
Return the text actually entered, or nil."
  (save-excursion
    (let (old-buffer entry-buffer entry-buffer-name
		     entry-text entry-keymap entry-window)
      (setq old-buffer (current-buffer))
      (setq entry-buffer-name (concat "*" name "*"))
      (setq entry-buffer (create-file-buffer entry-buffer-name))
      (pop-to-buffer entry-buffer)
      (setq entry-window (get-buffer-window entry-buffer))
      (if (> (window-height entry-window) get-heading-window-hgt)
	  (shrink-window (- (window-height entry-window)
			    get-heading-window-hgt))
	(enlarge-window (- get-heading-window-hgt
			   (window-height entry-window))))
      (text-mode)
      (set-minor-mode 'foo "Entry" t)
      (setq fill-column c-prolog-fill-column)
      (auto-fill-mode fill-column)
      (setq text-entry-exit t)
      (define-key text-mode-map "\^c\^s" 'text-entry-exit-ok)
      (define-key text-mode-map "\^c\^c" 'text-entry-exit-abort)
      (use-local-map text-mode-map)
      (message
       "Enter text for %s, type  C-c C-s  to exit, C-c C-c  to abort." name)
      (recursive-edit)
      (if (or (null text-entry-exit) (equal (point-min) (point-max)))
	  (setq entry-text nil)
	(mark-whole-buffer)
	(exchange-dot-and-mark)
	(backward-char 1)
	(if (looking-at "\n")
	    (forward-char 1)
	  (forward-char 1) (insert "\n"))
	(copy-region-as-kill (point) (mark))
	(setq entry-text (car kill-ring))
	(setq kill-ring (cdr kill-ring)))
      (pop-to-buffer old-buffer)
      (kill-buffer entry-buffer)
      (delete-other-windows)
      entry-text)))
    
============= also cut here, because Inews will append .signature =======
 
-- 
...nz  (Neal Ziring  @  ATT-BL Holmdel, x2354, 3H-437)
	"You can fit an infinite number of wires into this junction box,
	but we usually don't go that far in practice."
					London Electric Co. Worker, 1880s