home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #30 / NN_1992_30.iso / spool / alt / lucidem / help / 797 < prev    next >
Encoding:
Text File  |  1992-12-14  |  21.7 KB  |  547 lines
  1. x-gateway: rodan.UU.NET from help-lucid-emacs to alt.lucid-emacs.help; Mon, 14 Dec 1992 10:38:39 EST
  2. Return-Path: <sun001!mbattagl>
  3. Date: Mon, 14 Dec 1992 08:33:36 CST
  4. From: sun001!mbattagl@uunet.uu.net (M. Battagl)
  5. Message-ID: <9212141433.AA04038@enterprise-gw>
  6. Subject: mini-buffer recall
  7. Newsgroups: alt.lucid-emacs.help
  8. Path: sparky!uunet!wendy-fate.uu.net!help-lucid-emacs
  9. Sender: help-lucid-emacs-request@lucid.com
  10. Lines: 535
  11.  
  12. A long time ago I wrote a mini-buffer recall.  Since then I have been
  13. informed of other code that does this.  However, I still found the
  14. functionality of the code I wrote more useful to me.  So if anyone
  15. would like it here it is. 
  16.  
  17.  Also to the few people posting about formatting text, I have written a
  18. formatter I think is more useful.  However, since the introduction of
  19. lemacs 19.x it has developed some bugs.  I will post that as soon as I
  20. think it has been updated for correctly.
  21.  
  22. ;; mini-buffer.el
  23. ;; This file is part of GNU Emacs.
  24.  
  25. ;; GNU Emacs is free software; you can redistribute it and/or modify
  26. ;; it under the terms of the GNU General Public License as published by
  27. ;; the Free Software Foundation; either version 1, or (at your option)
  28. ;; any later version.
  29.  
  30. ;; GNU Emacs is distributed in the hope that it will be useful,
  31. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  32. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  33. ;; GNU General Public License for more details.
  34.  
  35. ;; You should have received a copy of the GNU General Public License
  36. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  37. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  38.  
  39. ;;;======================== mini-buffer.el ===========================
  40. ;;; This file contains the routines used to provide defaults for calls
  41. ;;; using the minibuffer. Up and down arrow will recall the defaults
  42. ;;; If the variable 'mini-default-buffer' is nil
  43. ;;; then a default default buffer will be used.  If you want seperate
  44. ;;; default sets, set 'mini-default-buffer' to the buffer name to hold
  45. ;;; the defaults for a function prior to calling the original function.
  46. ;;; In this way you can have search commands have one default and edit
  47. ;;; files have another.
  48. ;;; No matter how the minibuffer is exited (or aborted) the variable
  49. ;;; 'mini-default-buffer' will be set back to nil !!!!
  50.  
  51. ;;; this does not (or should not) effect the execute extended command
  52. ;;; (M-x) function.  However if you want defaults for that please use
  53. ;;; the function 'func-execute-ext-cmd'
  54.  
  55. ;;; NOTE: DEFAULT BUFFER NAMES SHOULD START WITH A SPACE SO THEY WILL
  56. ;;;       NOT SHOW UP IN THE BUFFER LIST!!!!!!!!
  57. ;;;===================================================================
  58.  
  59. (defvar mini-default-buffer nil
  60.   "The name of a buffer to retrieve defaults from.
  61.      nil = use general defaults"
  62.   )
  63. (defun func-get-mini-default(count)
  64.   "this function will change the default in the minibuffer
  65.   when called with a buffer to retreive them from.  If the variable
  66.   'mini-default-buffer' is nil it will output an error message. If
  67.   not it will retrieve defaults from that buffer.  The paramater passed
  68.   should be a '1' for down-arrow and a -1 for up-arrow"
  69.   (if (eq mini-default-buffer nil)
  70.       (setq mini-default-buffer " misc-defaults")
  71.     )
  72.   (erase-buffer)
  73.   (let* ((a nil) (mark nil) (temp_buffer (buffer-name)))
  74.     (if (not (get-buffer mini-default-buffer))
  75.     (progn
  76.       (get-buffer-create mini-default-buffer)
  77.       (set-buffer mini-default-buffer)
  78.           (newline 1)
  79.           )
  80.       (set-buffer mini-default-buffer)
  81.       )
  82.     (forward-line count)
  83.     (setq mark (point))
  84.     (end-of-line 1)
  85.     (setq a (buffer-substring (point) mark))
  86.     (set-buffer temp_buffer)
  87.     (insert-string a)
  88.     (end-of-line 1)
  89.     )
  90.   )
  91. (defun func-mini-get-up()
  92.   "up arrow in minibuffer for defaults"
  93.   (interactive)
  94.   (func-get-mini-default -1)
  95.   )
  96. (defun func-mini-get-down()
  97.   "down arrow in minibuffer for defaults"
  98.   (interactive)
  99.   (func-get-mini-default 1)
  100.   )
  101. ;;;===================================================================
  102. (defun func-mini-match-end()        ;
  103.   "return key in minibuffer for defaults" ;
  104.   (interactive)                ;
  105.   (if (eq mini-default-buffer nil)    ;set default if not defined
  106.       (setq mini-default-buffer " misc-defaults") ;
  107.     )                    ;
  108.   (let* ((mark nil) (temp_buffer (buffer-name))    ;
  109.      (a (buffer-substring (point-min) (point-max)))    ;
  110.      (temp (try-completion        ;
  111.         a minibuffer-completion-table ;
  112.         minibuffer-completion-predicate) ;
  113.            )            ;
  114.      )                ;
  115.     (if (and temp            ;if possible match exists(temp not nil)
  116.          (or (eq temp t)        ;if not a unique completion
  117.          (equal temp "")    ;if defaulted, go with it
  118.          (if (sequencep minibuffer-completion-table) ;
  119.              (if (vectorp minibuffer-completion-table) ;
  120.              (intern-soft (setq a temp) minibuffer-completion-table) ;
  121.                (assoc (setq a temp) minibuffer-completion-table) ;
  122.                )        ;end-> "if (vectorp minibuf..."
  123.            t            ;
  124.            )            ;end-> "if (sequencep minib..."
  125.          )            ;end-> "or (eq temp t)"
  126.          )                ;end-> "and temp"
  127.     (progn                ;if temp is a completion
  128.       (if (string-match "[^     ]" a) ;
  129.           (progn            ;if not all whitespace
  130.         (if (not (get-buffer mini-default-buffer)) ;
  131.             (progn        ;
  132.               (get-buffer-create mini-default-buffer) ;
  133.               (set-buffer mini-default-buffer) ;
  134.               (newline 1)    ;
  135.               )            ;
  136.           (set-buffer mini-default-buffer) ;
  137.           )            ;
  138.         (goto-char (point-min))    ;start of buffer
  139.         (if (re-search-forward
  140.              (concat "^" (regexp-quote a) "$") ;
  141.              (point-max) 2)
  142.             (progn        ;if found exact match
  143.               (let ((end (point))) ;save line end
  144.             (beginning-of-line) ;go to start of line
  145.             (delete-region end (point)) ;delete line
  146.             (delete-char 1)   ;delete newline
  147.             )        ;end let
  148.               )            ;end-> "progn"
  149.           )            ;end-> "if (not (re-search-forward "
  150.         (goto-char (point-max))    ;
  151.         (insert-string a)    ;save this one
  152.         (newline)        ;mark end of text
  153.         (goto-char (point-max))    ;
  154.         )            ;end-> "progn"
  155.         )                ;end-> "if (string-match "[^     ]" (se..."
  156.       (set-buffer temp_buffer)    ;
  157.       (setq mini-default-buffer nil) ;
  158.       (minibuffer-complete-and-exit) ;
  159.       )                ;end-> "progn"
  160.       (minibuffer-complete)        ;
  161.       )                    ;end-> "if (and temp"
  162.     )                    ;end-> "let* ((mark nil) (t..."
  163.   )                    ;end-> "defun func-mini-mat..."
  164. ;;;======================================================================
  165. (defun func-mini-end()
  166.   "return key in minibuffer for defaults"
  167.   (interactive)
  168.   (if (eq mini-default-buffer nil)
  169.       (setq mini-default-buffer " misc-defaults")
  170.     )
  171.   (let* ((a nil) (mark nil) (temp_buffer (buffer-name)))
  172.     (goto-char (point-min))
  173.     (setq mark (point))
  174.     (end-of-line 1)
  175.     (setq a (buffer-substring (point) mark))
  176.     (if (string-match "[^     ]" a)
  177.     (progn
  178.       (if (not (get-buffer mini-default-buffer))
  179.           (progn
  180.         (get-buffer-create mini-default-buffer)
  181.         (set-buffer mini-default-buffer)
  182.         (newline 1)
  183.         )
  184.         (set-buffer mini-default-buffer)
  185.         )
  186.       (goto-char (point-max))
  187.       (previous-line 1)
  188.       (beginning-of-line)
  189.       (if (not (re-search-forward
  190.             (concat "^" (regexp-quote a) "$") (point-max) 2))
  191.           (progn
  192.         (insert-string a)
  193.         (newline)
  194.         )
  195.         )
  196.       (goto-char (point-max))
  197.       )
  198.       )
  199.     (set-buffer temp_buffer)
  200.     (setq mini-default-buffer nil)
  201.     (exit-minibuffer)
  202.       )
  203.   )
  204. ;;;===================================================================
  205. (defun func-mini-abort()
  206.   (interactive)
  207.   (if (eq mini-default-buffer nil)
  208.       (setq mini-default-buffer " misc-defaults")
  209.     )
  210.   (get-buffer-create mini-default-buffer)
  211.   (set-buffer mini-default-buffer)
  212.   (goto-char (point-max))
  213.   (setq mini-default-buffer nil)
  214.   (abort-recursive-edit)
  215.   )
  216. (defun func-execute-ext-cmd(arg)
  217.   "execute extended command with defaults"
  218.   (interactive "p")
  219.   (setq mini-default-buffer " extend-cmd-default")
  220.   (if (/= arg 1)
  221.       (setq arg (concat "C-u " arg " "))
  222.     (setq arg "")
  223.     )
  224.   (call-interactively
  225.    (intern 
  226.     (completing-read (concat arg "Cmd: ") obarray 'commandp t)))
  227.   )
  228. (define-key minibuffer-local-map 'down 'func-mini-get-down) ;down arrow
  229. (define-key minibuffer-local-map 'up 'func-mini-get-up) ;up arrow
  230. (define-key minibuffer-local-map 'return 'func-mini-end)  ;'return key'
  231. (define-key minibuffer-local-map '(control g) 'func-mini-abort)  ;'return key'
  232. (define-key minibuffer-local-completion-map 'down 'func-mini-get-down) ;down arrow
  233. (define-key minibuffer-local-completion-map 'up 'func-mini-get-up) ;up arrow
  234. (define-key minibuffer-local-completion-map 'return 'func-mini-end)  ;'return key'
  235. (define-key minibuffer-local-completion-map '(control g) 'func-mini-abort)  ;'return key'
  236. (define-key minibuffer-local-must-match-map 'down 'func-mini-get-down) ;down arrow
  237. (define-key minibuffer-local-must-match-map 'up 'func-mini-get-up) ;up arrow
  238. (define-key minibuffer-local-must-match-map 'return 'func-mini-match-end)  ;'return key'
  239. (define-key minibuffer-local-must-match-map '(control g) 'func-mini-abort)  ;'return key'
  240. (define-key minibuffer-local-must-match-map '(control space) 'lisp-complete-symbol)  ;'return key'
  241.  
  242. ;;; ====== end of mini-buffer.el
  243.  
  244. Here's an example of find-file code using it.  It also is a little
  245. smarter than the normal find-file...
  246.  
  247. (defun edit-file()
  248.   "(edit-file) - Edit a file. If the current buffer is empty, read the file into
  249. the current window.  If there is data, read the file into the other buffer.
  250.  
  251. Also see command: visit-file - \\[visit-file]"
  252.   (interactive)                ;
  253.   (file-sub "Edit file: " nil)        ;
  254.   )                    ;end->"(defun edit-file()"
  255.  
  256. (defun visit-file()
  257.   "(visit-file) - Visit (read only) a file.
  258. If the current buffer is empty, read the file into the current window.
  259. If there is data, read the file into the other buffer
  260.  
  261. Also see command: edit-file - \\[edit-file]"
  262.   (interactive)                ;
  263.   (file-sub "Browse file: " t)        ;
  264.   )                    ;end->"(defun visit-file()"
  265.  
  266. (defun file-sub(prompt read-only)
  267.   (setq mini-default-buffer " mini-edit-file-default")
  268.   (let* ((file-name (read-file-name prompt nil t)))
  269.     (if (and (equal (buffer-size) 0)
  270.          (not (string-match "^\\*.*\\*$" (buffer-name)))
  271.          )                ;end->"(and (equal (buffer..."
  272.     (condition-case error
  273.         (find-alternate-file file-name)
  274.       (error
  275.        (find-file file-name)
  276.        )                ;end->"(error"
  277.       )                ;end->"(condition-case error"
  278.       (if (and (string-match "^\\*scratch\\*$" (buffer-name))
  279.            (equal (buffer-size) 0))
  280.       (find-file file-name)
  281.     (find-file-other-window file-name)
  282.     )                ;end->"(if (and (string-ma..."
  283.       )                    ;end->"(if (and (equal (bu..."
  284.     )                    ;end->"(let* ((file-name (..."
  285.   (setq buffer-read-only read-only)
  286.   )                    ;end->"(defun edit-file()"
  287.  
  288. ========= end of example ===================================
  289.  
  290. As long as I'm at it, for all you elisp-ers here is a auto-commenter.
  291. it help keeping track of 'end' parenthesis.
  292.  
  293. ;;;****************************************************************************
  294. ;;;** AUTO-COMMENT.EL - Routines to automatically comment code lines
  295. ;;;**   which contain only the symbols for the type parenthesis close.
  296. ;;;**   (whitespace, and old auto-comments are ignored)
  297. ;;;**   This function is activated as a minor mode and using blink-paren-hook
  298. ;;;**   When on close-paren-link is used, when off blink-matching-open is used.
  299. ;;;**   The local variable auto-comment-mode is the final control used.
  300. ;;;**   When auto-comment-mode is not nil and a close parenthesis type code
  301. ;;;**   (defined by the active character syntax table) is typed on a line
  302. ;;;**   by itself or with whitespace and/or an auto-comment, the matching
  303. ;;;**   open parenthesis is located and the text from it to the end of its
  304. ;;;**   line is used to form an auto-comment:
  305. ;;;**      the close parenthesis is placed on an indented line by itself
  306. ;;;**      (kill-comment) is used to set to dot comment column and add 
  307. ;;;**         the active comment character/sequence.
  308. ;;;**      The user defined auto-close-prefix is added and the comment
  309. ;;;**         is processed to fit before fill-column
  310. ;;;**      If additional levels of close-parenthesis were on the original
  311. ;;;**         line they are processed in the same manner.
  312. ;;;****************************************************************************
  313. (defvar auto-comment-mode nil
  314.   "to automatically comment at function close
  315.           t = do auto comment
  316.         nil = don't do auto comment
  317. The function 'auto-comment-mode' will toggle this and update the display"
  318.   )                    ;end->"(defvar auto-comment-mode nil"
  319. (make-variable-buffer-local 'auto-comment-mode)
  320. (defvar auto-close-prefix "end->"
  321.   "*defines the prefix inserted to start an auto-commented close parenthesis"
  322.   )                    ;end->"(defvar auto-close-prefix 'e..."
  323. (or (assq 'auto-comment-mode minor-mode-alist)
  324.     (setq minor-mode-alist        ;define as minor mode
  325.       (cons '(auto-comment-mode " Auto_cmt") minor-mode-alist) ;text for line
  326.       )                ;end->"(setq minor-mode-alist  ;"
  327.     )                    ;end->"(or (assq 'auto-comment-mode..."
  328. (defvar old-lisp-indent-line nil
  329.   "symbol function for lisp-indent-line prior to intercept for
  330. auto-comment-close being substituted"
  331.   )                    ;end->"(defvar old-lisp-indent-line nil"
  332. (if (not old-lisp-indent-line)        ;define only if nil
  333.     (progn                ;
  334.       (fset 'old-lisp-indent-line (symbol-function 'lisp-indent-line)) ;
  335.       (defun lisp-indent-line(&optional exp) ;
  336.     "Tab response of auto-comment-close if only closes (without non-auto comment)
  337. on line where tab is called, else use normal tab function"
  338.     (interactive)            ;
  339.     (if (and auto-comment-mode    ;
  340.          (interactive-p)    ;
  341.          (save-excursion    ;
  342.            (beginning-of-line)    ;
  343.            (looking-at "[     ]*\\s)+[     ]*\\s<?") ;
  344.            )            ;end->"(save-excursion ;"
  345.          )            ;end->"(and auto-comment-mode ;"
  346.         (progn            ;
  347.           (beginning-of-line)    ;
  348.           (re-search-forward "\\s)" (point-max) nil 1) ;
  349.           (auto-comment-close)    ;
  350.           )                ;end->"(progn   ;"
  351.       (old-lisp-indent-line exp)    ;not comment time so call old function
  352.       )                ;end->"(if (and auto-comment-mode ;"
  353.     )                ;end->"(defun lisp-indent-line(&opt..."
  354.       )                    ;end->"(progn    ;"
  355.   )                    ;end->"(if (not old-lisp-indent-lin..."
  356. (defun auto-comment-mode(val)
  357.   "Function to toggle auto commenter when a function close is entered
  358. from the keyboard on and off"
  359.   (interactive "p")            ;allow execution as extended command
  360.   (setq blink-paren-hook 'close-paren-link) ;link in automatic comment close
  361.   (if (or (interactive-p) (eq val 0))    ;if extended command or parameter=0
  362.       (if auto-comment-mode        ;if defined
  363.       (setq auto-comment-mode nil)    ;if defined turn off
  364.     (setq auto-comment-mode t)    ;if not defined turn on
  365.     )                ;end->"(if auto-comment-mode  ;if d..."
  366.     (if (< val 0)            ;if parameter was negative
  367.     (setq auto-comment-mode nil)    ;if parameter was negative turn off
  368.       (setq auto-comment-mode t)    ;if parameter was positive turn on
  369.       )                    ;end->"(if (< val 0)   ;"
  370.     )                    ;end->"(if (or (interactive-p) (eq ..."
  371.   (set-buffer-modified-p (buffer-modified-p)) ;
  372.   )                    ;end->"(defun auto-comment-mode(val)"
  373. (defun close-paren-link()
  374.   "Handle close parenthesis: If matching end-of-defun, re-comment defun.
  375. If only closes and whitespace are on the current line, auto-comment-close.
  376. In any other case the matching open parenthesis will be displayed"
  377.   (if (and auto-comment-mode        ;
  378.        (save-excursion        ;
  379.          (beginning-of-line)    ;
  380.          (looking-at "\\s-*\\s)+\\s-*$") ;
  381.          )                ;end->"(save-excursion  ;"
  382.        )                ;end->"(and auto-comment-mode  ;"
  383.       (progn                ;
  384.     (beginning-of-line)        ;
  385.     (re-search-forward "\\s)" (point-max) nil 1) ;
  386.     (if (save-excursion (end-of-line) ;if line end ends function:
  387.                 (eq 0 (nth 0 ;
  388.                        (parse-partial-sexp 1 (dot)) ;
  389.                        ) ;end->"(nth 0 ;"
  390.                 )    ;end->"(eq 0 (nth 0 ;"
  391.                 )        ;end->"(save-excursion (end-of-line..."
  392.         (re-comment-close)        ;re do entire function
  393.       (auto-comment-close)        ;else line only
  394.       )                ;end->"(if (save-excursion (end-of-..."
  395.     )                ;end->"(progn    ;"
  396.     (blink-matching-open)        ;use normal hook
  397.     )                    ;end->"(if (and auto-comment-mode  ;"
  398.   )                    ;end->"(defun close-paren-link()"
  399. (defun auto-comment-close ()
  400.   "(auto-comment-close) - reallign the current line and comment and then
  401. automatically comment the initial close parenthesis type characters at the
  402. start of current line if there is not a manual comment present.
  403.  
  404. Warning: due to the parser's failure to recognize a comment as a comment,
  405.          quotes(\") within the open text will be changed to single quotes(')"
  406.   (interactive)
  407.   (old-lisp-indent-line)        ;set proper indention for line
  408.   (indent-for-comment)            ;goto comment, realign or add
  409. ;;; if looking at a line with a manual comment, do NOT process further
  410.   (if (looking-at            ;if blank comment or auto-comment
  411.        (concat "\\(\\s-*$\\)\\|\\(" (regexp-quote auto-close-prefix) "\\)")
  412.        )                ;end->"(looking-at   ;if blank com..."
  413.       (progn
  414.     (beginning-of-line)
  415.     (if (re-search-forward        ;find starting close
  416.          "\\s)" (save-excursion (end-of-line) (dot)) nil) ;try whole line
  417.         (progn
  418.           (forward-char -1)        ;align as though found by back search
  419.           (let ((loc)(string)(key 1)(room)
  420.             (acpsz (1+ (length auto-close-prefix)))
  421.             )            ;end->"((loc)(string)(key 1)(room)"
  422.         (save-excursion        ;keep track of close location
  423.           (end-of-line)        ;force to end of line
  424.           (kill-comment 1)    ;kill any previous comment
  425.           )            
  426.         (while (> (setq key (1- key)) -1) ;loop to handle multiple ")"s
  427.           (setq loc (dot))    ;save location of ")"
  428.           (match-paren)        ;goto matching open
  429.           (setq string        ;get text
  430.             (buffer-substring (dot) (progn (end-of-line) (dot)))
  431.             )        ;end->"(setq string  ;get text"
  432.           (goto-char (1+ loc))    ;return to char after original ")"
  433.           (delete-horizontal-space) ;remove white-space after ")"
  434.           (if (looking-at "\\s)") ;if a another ")"
  435.               (save-excursion    ;save cursor position
  436.             (insert-char ?\n 1) ;force line break
  437.             (old-lisp-indent-line) ;indent new ")" line
  438.             (setq  key (1+ key)) ;force loop to handle multiple ")"s
  439.             )        ;end->"(save-excursion  ;save curs..."
  440.             )            ;end->"(if (looking-at '\\s)') ;if..."
  441.           (end-of-line)        ;force to end of line
  442.           (indent-for-comment)    ;set to comment column & force comment
  443.           (if (< (setq room (- fill-column (current-column) acpsz)) 10) ;room?
  444.               (progn        ;if insuffient room for comment
  445.             (newline)    ;break line
  446.             (end-of-line)    ;force to end of line
  447.             (indent-for-comment)    ;set to comment column & force comment
  448.             (setq room (- fill-column (current-column) acpsz)) ;new size
  449.             )        ;end->"(progn  ;if insuffient room..."
  450.             )            ;end->"(if (< (setq room (- fill-c..."
  451.           (if (> (length string) room) ;if trim needed
  452.               (setq string    ;trim and add trailing ...
  453.                 (concat (substring string 0 (- room 4)) "...")
  454.                 )        ;end->"(setq string"
  455.             )            ;end->"(if (> (length string) room..."
  456.           (insert auto-close-prefix "\"") ;insert prefix and quote
  457.           (setq loc (dot))    ;save location
  458.           (insert string)    ;Insert comment string
  459.           (subst-char-in-region loc (dot) ?\" ?') ;get rid of quotes
  460.           (subst-char-in-region loc (dot) ?     ? ) ;get rid of tabs
  461.           (insert "\"")        ;insert final quote
  462.           (if (> key 0)        ;if more ")"s to process
  463.               (progn        ;find next ")"
  464.             (re-search-forward "\\s)" (point-max) nil)
  465.             (backward-char 1) ;point to ")"
  466.             )        ;end->"(progn  ;find next ')'"
  467.             )            ;end->"(if (> key 0)  ;if more ')'..."
  468.           )            ;end->"(while (> (setq key (1- key..."
  469.         )            ;end->"(let ((loc)(string)(key 1)(..."
  470.           (if (interactive-p)
  471.           (message "Comment done")
  472.         )            ;end->"(if (interactive-p)"
  473.           )                ;end->"(progn"
  474.       )                ;end->"(if (re-search-forward  ;fi..."
  475.     )                ;end->"(progn"
  476.     )                    ;end->"(if (looking-at   ;if blank..."
  477.   )                    ;end->"(defun auto-comment-close ()"
  478. (defun re-comment-close ()
  479.   "(re-comment-close) for entire function process each line outside of quotes
  480. using auto-comment-close"
  481.   (interactive)
  482.   (save-excursion
  483.     (save-restriction
  484.       (end-of-defun)            ;locate end of function
  485.       (newline 1)            ;insert line for kill comment bug
  486.       (let ((mark (dot)))        ;save for end test
  487.     (beginning-of-defun)        ;locate start of function
  488.     (narrow-to-region (dot) mark)    ;select function as if entire buffer
  489.     (delete-eol-white-space)    ;remove excess white space after lines
  490.     (while (not (progn (forward-line 1) (looking-at "\\'"))) ;while more lines
  491.       (if (not (nth 3 (parse-partial-sexp (point-min)(dot)))) ;if not in quote
  492.           (if (looking-at "\\s-*\\s)+") ;if line starts with close
  493.           (auto-comment-close)    ;align/comment process line
  494.         (if (not (looking-at    ;if not a blank line or quote
  495.               "\\($\\)\\|\\(\\s-*\"\\)"))
  496.              (progn        ;if not at comment or quote start
  497.                (old-lisp-indent-line) ;set proper line indention
  498.                (indent-for-comment)    ;goto comment, realign or add
  499.                )        ;end->"(progn"
  500.           )            ;end->"(if (not (looking-at '\\s<'..."
  501.         )            ;end->"(if (looking-at '\\s-*\\s)+..."
  502.         )                ;end->"(if (not (nth 3 (parse-part..."
  503.       )                ;end->"(while (< (dot) (point-max)..."
  504.     )                ;end->"(let ((mark (dot)))  ;save ..."
  505.       (end-of-defun)            ;locate end of function
  506.       (delete-char -1 nil)        ;kill inserted line (eol)
  507.       )                    ;end-> "(save-restriction"
  508.     )                    ;end-> "(save-excursion"
  509.   (if (interactive-p)
  510.       (message "Re-commented")
  511.     )                    ;end-> "(if (interactive-p)"
  512.   )                    ;end-> "(defun re-comment-close ()"
  513. (defun tab-link()
  514.   "Handle tab by auto-comment-close if only closes and whitespace
  515. are on line the current line, otherwise old-lisp-indent-line"
  516.   (if (and auto-comment-mode
  517.        (save-excursion 
  518.          (beginning-of-line)
  519.          (looking-at "[     ]*\\s)+[     ]*$")
  520.          )                ;end-> "(save-excursion "
  521.        )                ;end-> "(and auto-comment-mode"
  522.       (progn
  523.     (beginning-of-line)
  524.     (re-search-forward "\\s)" (point-max) nil 1)
  525.     (auto-comment-close)
  526.     )                ;end-> "(progn"
  527.     (old-lisp-indent-line)            ;use normal tab function
  528.     )                    ;end-> "(if (and auto-comment-mode"
  529.   )                    ;end-> "(defun close-paren-link()"
  530.  
  531. --
  532. Mike Battaglia
  533. DSC Communications Corp
  534.  
  535. (214) 519-3253
  536. mbattagl@dsccc.com
  537.  
  538.  
  539. ==================================================================
  540.  
  541. The universe never did make sense; I suspect that it was built on
  542. government contract.
  543.  
  544.     *** heinlein ****
  545.  
  546. ==================================================================
  547.