Mercurial > hg > xemacs-beta
diff lisp/modes/lisp-mode.el @ 2:ac2d302a0011 r19-15b2
Import from CVS: tag r19-15b2
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:46:35 +0200 |
parents | 376386a54a3c |
children | b82b59fe008d |
line wrap: on
line diff
--- a/lisp/modes/lisp-mode.el Mon Aug 13 08:45:53 2007 +0200 +++ b/lisp/modes/lisp-mode.el Mon Aug 13 08:46:35 2007 +0200 @@ -1,6 +1,6 @@ ;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands. -;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1996 Free Software Foundation, Inc. ;; Copyright (C) 1995 Tinker Systems ;; Maintainer: FSF @@ -20,9 +20,10 @@ ;; You should have received a copy of the GNU General Public License ;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. -;;; Synched up with: FSF 19.30. +;;; Synched up with: FSF 19.34 (but starting to diverge). ;;; Commentary: @@ -35,6 +36,7 @@ (defvar emacs-lisp-mode-syntax-table nil "") (defvar lisp-mode-abbrev-table nil "") +;; XEmacs change (defvar lisp-interaction-mode-popup-menu (purecopy '("Lisp Interaction Menu" ["Evaluate Last S-expression" eval-last-sexp t] @@ -98,6 +100,7 @@ (modify-syntax-entry ?\n "> " emacs-lisp-mode-syntax-table) ;; Give CR the same syntax as newline, for selective-display. (modify-syntax-entry ?\^m "> " emacs-lisp-mode-syntax-table) + ;; XEmacs change ;; Treat ^L as whitespace. (modify-syntax-entry ?\f " " emacs-lisp-mode-syntax-table) (modify-syntax-entry ?\; "< " emacs-lisp-mode-syntax-table) @@ -117,7 +120,9 @@ (if (not lisp-mode-syntax-table) (progn (setq lisp-mode-syntax-table (copy-syntax-table emacs-lisp-mode-syntax-table)) + (modify-syntax-entry ?\| "\" " lisp-mode-syntax-table) (modify-syntax-entry ?\[ "_ " lisp-mode-syntax-table) + ;; XEmacs changes (modify-syntax-entry ?\] "_ " lisp-mode-syntax-table) ;; ;; If emacs was compiled with NEW_SYNTAX, then do @@ -126,8 +131,8 @@ (progn (modify-syntax-entry ?# "' 58" lisp-mode-syntax-table) (modify-syntax-entry ?| ". 67" lisp-mode-syntax-table)) - ;; else, old style - (modify-syntax-entry ?\| "\" " lisp-mode-syntax-table)))) + ;; else, old style + (modify-syntax-entry ?\| "\" " lisp-mode-syntax-table)))) (define-abbrev-table 'lisp-mode-abbrev-table ()) @@ -144,8 +149,8 @@ ; "Imenu generic expression for Lisp mode. See `imenu-generic-expression'.") (defun lisp-mode-variables (lisp-syntax) - (if lisp-syntax - (set-syntax-table lisp-mode-syntax-table)) + (cond (lisp-syntax + (set-syntax-table lisp-mode-syntax-table))) (setq local-abbrev-table lisp-mode-abbrev-table) (make-local-variable 'paragraph-start) (setq paragraph-start (concat page-delimiter "\\|$" )) @@ -155,6 +160,11 @@ (setq paragraph-ignore-fill-prefix t) (make-local-variable 'fill-paragraph-function) (setq fill-paragraph-function 'lisp-fill-paragraph) + ;; Adaptive fill mode gets in the way of auto-fill, + ;; and should make no difference for explicit fill + ;; because lisp-fill-paragraph should do the job. + (make-local-variable 'adaptive-fill-mode) + (setq adaptive-fill-mode nil) (make-local-variable 'indent-line-function) (setq indent-line-function 'lisp-indent-line) (make-local-variable 'indent-region-function) @@ -163,14 +173,19 @@ (setq parse-sexp-ignore-comments t) (make-local-variable 'outline-regexp) (setq outline-regexp ";;; \\|(....") - (set (make-local-variable 'comment-start) ";") + (make-local-variable 'comment-start) + (setq comment-start ";") + ;; XEmacs change (set (make-local-variable 'block-comment-start) ";;") (make-local-variable 'comment-start-skip) - (setq comment-start-skip ";+[ \t]*") + ;; Look within the line for a ; following an even number of backslashes + ;; after either a non-backslash or the line beginning. + (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") (make-local-variable 'comment-column) (setq comment-column 40) (make-local-variable 'comment-indent-function) (setq comment-indent-function 'lisp-comment-indent) + ;; XEmacs changes ; (make-local-variable 'imenu-generic-expression) ; (setq imenu-generic-expression lisp-imenu-generic-expression) (set (make-local-variable 'dabbrev-case-fold-search) nil) @@ -184,10 +199,11 @@ (if shared-lisp-mode-map () (setq shared-lisp-mode-map (make-sparse-keymap)) + ;; XEmacs changes (set-keymap-name shared-lisp-mode-map 'shared-lisp-mode-map) + (define-key shared-lisp-mode-map "\M-;" 'lisp-indent-for-comment) (define-key shared-lisp-mode-map "\e\C-q" 'indent-sexp) - (define-key shared-lisp-mode-map "\177" 'backward-delete-char-untabify) - (define-key shared-lisp-mode-map "\M-;" 'lisp-indent-for-comment)) + (define-key shared-lisp-mode-map "\177" 'backward-delete-char-untabify)) (defvar emacs-lisp-mode-map () "Keymap for Emacs Lisp mode. @@ -195,21 +211,41 @@ (if emacs-lisp-mode-map () + ;; XEmacs: Ignore FSF nconc stuff (setq emacs-lisp-mode-map (make-sparse-keymap)) (set-keymap-name emacs-lisp-mode-map 'emacs-lisp-mode-map) (set-keymap-parents emacs-lisp-mode-map (list shared-lisp-mode-map)) (define-key emacs-lisp-mode-map "\e\t" 'lisp-complete-symbol) - (define-key emacs-lisp-mode-map "\e\C-x" 'eval-defun)) + (define-key emacs-lisp-mode-map "\e\C-x" 'eval-defun) + ;; XEmacs: Not sure what the FSF menu bindings are. I hope XEmacs + ;; doesn't need them. +) (defun emacs-lisp-byte-compile () "Byte compile the file containing the current buffer." (interactive) (if buffer-file-name + ;; XEmacs change. Force buffer save first (progn (save-buffer) (byte-compile-file buffer-file-name)) (error "The buffer must be saved in a file first."))) +(defun emacs-lisp-byte-compile-and-load () + "Byte-compile the current file (if it has changed), then load compiled code." + (interactive) + (or buffer-file-name + (error "The buffer must be saved in a file first")) + (require 'bytecomp) + ;; Recompile if file or buffer has changed since last compilation. + (if (and (buffer-modified-p) + (y-or-n-p (format "save buffer %s first? " (buffer-name)))) + (save-buffer)) + (let ((compiled-file-name (byte-compile-dest-file buffer-file-name))) + (if (file-newer-than-file-p compiled-file-name buffer-file-name) + (load-file compiled-file-name) + (byte-compile-file buffer-file-name t)))) + (defun emacs-lisp-mode () "Major mode for editing Lisp code to run in Emacs. Commands: @@ -222,6 +258,7 @@ (kill-all-local-variables) (use-local-map emacs-lisp-mode-map) (set-syntax-table emacs-lisp-mode-syntax-table) + ;; XEmacs changes (setq major-mode 'emacs-lisp-mode mode-popup-menu emacs-lisp-mode-popup-menu mode-name "Emacs-Lisp") @@ -241,6 +278,7 @@ (if lisp-mode-map () + ;; XEmacs changes (setq lisp-mode-map (make-sparse-keymap)) (set-keymap-name lisp-mode-map 'lisp-mode-map) (set-keymap-parents lisp-mode-map (list shared-lisp-mode-map)) @@ -270,18 +308,20 @@ (run-hooks 'lisp-mode-hook)) ;; This will do unless shell.el is loaded. +;; XEmacs change (defun lisp-send-defun () "Send the current defun to the Lisp process made by \\[run-lisp]." (interactive) (error "Process lisp does not exist")) ;; XEmacs change: emacs-lisp-mode-map is a more appropriate parent. -(defvar lisp-interaction-mode-map nil +(defvar lisp-interaction-mode-map () "Keymap for Lisp Interaction moe. -All commands in `emacs-lisp-mode-map' are inherited by this map.") +All commands in `shared-lisp-mode-map' are inherited by this map.") (if lisp-interaction-mode-map () + ;; XEmacs set keymap our way (setq lisp-interaction-mode-map (make-sparse-keymap)) (set-keymap-name lisp-interaction-mode-map 'lisp-interaction-mode-map) (set-keymap-parents lisp-interaction-mode-map (list emacs-lisp-mode-map)) @@ -296,16 +336,18 @@ Commands: Delete converts tabs to spaces as it moves back. -Paragraphs are separated only by blank lines. Semicolons start comments. +Paragraphs are separated only by blank lines. +Semicolons start comments. \\{lisp-interaction-mode-map} Entry to this mode calls the value of `lisp-interaction-mode-hook' if that value is non-nil." (interactive) (kill-all-local-variables) (use-local-map lisp-interaction-mode-map) - (setq major-mode 'lisp-interaction-mode - mode-popup-menu lisp-interaction-mode-popup-menu - mode-name "Lisp Interaction") + (setq major-mode 'lisp-interaction-mode) + (setq mode-name "Lisp Interaction") + ;; XEmacs change + (setq mode-popup-menu lisp-interaction-mode-popup-menu) (set-syntax-table emacs-lisp-mode-syntax-table) (lisp-mode-variables nil) (run-hooks 'lisp-interaction-mode-hook)) @@ -318,6 +360,7 @@ (eval-last-sexp t) (terpri))) +;; XEmacs change (defun eval-interactive (expr) "Like `eval' except that it transforms defvars to defconsts." ;; by Stig@hackvan.com @@ -330,13 +373,14 @@ (message "")) (eval expr))) -(defun eval-last-sexp (eval-last-sexp-arg-internal) ;dynamic scoping wonderment +(defun eval-last-sexp (eval-last-sexp-arg-internal) "Evaluate sexp before point; print value in minibuffer. With argument, print output into current buffer." (interactive "P") (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)) (opoint (point))) (prin1 (let ((stab (syntax-table))) + ;; XEmacs change use eval-interactive not eval (eval-interactive (unwind-protect (save-excursion (set-syntax-table emacs-lisp-mode-syntax-table) @@ -346,16 +390,21 @@ (read (current-buffer)))) (set-syntax-table stab))))))) -(defun eval-defun (eval-defun-arg-internal) ;dynamic scoping wonderment +(defun eval-defun (eval-defun-arg-internal) "Evaluate defun that point is in or before. Print value in minibuffer. With argument, insert value in current buffer after the defun." (interactive "P") - (let ((standard-output (if eval-defun-arg-internal (current-buffer) t))) - (prin1 (eval-interactive (save-excursion - (end-of-defun) - (beginning-of-defun) - (read (current-buffer))))))) + ;; XEmacs: FSF version works, so use it + (let ((standard-output (if eval-defun-arg-internal (current-buffer) t)) + (form (save-excursion + (end-of-defun) + (beginning-of-defun) + (read (current-buffer))))) + (if (and (eq (car form) 'defvar) + (cdr-safe (cdr-safe form))) + (setq form (cons 'defconst (cdr form)))) + (prin1 (eval form)))) (defun lisp-comment-indent () (if (looking-at "\\s<\\s<\\s<") @@ -367,6 +416,7 @@ (max (if (bolp) 0 (1+ (current-column))) comment-column)))) +;; XEmacs change (defun lisp-indent-for-comment () "Indent this line's comment appropriately, or insert an empty comment. If adding a new comment on a blank line, use `block-comment-start' instead @@ -435,6 +485,7 @@ (save-excursion (beginning-of-line) (let ((indent-point (point)) + ;; XEmacs change (remove paren-depth) state ;;paren-depth ;; setting this to a number inhibits calling hook (desired-indent nil) @@ -449,6 +500,7 @@ ;; Find innermost containing sexp (while (and retry state + ;; XEmacs change (remove paren-depth) (> ;;(setq paren-depth (elt state 0)) (elt state 0) 0)) @@ -517,6 +569,7 @@ (not retry)) (or (funcall lisp-indent-function indent-point state) normal-indent)) + ;; XEmacs change: ;; lisp-indent-offset shouldn't override lisp-indent-function ! ((and (integerp lisp-indent-offset) containing-sexp) ;; Indent by constant offset @@ -551,7 +604,7 @@ (progn (forward-sexp 1) (point)))) method) (setq method (or (get (intern-soft function) 'lisp-indent-function) - (get (intern-soft function) 'lisp-indent-hook))) + (get (intern-soft function) 'lisp-indent-hook))) (cond ((or (eq method 'defun) (and (null method) (> (length function) 3) @@ -649,21 +702,15 @@ ENDPOS is encountered." (interactive) (let ((indent-stack (list nil)) - (next-depth 0) + (next-depth 0) ;; If ENDPOS is non-nil, use nil as STARTING-POINT ;; so that calculate-lisp-indent will find the beginning of ;; the defun we are in. ;; If ENDPOS is nil, it is safe not to scan before point ;; since every line we indent is more deeply nested than point is. (starting-point (if endpos nil (point))) - (last-point (point)) - last-depth - bol - (outer-loop-done nil) - inner-loop-done - state - this-indent) - ;; Get error now if we don't have a complete sexp after point. + (last-point (point)) + last-depth bol outer-loop-done inner-loop-done state this-indent) (or endpos ;; Get error now if we don't have a complete sexp after point. (save-excursion (forward-sexp 1))) @@ -700,15 +747,6 @@ (forward-line 1) (setcar (nthcdr 5 state) nil)) (setq inner-loop-done t))) -; Chuck had a comment here saying that the alternate code -; (the next sexp after this one) led to an infine loop. -; Since merging some changes in from FSF 19.30, I'm going -; to try going the FSF way and see what happens. -; (and endpos -; (while (<= next-depth 0) ;XEmacs change -; (setq indent-stack (append indent-stack (list nil))) -; (setq next-depth (1+ next-depth)) -; (setq last-depth (1+ last-depth)))) (and endpos (<= next-depth 0) (progn @@ -717,7 +755,7 @@ last-depth (- last-depth next-depth) next-depth 0))) (or outer-loop-done endpos - (setq outer-loop-done (<= next-depth 0))) + (setq outer-loop-done (<= next-depth 0))) (if outer-loop-done (forward-line 1) (while (> last-depth next-depth) @@ -739,9 +777,8 @@ (>= (car indent-stack) 0)) (setq this-indent (car indent-stack)) (let ((val (calculate-lisp-indent - (if (car indent-stack) - (- (car indent-stack)) - starting-point)))) + (if (car indent-stack) (- (car indent-stack)) + starting-point)))) (if (integerp val) (setcar indent-stack (setq this-indent val)) @@ -763,7 +800,6 @@ (lisp-indent-line)) (indent-sexp endmark) (set-marker endmark nil)))) - ;;;; Lisp paragraph filling commands. @@ -777,6 +813,9 @@ ;; Non-nil if the current line contains a comment. has-comment + ;; Non-nil if the current line contains code and a comment. + has-code-and-comment + ;; If has-comment, the appropriate fill-prefix for the comment. comment-fill-prefix ) @@ -795,50 +834,87 @@ ;; A line with some code, followed by a comment? Remember that the ;; semi which starts the comment shouldn't be part of a string or ;; character. - ((progn - (while (not (looking-at ";\\|$")) - (skip-chars-forward "^;\n\"\\\\?") - (cond - ((eq (char-after (point)) ?\\) (forward-char 2)) - ((memq (char-after (point)) '(?\" ??)) (forward-sexp 1)))) - (looking-at ";+[\t ]*")) - (setq has-comment t) + ;; XEmacs Try this the FSF and see if it works. +; ((progn +; (while (not (looking-at ";\\|$")) +; (skip-chars-forward "^;\n\"\\\\?") +; (cond +; ((eq (char-after (point)) ?\\) (forward-char 2)) +; ((memq (char-after (point)) '(?\" ??)) (forward-sexp 1)))) +; (looking-at ";+[\t ]*")) +; (setq has-comment t) + ((condition-case nil + (save-restriction + (narrow-to-region (point-min) + (save-excursion (end-of-line) (point))) + (while (not (looking-at ";\\|$")) + (skip-chars-forward "^;\n\"\\\\?") + (cond + ((eq (char-after (point)) ?\\) (forward-char 2)) + ((memq (char-after (point)) '(?\" ??)) (forward-sexp 1)))) + (looking-at ";+[\t ]*")) + (error nil)) + (setq has-comment t has-code-and-comment t) (setq comment-fill-prefix - (concat (make-string (current-column) ? ) + (concat (make-string (/ (current-column) 8) ?\t) + (make-string (% (current-column) 8) ?\ ) (buffer-substring (match-beginning 0) (match-end 0))))))) (if (not has-comment) (fill-paragraph justify) ;; Narrow to include only the comment, and then fill the region. - (save-restriction - (narrow-to-region - ;; Find the first line we should include in the region to fill. - (save-excursion - (while (and (zerop (forward-line -1)) - (looking-at "^[ \t]*;"))) - ;; We may have gone to far. Go forward again. - (or (looking-at "^[ \t]*;") - (forward-line 1)) - (point)) - ;; Find the beginning of the first line past the region to fill. - (save-excursion - (while (progn (forward-line 1) + (save-excursion + (save-restriction + (beginning-of-line) + (narrow-to-region + ;; Find the first line we should include in the region to fill. + (save-excursion + (while (and (zerop (forward-line -1)) (looking-at "^[ \t]*;"))) - (point))) + ;; We may have gone too far. Go forward again. + (or (looking-at ".*;") + (forward-line 1)) + (point)) + ;; Find the beginning of the first line past the region to fill. + (save-excursion + (while (progn (forward-line 1) + (looking-at "^[ \t]*;"))) + (point))) - ;; Lines with only semicolons on them can be paragraph boundaries. - (let ((paragraph-start (concat paragraph-start "\\|[ \t;]*$")) - (paragraph-separate (concat paragraph-start "\\|[ \t;]*$")) - (fill-prefix comment-fill-prefix)) - (fill-paragraph justify)))) + ;; Lines with only semicolons on them can be paragraph boundaries. + (let* ((paragraph-start (concat paragraph-start "\\|[ \t;]*$")) + (paragraph-separate (concat paragraph-start "\\|[ \t;]*$")) + (paragraph-ignore-fill-prefix nil) + (fill-prefix comment-fill-prefix) + (after-line (if has-code-and-comment + (save-excursion + (forward-line 1) (point)))) + (end (progn + (forward-paragraph) + (or (bolp) (newline 1)) + (point))) + ;; If this comment starts on a line with code, + ;; include that like in the filling. + (beg (progn (backward-paragraph) + (if (eq (point) after-line) + (forward-line -1)) + (point)))) + (fill-region-as-paragraph beg end + justify nil + (save-excursion + (goto-char beg) + (if (looking-at fill-prefix) + nil + (re-search-forward comment-start-skip) + (point)))))))) t)) - (defun indent-code-rigidly (start end arg &optional nochange-regexp) "Indent all lines of code, starting in the region, sideways by ARG columns. -Does not affect lines starting inside comments or strings, -assuming that the start of the region is not inside them. +Does not affect lines starting inside comments or strings, assuming that +the start of the region is not inside them. + Called from a program, takes args START, END, COLUMNS and NOCHANGE-REGEXP. The last is a regexp which, if matched at the beginning of a line, means don't indent that line."