home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / ilisp / ilisp-ext.el < prev    next >
Encoding:
Text File  |  1992-06-29  |  23.3 KB  |  679 lines
  1. ;;; -*-Emacs-Lisp-*-
  2. ;;;%Header
  3. ;;; Lisp mode extensions from the ILISP package.
  4. ;;; Copyright (C) 1990, 1991, 1992 Chris McConnell, ccm@cs.cmu.edu.
  5.  
  6. ;;; This file is part of GNU Emacs.
  7.  
  8. ;;; GNU Emacs is distributed in the hope that it will be useful,
  9. ;;; but WITHOUT ANY WARRANTY.  No author or distributor
  10. ;;; accepts responsibility to anyone for the consequences of using it
  11. ;;; or for whether it serves any particular purpose or works at all,
  12. ;;; unless he says so in writing.  Refer to the GNU Emacs General Public
  13. ;;; License for full details.
  14.  
  15. ;;; Everyone is granted permission to copy, modify and redistribute
  16. ;;; GNU Emacs, but only under the conditions described in the
  17. ;;; GNU Emacs General Public License.   A copy of this license is
  18. ;;; supposed to have been given to you along with GNU Emacs so you
  19. ;;; can know your rights and responsibilities.  It should be in a
  20. ;;; file named COPYING.  Among other things, the copyright notice
  21. ;;; and this notice must be preserved on all copies.
  22.  
  23. ;;; When loaded this file adds new functionality to emacs lisp mode
  24. ;;; and lisp mode. 
  25. ;;; 
  26. ;;; Default bindings:
  27. ;;;
  28. ;;; M-x find-unbalanced-lisp find unbalanced parens in the current
  29. ;;; buffer.  With a prefix in the current region. 
  30. ;;;
  31. ;;; ] Close all open parentheses back to the start of the containing
  32. ;;; sexp, or to a previous left bracket which will be converted to a
  33. ;;; left paren.
  34. ;;;
  35. ;;; M-q Reindent comments or strings in paragraph chunks or reindent
  36. ;;; the containing sexp.
  37. ;;;
  38. ;;; M-x comment-region-lisp inserts prefix copies of the comment-start
  39. ;;; character before lines in the region and the comment-end character
  40. ;;; at the end of each line.  If called with a negative prefix, that
  41. ;;; many copies are removed.
  42. ;;;
  43. ;;; C-M-r repositions the first line of the current defun to the top
  44. ;;; of the current window.
  45. ;;;
  46. ;;; C-M-l switches the current window to the previously seen buffer.
  47. ;;;
  48. ;;; EXAMPLE .emacs:
  49. ;;;
  50. ;;; (setq ilisp-ext-load-hook 
  51. ;;;   '(lambda () (define-key global-map "\C-\M-l" 'previous-buffer-lisp)))
  52. ;;; (require 'ilisp-ext)
  53.  
  54. ;;;%Syntax
  55. ;;; This makes it so that .'s are treated as normal characters so that
  56. ;;; 3.141 gets treated as a single lisp token.  This does cause dotted
  57. ;;; pairs to be treated weird though.
  58. (modify-syntax-entry ?. "_" lisp-mode-syntax-table)
  59.  
  60. ;;; Brackets match
  61. (modify-syntax-entry ?\[ "(]" lisp-mode-syntax-table)
  62. (modify-syntax-entry ?\] ")[" lisp-mode-syntax-table)
  63.  
  64. ;;;%Globals
  65. (defvar ilisp-ext-load-hook nil "Hook to run when extensions are loaded.")
  66. (defvar left-delimiter "\(" "*Left delimiter for find-unbalanced.")
  67. (defvar right-delimiter "\)" "*Right delimiter for find-unbalanced.")
  68.  
  69. ;;; Copies of ilisp var definitions
  70. (defvar ilisp-complete nil "T when ilisp is in completion mode.")
  71. (defvar ilisp-modes '(ilisp-mode) "List of all inferior ilisp modes.")
  72.  
  73. ;;;%Utils
  74. ;;; This should be in emacs, but it isn't.
  75. (defun lisp-mem (item list &optional elt=)
  76.   "Test to see if ITEM is equal to an item in LIST.
  77. Option comparison function ELT= defaults to equal."
  78.   (let ((elt= (or elt= (function equal)))
  79.     (done nil))
  80.     (while (and list (not done))
  81.       (if (funcall elt= item (car list))
  82.       (setq done list)
  83.       (setq list (cdr list))))
  84.     done))
  85.  
  86. ;;;
  87. (defun lisp-defun-begin ()
  88.   "Go to the start of the containing defun and return point."
  89.   (let (begin)
  90.     (if (memq major-mode ilisp-modes)
  91.     (lisp-input-start)
  92.     (if (or (eobp) (not (and (bolp) (= (char-after (point)) ?\())))
  93.         (beginning-of-defun))
  94.     (point))))
  95.  
  96. ;;;
  97. (defun lisp-defun-end (&optional no-errorp at-beginp)
  98.   "Go to the end of the containing defun and return point or nil if
  99. there is no end."
  100.   (if (not at-beginp) (lisp-defun-begin))
  101.   (condition-case ()
  102.       (progn
  103.     (lisp-skip (point-max))        ;To skip comments on defun-end
  104.     (forward-sexp)
  105.     (point))
  106.     (error (if no-errorp nil (error "Unbalanced parentheses")))))
  107.  
  108. ;;;
  109. (defun lisp-find-next-start ()
  110.   "Find the start of the next line at the left margin that starts with
  111. a character besides whitespace, a \) or ;;; and return the
  112. point."
  113.   (if (eobp)
  114.       (point-max)
  115.       (save-excursion
  116.     (forward-char)
  117.     (if (re-search-forward "^\\(\\(;;;\\)\\|\\([^ \t\n\);]\\)\\)" nil t)
  118.         (match-beginning 0)
  119.         (point-max)))))
  120.  
  121. ;;;
  122. (defun lisp-end-defun-text (&optional at-start)
  123.   "Go the end of the text associated with the current defun and return
  124. point.  The end is the last character before whitespace leading to
  125. a left paren or ;;; at the left margin unless it is in a string."
  126.   (if (not at-start) (lisp-defun-begin))
  127.   (let ((point (point))
  128.     (boundary (lisp-find-next-start))
  129.     (final (save-excursion
  130.          (condition-case ()
  131.              (progn (forward-sexp) (point))
  132.            (error (point-max))))))
  133.     ;; Find the next line starting at the left margin and then check
  134.     ;; to see if it is in a string. 
  135.     (while (progn
  136.          (skip-chars-forward "^\"" boundary) ;To the next string
  137.          (if (= (point) boundary)    
  138.          nil            ;No quote found and at limit
  139.          (let ((string-boundary ;Start of next defun
  140.             (save-excursion
  141.               (if (re-search-forward "^\(\\|^;;;" nil t)
  142.                   (match-beginning 0)
  143.                   (point-max)))))
  144.            (if (condition-case ()
  145.                (progn (forward-sexp) t)
  146.              (error (goto-char string-boundary) nil))
  147.                (if (>= (point) boundary)
  148.                ;; Boundary was in string
  149.                (if (> (point) string-boundary)
  150.                    (progn    ;String ended in next defun
  151.                  (goto-char string-boundary)
  152.                  nil)
  153.                    (if (> (setq boundary
  154.                         (lisp-find-next-start))
  155.                       final)
  156.                    ;; Normal defun
  157.                    (progn (goto-char final) nil)
  158.                    t))
  159.                t)
  160.                ;; Unclosed string
  161.                nil)))))
  162.     (re-search-backward  "^[^; \t\n]\\|^[^;\n][ \t]*[^ \t\n]" point t)
  163.     (end-of-line)
  164.     (skip-chars-backward " \t")
  165.     (if (< (point) point)
  166.     (goto-char point)
  167.     (if (save-excursion
  168.           (let ((point (point)))
  169.         (beginning-of-line)
  170.         (if comment-start (search-forward comment-start point t))))
  171.         (progn (next-line 1) (indent-line-ilisp)))
  172.     (point))))
  173.  
  174. ;;;
  175. (defun lisp-in-comment (test)
  176.   "Return T if you are in a comment."
  177.   (beginning-of-line)
  178.   (and (looking-at test)
  179.        (not (= (match-end 0)
  180.            (progn (end-of-line) (point))))))
  181.  
  182. ;;;
  183. (defun lisp-in-string (&optional begin end)
  184.   "Return the string region that immediately follows/precedes point or
  185. that contains point in optional region BEGIN to END.  If point is in
  186. region, T will be returned as well."
  187.   (save-excursion
  188.     (if (not begin)
  189.     (save-excursion
  190.       (setq end (lisp-end-defun-text)
  191.         begin (lisp-defun-begin))))
  192.     (let* ((point (progn (skip-chars-forward " \t") (point)))
  193.        (done nil))
  194.       (goto-char begin)
  195.       (while (and (< (point) end) (not done))
  196.     (skip-chars-forward "^\"" end)
  197.     (setq begin (point))
  198.     (if (< begin end)
  199.         (if (and (not (bobp)) (= (char-after (1- begin)) ??))
  200.         (forward-char)
  201.         (if (condition-case () (progn (forward-sexp) (<= (point) end))
  202.               (error nil))
  203.             (progn        ;After string
  204.               (skip-chars-forward " \t")
  205.               (if (or (= begin point) (= point (point)))
  206.               (setq done (list begin (point) nil))
  207.               (if (and (< begin point) (< point (point)))
  208.                   (setq done (list begin (point) t)))))
  209.             ;; In string at end of buffer
  210.             (setq done (list begin end t))))))
  211.       done)))
  212.  
  213. ;;;%Indentation
  214. (defun indent-line-ilisp (&optional whole-exp)
  215.   "Indent current line as Lisp code.
  216. With argument, indent any additional lines of the same expression
  217. rigidly along with this one.  This is restricted to the current buffer input."
  218.   (interactive "P")
  219.   (save-restriction
  220.     (if (memq major-mode ilisp-modes)
  221.     (narrow-to-region (save-excursion (lisp-input-start)) (point-max)))
  222.     (lisp-indent-line whole-exp)))
  223.  
  224. ;;;
  225. (defun indent-sexp-ilisp ()
  226.   "Indent each line of the list starting just after point."
  227.   (interactive)
  228.   (save-restriction
  229.     (if (memq major-mode ilisp-modes)
  230.     (narrow-to-region (save-excursion (lisp-input-start)) (point-max)))
  231.     (indent-sexp)))
  232.  
  233. ;;;%Unbalanced parentheses
  234. (defun lisp-skip (end)
  235.   "Skip past whitespace, comments, backslashed characters and strings
  236. in the current buffer as long as you are before END.  This does move
  237. the point."
  238.   (if (< (point) end)
  239.       (let ((comment (and comment-start (string-to-char comment-start)))
  240.         (done nil)
  241.         char)
  242.     (while (and (< (point) end)
  243.             (not done))
  244.       (skip-chars-forward "\n\t " end)
  245.       (setq char (char-after (point)))
  246.       (cond ((eq char ?\")
  247.          (forward-sexp))
  248.         ((eq char comment)
  249.          (forward-char)
  250.          (skip-chars-forward "^\n" end))
  251.         ((eq char ?\\)
  252.          (forward-char 2))
  253.         (t (setq done t)))))))
  254.  
  255. ;;;
  256. (defun lisp-count-pairs (begin end left-delimiter right-delimiter)
  257.   "Return the number of top-level pairs of LEFT-DELIMITER and
  258. RIGHT-DELIMITER between BEGIN and END.  If they don't match, the point
  259. will be placed on the offending entry."
  260.   (let ((old-point (point))
  261.     (sexp 0)
  262.     left)
  263.     (goto-char begin)
  264.     (lisp-skip end)
  265.     (while (< (point) end)
  266.       (let ((char (char-after (point))))
  267.     (cond ((or (eq char left-delimiter)
  268.            ;; For things other than lists
  269.            (eq (char-after (1- (point))) ?\n))
  270.            (setq sexp (1+ sexp))
  271.            (if (condition-case ()
  272.                (progn (forward-sexp) nil)
  273.              (error t))
  274.            (error "Extra %s" (char-to-string left-delimiter))))
  275.           ((eq char right-delimiter)
  276.            (error "Extra %s" (char-to-string right-delimiter)))
  277.           ((< (point) end) (forward-char))))
  278.       (lisp-skip end))
  279.     (goto-char old-point)
  280.     sexp))
  281.  
  282. ;;;
  283. (defun find-unbalanced-region-lisp (start end)
  284.   "Go to the point in region where LEFT-DELIMITER and RIGHT-DELIMITER
  285. become unbalanced.  Point will be on the offending delimiter."
  286.   (interactive "r")
  287.   (lisp-count-pairs start end
  288.             (string-to-char left-delimiter)
  289.             (string-to-char right-delimiter))
  290.   (if (not ilisp-complete) (progn (beep) (message "Delimiters balance"))))
  291.  
  292. ;;;
  293. (defun find-unbalanced-lisp (arg)
  294.   "Go to the point in buffer where LEFT-DELIMITER and RIGHT-DELIMITER
  295. become unbalanced.  Point will be on the offending delimiter.  If
  296. called with a prefix, use the current region."
  297.   (interactive "P")
  298.   (if arg
  299.       (call-interactively 'find-unbalanced-region-lisp)
  300.       (find-unbalanced-region-lisp (point-min) (point-max))))
  301.  
  302. ;;;%Superbrackets
  303. (defun close-all-lisp (arg)
  304.   "Unless you are in a string, insert right parentheses as necessary
  305. to balance unmatched left parentheses back to the start of the current
  306. defun or to a previous left bracket which is then replaced with a left
  307. parentheses.  If there are too many right parentheses, remove them
  308. unless there is text after the extra right parentheses.  If called
  309. with a prefix, the entire expression will be closed and all open left
  310. brackets will be replaced with left parentheses."
  311.   (interactive "P")
  312.   (let* ((point (point))
  313.      (begin (lisp-defun-begin))
  314.      (end (lisp-end-defun-text))
  315.      inserted
  316.      (closed nil))
  317.     (goto-char point)
  318.     (if (or (car (cdr (cdr (lisp-in-string begin end))))
  319.         (save-excursion (beginning-of-line)
  320.                 (looking-at "[ \t]*;")))
  321.     (insert "]")
  322.     (if (= begin end)
  323.         (error "No sexp to close.")
  324.         (save-restriction
  325.           (narrow-to-region begin end)
  326.           (if (< point begin) 
  327.           (setq point begin)
  328.           (if (> point end)
  329.               (setq point end)))
  330.           ;; Add parens at point until either the defun is closed, or we
  331.           ;; hit a square bracket.
  332.           (goto-char point)
  333.           (insert ?\))        ;So we have an sexp
  334.           (while (progn
  335.                (setq inserted (point))
  336.                (condition-case () 
  337.                (progn (backward-sexp)
  338.                   (or arg 
  339.                       (not (eq (char-after (point)) ?\[))))
  340.              (error (setq closed t) nil)))
  341.         ;; With an arg replace all left brackets
  342.         (if (and arg (= (char-after (point)) ?\[))
  343.             (progn
  344.               (delete-char 1)
  345.               (insert ?\()
  346.               (backward-char)))
  347.         (forward-sexp)
  348.         (insert ?\)))
  349.           (if (< (point) point)
  350.           ;; We are at a left bracket
  351.           (let ((left (point)))
  352.             (delete-char 1)
  353.             (insert ?\()
  354.             (backward-char)
  355.             (forward-sexp))
  356.           ;; There was not an open left bracket so close at end
  357.           (delete-region point inserted)
  358.           (goto-char begin)
  359.           (if (condition-case () (progn
  360.                        (forward-sexp)
  361.                        (<= (point) end))
  362.             (error nil))
  363.               ;; Delete extra right parens
  364.               (let ((point (point)))
  365.             (skip-chars-forward " \t)\n")
  366.             (if (or (bolp) (eobp))
  367.                 (progn
  368.                   (skip-chars-backward " \t\n")
  369.                   (delete-region point (point)))
  370.                 (error
  371.                  "There is text after the last right parentheses.")))
  372.               ;; Insert parens at end changing any left brackets
  373.               (goto-char end)
  374.               (while 
  375.               (progn
  376.                 (insert ?\))
  377.                 (save-excursion
  378.                   (condition-case ()
  379.                   (progn (backward-sexp)
  380.                      (if (= (char-after (point)) ?\[)
  381.                          (progn
  382.                            (delete-char 1)
  383.                            (insert ?\()
  384.                            (backward-char)))
  385.                      (> (point) begin))
  386.                 (error (delete-backward-char 1)
  387.                        nil))))))))))))
  388.  
  389. ;;;%Reindentation
  390. (defvar lisp-fill-marker (make-marker)
  391.   "Keeps track of point so that it does not move during a reindent-lisp.")
  392.  
  393. ;;;
  394. (defun reindent-lisp ()
  395.   "If in a comment, indent the comment paragraph bounded by
  396. non-comments, blank lines or empty comment lines.  If in a string,
  397. indent the paragraph bounded by string delimiters or blank lines.
  398. Otherwise go to the containing defun, close it and reindent the code
  399. block."
  400.   (interactive)
  401.   (let ((region (lisp-in-string))
  402.     (comment (concat "[ \t]*" comment-start "+[ \t]*")))
  403.     (set-marker lisp-fill-marker (point))
  404.     (back-to-indentation)
  405.     (cond (region
  406.        (or (= (char-after (point)) ?\")
  407.            (and (< (point) (car region)) (goto-char (car region)))
  408.            (re-search-backward "^$" (car region) 'end))
  409.        (let ((begin (point))
  410.          (end (car (cdr region)))
  411.          (fill-prefix nil))
  412.          (forward-char)
  413.          (re-search-forward "^$" end 'end)
  414.          (if (= (point) end)
  415.          (progn (skip-chars-forward "^\n")
  416.             (if (not (eobp)) (forward-char))))
  417.          (fill-region-as-paragraph begin (point))))
  418.       ((looking-at comment)
  419.        (let ((fill-prefix
  420.           (buffer-substring
  421.            (progn (beginning-of-line) (point))
  422.            (match-end 0))))
  423.          (while (and (not (bobp)) (lisp-in-comment comment))
  424.            (forward-line -1))
  425.          (if (not (bobp)) (forward-line 1))
  426.          (let ((begin (point)))
  427.            (while (and (lisp-in-comment comment) (not (eobp)))
  428.          (replace-match fill-prefix)
  429.          (forward-line 1))
  430.            (if (not (eobp))
  431.            (progn (forward-line -1)
  432.               (end-of-line)
  433.               (forward-char 1)))
  434.            (fill-region-as-paragraph begin (point)))))
  435.       (t
  436.        (goto-char lisp-fill-marker)
  437.        (close-all-lisp 1)
  438.        (lisp-defun-begin)
  439.        (indent-sexp-ilisp)))
  440.   (goto-char lisp-fill-marker)
  441.   (set-marker lisp-fill-marker nil)
  442.   (message "Done")))
  443.  
  444. ;;;%Comment region
  445. (defvar ilisp-comment-marker (make-marker)
  446.   "Marker for end of a comment region.")
  447. (defun comment-region-lisp (start end prefix)
  448.   "If prefix is positive, insert prefix copies of comment-start at the
  449. start and comment-end at the end of each line in region.  If prefix is
  450. negative, remove all comment-start and comment-end strings from the
  451. region."
  452.   (interactive "r\np")
  453.   (save-excursion
  454.     (goto-char end)
  455.     (if (and (not (= start end)) (bolp)) (setq end (1- end)))
  456.     (goto-char end)
  457.     (beginning-of-line)
  458.     (set-marker ilisp-comment-marker (point))
  459.     (untabify start end)
  460.     (goto-char start)
  461.     (beginning-of-line)
  462.     (let* ((count 1)
  463.        (comment comment-start)
  464.        (comment-end (if (not (equal comment-end "")) comment-end)))
  465.       (if (> prefix 0)
  466.       (progn
  467.         (while (< count prefix)
  468.           (setq comment (concat comment-start comment)
  469.             count (1+ count)))
  470.         (while (<= (point) ilisp-comment-marker)
  471.           (beginning-of-line)
  472.           (insert comment)
  473.           (if comment-end (progn (end-of-line) (insert comment-end)))
  474.           (forward-line 1)))
  475.       (setq comment (concat comment "+"))
  476.       (while (<= (point) ilisp-comment-marker)
  477.         (back-to-indentation)
  478.         (if (looking-at comment) (replace-match ""))
  479.         (if comment-end
  480.         (progn
  481.           (re-search-backward comment-end)
  482.           (replace-match "")))
  483.         (forward-line 1)))
  484.       (set-marker ilisp-comment-marker nil))))
  485.  
  486. ;;;%Movement
  487. ;;; beginning-of-defun-lisp and end-of-defun-lisp are overloaded by ilisp.el
  488. (defun beginning-of-defun-lisp (&optional stay)
  489.   "Go to the next left paren that starts at the left margin."
  490.   (interactive)
  491.   (beginning-of-defun))
  492.  
  493. ;;;
  494. (defun end-of-defun-lisp ()
  495.   "Go to the next left paren that starts at the left margin."
  496.   (interactive)
  497.   (let ((point (point)))
  498.     (beginning-of-line)
  499.     (re-search-forward "^[ \t\n]*[^; \t\n]" nil t)
  500.     (back-to-indentation)
  501.     (if (not (bolp)) (beginning-of-defun-lisp t))
  502.     (lisp-end-defun-text t)
  503.     (if (= point (point))        ;Already at end so move to next end
  504.     (lisp-skip (point-max))
  505.     (if (not (or (eobp)
  506.              (= (char-after (point)) ?\n)))
  507.         (lisp-end-defun-text t)))))
  508.  
  509. ;;;%%Reposition-window
  510. (defun count-screen-lines-lisp (start end)
  511.   "Return the number of screen lines between start and end."
  512.   (save-excursion
  513.     (save-restriction
  514.       (narrow-to-region start end)
  515.       (goto-char (point-min))
  516.       (vertical-motion (- (point-max) (point-min))))))
  517.  
  518. ;;;
  519. (defun count-screen-lines-signed-lisp (start end)
  520.   "Return number of screen lines between START and END; returns a negative
  521. number if END precedes START."
  522.   (interactive "r")
  523.   (let ((lines (count-screen-lines-lisp start end)))
  524.     (if (< start end) lines (- lines))))
  525.  
  526. ;;; This was written by Michael D. Ernst
  527. (defun reposition-window-lisp (&optional arg)
  528.   "Make the current definition and/or comment visible, move it to the
  529. top of the window, or toggle the visibility of comments that precede
  530. it.  Leaves point unchanged unless supplied with prefix ARG.  If the
  531. definition is fully onscreen, it is moved to the top of the window.
  532. If it is partly offscreen, the window is scrolled to get the
  533. definition \(or as much as will fit) onscreen, unless point is in a
  534. comment which is also partly offscreen, in which case the scrolling
  535. attempts to get as much of the comment onscreen as possible.
  536. Initially reposition-window attempts to make both the definition and
  537. preceding comments visible.  Further invocations toggle the visibility
  538. of the comment lines.  If ARG is non-nil, point may move in order to
  539. make the whole defun visible \(if only part could otherwise be made
  540. so), to make the defun line visible \(if point is in code and it could
  541. not be made so, or if only comments, including the first comment line,
  542. are visible), or to make the first comment line visible \(if point is
  543. in a comment)."
  544.   (interactive "P")
  545.   (let* ((here (point))
  546.      ;; change this name once I've gotten rid of references to ht.
  547.      ;; this is actually the number of the last screen line
  548.      (ht (- (window-height (selected-window)) 2))
  549.      (line (count-screen-lines-lisp (window-start) (point)))
  550.      (comment-height
  551.       ;; The max deals with the case of cursor between defuns.
  552.       (max 0
  553.            (count-screen-lines-signed-lisp
  554.         ;; the beginning of the preceding comment
  555.         (save-excursion
  556.           (if (not (and (bolp) (eq (char-after (point)) ?\()))
  557.               (beginning-of-defun-lisp))
  558.           (beginning-of-defun-lisp)
  559.           (end-of-defun-lisp)
  560.           ;; Skip whitespace, newlines, and form feeds.
  561.           (re-search-forward "[^\\s \n\014]")
  562.           (backward-char 1)
  563.           (point))
  564.         here)))
  565.      (defun-height 
  566.          (count-screen-lines-signed-lisp
  567.           (save-excursion
  568.            (end-of-defun-lisp)    ;associate comment with next defun 
  569.            (beginning-of-defun-lisp)
  570.            (point))
  571.           here))
  572.      ;; This must be positive, so don't use the signed version.
  573.      (defun-depth
  574.          (count-screen-lines-lisp
  575.           here
  576.           (save-excursion (end-of-defun-lisp) (point))))
  577.      (defun-line-onscreen-p
  578.          (and (<= defun-height line) (<= (- line defun-height) ht))))
  579.     (cond ((or (= comment-height line)
  580.            (and (= line ht)
  581.             (> comment-height line)
  582.             ;; if defun line offscreen, we should be in case 4
  583.             defun-line-onscreen-p))
  584.        ;; Either first comment line is at top of screen or (point at
  585.        ;; bottom of screen, defun line onscreen, and first comment line
  586.        ;; off top of screen).  That is, it looks like we just did
  587.        ;; recenter-definition, trying to fit as much of the comment
  588.        ;; onscreen as possible.  Put defun line at top of screen; that
  589.        ;; is, show as much code, and as few comments, as possible.
  590.        (if (and arg (> defun-depth (1+ ht)))
  591.            ;; Can't fit whole defun onscreen without moving point.
  592.            (progn (end-of-defun-lisp) (beginning-of-defun-lisp)
  593.               (recenter 0))
  594.            (recenter (max defun-height 0))))
  595.       ((or (= defun-height line)
  596.            (= line 0)
  597.            (and (< line comment-height)
  598.             (< defun-height 0)))
  599.        ;; Defun line or cursor at top of screen, OR cursor in comment
  600.        ;; whose first line is offscreen.
  601.        ;; Avoid moving definition up even if defun runs offscreen;
  602.        ;; we care more about getting the comment onscreen.
  603.        (cond ((= line ht)
  604.           ;; cursor on last screen line (and so in a comment)
  605.           (if arg (progn (end-of-defun-lisp) 
  606.                  (beginning-of-defun-lisp)))
  607.           (recenter 0))
  608.          ;; This condition, copied from case 4, may not be quite right
  609.          ((and arg (< ht comment-height))
  610.           ;; Can't get first comment line onscreen.
  611.           ;; Go there and try again.
  612.           (forward-line (- comment-height))
  613.           (beginning-of-line)
  614.           ;; was (reposition-window)
  615.           (recenter 0))
  616.          (t
  617.           (recenter (min ht comment-height))))
  618.        ;; (recenter (min ht comment-height))
  619.        )
  620.       ((and (> (+ line defun-depth -1) ht)
  621.         defun-line-onscreen-p)
  622.        ;; Defun runs off the bottom of the screen and the defun
  623.        ;; line is onscreen.  Move the defun up.
  624.        (recenter (max 0 (1+ (- ht defun-depth)) defun-height)))
  625.       (t
  626.        ;; If on the bottom line and comment start is offscreen
  627.        ;; then just move all comments offscreen, or at least as
  628.        ;; far as they'll go.  Try to get as much of the comments
  629.        ;; onscreen as possible.
  630.        (if (and arg (< ht comment-height))
  631.            ;; Can't get defun line onscreen; go there and try again.
  632.            (progn (forward-line (- defun-height))
  633.               (beginning-of-line)
  634.               (reposition-window-lisp))
  635.            (recenter (min ht comment-height)))))))
  636.  
  637. ;;;
  638. (defun previous-buffer-lisp (n)
  639.   "Switch to Nth previously selected buffer.  N defaults to the number
  640. of windows plus 1.  That is, no argument switches to the most recently
  641. selected buffer that is not visible.  If N is 1, repeated calls will
  642. cycle through all buffers; -1 cycles the other way.  If N is greater
  643. than 1, the first N buffers on the buffer list are rotated."
  644.   (interactive "P")
  645.   (if (not n)
  646.       (switch-to-buffer nil)
  647.       (let ((buffer-list (buffer-list)))
  648.     (setq n (prefix-numeric-value n))
  649.     (cond ((= n 1)
  650.            (bury-buffer (current-buffer))
  651.            (setq n 2))
  652.           ((< n 0)
  653.            (setq buffer-list (nreverse buffer-list)
  654.              n (- n)))
  655.           (t nil))
  656.     (while (and (> n 1) buffer-list)
  657.       (setq n (1- n)
  658.         buffer-list (cdr buffer-list))
  659.       (while (eq (elt (buffer-name (car buffer-list)) 0) ? )
  660.         (setq buffer-list (cdr buffer-list))))
  661.     (if buffer-list
  662.         (switch-to-buffer (car buffer-list))
  663.         (error "There aren't that many buffers")))))
  664.  
  665. ;;;%Bindings
  666. (define-key emacs-lisp-mode-map "\M-q"    'reindent-lisp)
  667. (define-key emacs-lisp-mode-map "\M-\C-a" 'beginning-of-defun-lisp)
  668. (define-key emacs-lisp-mode-map "\M-\C-e" 'end-of-defun-lisp)
  669. (define-key emacs-lisp-mode-map "\C-\M-r" 'reposition-window-lisp)
  670. (define-key emacs-lisp-mode-map "]"       'close-all-lisp)
  671. (define-key lisp-mode-map       "\M-q"    'reindent-lisp)
  672. (define-key lisp-mode-map       "\C-\M-r" 'reposition-window-lisp)
  673. (define-key lisp-mode-map       "]"       'close-all-lisp)
  674. (define-key global-map          "\M-\C-l" 'previous-buffer-lisp)
  675.  
  676. ;;;
  677. (run-hooks 'ilisp-ext-load-hook)
  678. (provide 'ilisp-ext)
  679.