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