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