emacs: lisp/emacs-lisp/lisp-mode.el comparison

comparison lisp/emacs-lisp/lisp-mode.el @ 88155:d7ddb3e565de

sync with trunk

author	Henrik Enberg <henrik.enberg@telia.com>
date	Mon, 16 Jan 2006 00:03:54 +0000
parents	0d8b17d428b5
children

comparison

equal deleted inserted replaced

-:8ce476d3ba36
+:d7ddb3e565de
 ;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands
-;; Copyright (C) 1985, 1986, 1999, 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005 Free Software Foundation, Inc.
 ;; Maintainer: FSF
 ;; Keywords: lisp, languages
 ;; This file is part of GNU Emacs.
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02111-1307, USA.
+;; Boston, MA 02110-1301, USA.
 ;;; Commentary:
 ;; The base major mode for editing Lisp code (used also for Emacs Lisp).
 ;; This mode is documented in the Emacs manual.
 ;;; Code:
+(defvar font-lock-comment-face)
+(defvar font-lock-doc-face)
+(defvar font-lock-keywords-case-fold-search)
+(defvar font-lock-string-face)
 (defvar lisp-mode-abbrev-table nil)
 (defvar emacs-lisp-mode-syntax-table
 (let ((table (make-syntax-table)))
 	(setq i (1+ i)))
 (setq i (1+ ?z))
 (while (< i 128)
 	(modify-syntax-entry i "_   " table)
 	(setq i (1+ i)))
-(modify-syntax-entry ?  "    " table)
+(modify-syntax-entry ?\s "    " table)
 (modify-syntax-entry ?\t "    " table)
 (modify-syntax-entry ?\f "    " table)
 (modify-syntax-entry ?\n ">   " table)
-;; Give CR the same syntax as newline, for selective-display.
+;; This is probably obsolete since nowadays such features use overlays.
-(modify-syntax-entry ?\^m ">   " table)
+;; ;; Give CR the same syntax as newline, for selective-display.
+;; (modify-syntax-entry ?\^m ">   " table)
 (modify-syntax-entry ?\; "<   " table)
 (modify-syntax-entry ?` "'   " table)
 (modify-syntax-entry ?' "'   " table)
 (modify-syntax-entry ?, "'   " table)
+(modify-syntax-entry ?@ "'   " table)
 ;; Used to be singlequote; changed for flonums.
 (modify-syntax-entry ?. "_   " table)
 (modify-syntax-entry ?# "'   " table)
 (modify-syntax-entry ?\" "\"    " table)
 (modify-syntax-entry ?\\ "\\   " table)
 (defvar lisp-mode-syntax-table
 (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
 (modify-syntax-entry ?\[ "_   " table)
 (modify-syntax-entry ?\] "_   " table)
-(modify-syntax-entry ?# "' 14bn" table)
+(modify-syntax-entry ?# "' 14b" table)
-(modify-syntax-entry ?| "\" 23b" table)
+(modify-syntax-entry ?| "\" 23bn" table)
 table))
 (define-abbrev-table 'lisp-mode-abbrev-table ())
 (defvar lisp-imenu-generic-expression
 	 (purecopy (concat "^\\s-*("
 			   (eval-when-compile
 			     (regexp-opt
 			      '("defun" "defun*" "defsubst" "defmacro"
 				"defadvice" "define-skeleton"
-				"define-minor-mode" "define-derived-mode"
+				"define-minor-mode" "define-global-minor-mode"
+				"define-derived-mode" "define-generic-mode"
 				"define-compiler-macro" "define-modify-macro"
 				"defsetf" "define-setf-expander"
 				"define-method-combination"
 				"defgeneric" "defmethod") t))
-			   "\\s-+\\(\\sw\\(\\sw\\|\\s_\\)+\\)"))
+			   "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"))
 	 2)
 (list (purecopy "Variables")
 	 (purecopy (concat "^\\s-*("
 			   (eval-when-compile
 			     (regexp-opt
 			      '("defvar" "defconst" "defconstant" "defcustom"
 				"defparameter" "define-symbol-macro") t))
-			   "\\s-+\\(\\sw\\(\\sw\\|\\s_\\)+\\)"))
+			   "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"))
 	 2)
 (list (purecopy "Types")
 	 (purecopy (concat "^\\s-*("
 			   (eval-when-compile
 			     (regexp-opt
 			      '("defgroup" "deftheme" "deftype" "defstruct"
 				"defclass" "define-condition" "define-widget"
 				"defface" "defpackage") t))
-			   "\\s-+'?\\(\\sw\\(\\sw\\|\\s_\\)+\\)"))
+			   "\\s-+'?\\(\\(\\sw\\|\\s_\\)+\\)"))
 	 2))
 "Imenu generic expression for Lisp mode.  See `imenu-generic-expression'.")
 ;; This was originally in autoload.el and is still used there.
 (put 'deftheme 'doc-string-elt 2)
 (put 'defconst 'doc-string-elt 3)
 (put 'defmacro 'doc-string-elt 3)
 (put 'defmacro* 'doc-string-elt 3)
 (put 'defsubst 'doc-string-elt 3)
+(put 'defstruct 'doc-string-elt 2)
 (put 'define-skeleton 'doc-string-elt 2)
 (put 'define-derived-mode 'doc-string-elt 4)
+(put 'define-compilation-mode 'doc-string-elt 3)
 (put 'easy-mmode-define-minor-mode 'doc-string-elt 2)
 (put 'define-minor-mode 'doc-string-elt 2)
+(put 'easy-mmode-define-global-mode 'doc-string-elt 2)
+(put 'define-global-minor-mode 'doc-string-elt 2)
 (put 'define-generic-mode 'doc-string-elt 7)
-;; define-global-mode has no explicit docstring.
-(put 'easy-mmode-define-global-mode 'doc-string-elt 0)
 (put 'define-ibuffer-filter 'doc-string-elt 2)
 (put 'define-ibuffer-op 'doc-string-elt 3)
 (put 'define-ibuffer-sorter 'doc-string-elt 2)
+(put 'lambda 'doc-string-elt 2)
+(put 'defalias 'doc-string-elt 3)
+(put 'defvaralias 'doc-string-elt 3)
+(put 'define-category 'doc-string-elt 2)
+(defvar lisp-doc-string-elt-property 'doc-string-elt
+"The symbol property that holds the docstring position info.")
 (defun lisp-font-lock-syntactic-face-function (state)
 (if (nth 3 state)
-(if (and (eq (nth 0 state) 1)
+;; This might be a (doc)string or a |...| symbol.
-	       ;; This might be a docstring.
+(let ((startpos (nth 8 state)))
-	       (save-excursion
+(if (eq (char-after startpos) ?|)
-		 (let ((n 0))
+;; This is not a string, but a |...| symbol.
-		   (goto-char (nth 8 state))
+nil
-		   (condition-case nil
+(let* ((listbeg (nth 1 state))
-		       (while (progn (backward-sexp 1) (setq n (1+ n))))
+(firstsym (and listbeg
-		     (scan-error nil))
+(save-excursion
-		   (when (> n 0)
+(goto-char listbeg)
-		     (let ((sym (intern-soft
+(and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)")
-				 (buffer-substring
+(match-string 1)))))
-				  (point) (progn (forward-sexp 1) (point))))))
+(docelt (and firstsym (get (intern-soft firstsym)
-		       (eq n (or (get sym 'doc-string-elt) 3)))))))
+lisp-doc-string-elt-property))))
-	  font-lock-doc-face
+(if (and docelt
-	font-lock-string-face)
+;; It's a string in a form that can have a docstring.
+;; Check whether it's in docstring position.
+(save-excursion
+(when (functionp docelt)
+(goto-char (match-end 1))
+(setq docelt (funcall docelt)))
+(goto-char listbeg)
+(forward-char 1)
+(condition-case nil
+(while (and (> docelt 0) (< (point) startpos)
+(progn (forward-sexp 1) t))
+(setq docelt (1- docelt)))
+(error nil))
+(and (zerop docelt) (<= (point) startpos)
+(progn (forward-comment (point-max)) t)
+(= (point) (nth 8 state)))))
+font-lock-doc-face
+font-lock-string-face))))
 font-lock-comment-face))
 ;; The LISP-SYNTAX argument is used by code in inf-lisp.el and is
 ;; (uselessly) passed from pp.el, chistory.el, gnus-kill.el and score-mode.el
 (defun lisp-mode-variables (&optional lisp-syntax)
 (setq local-abbrev-table lisp-mode-abbrev-table)
 (make-local-variable 'paragraph-ignore-fill-prefix)
 (setq paragraph-ignore-fill-prefix t)
 (make-local-variable 'fill-paragraph-function)
 (setq fill-paragraph-function 'lisp-fill-paragraph)
+;; Adaptive fill mode gets the fill wrong for a one-line paragraph made of
+;; a single docstring.  Let's fix it here.
+(set (make-local-variable 'adaptive-fill-function)
+(lambda () (if (looking-at "\\s-+\"[^\n\"]+\"\\s-*$") "")))
 ;; 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.
 ;;  I believe that newcomment's auto-fill code properly deals with it  -stef
 ;;(set (make-local-variable 'adaptive-fill-mode) nil)
-(make-local-variable 'normal-auto-fill-function)
-(setq normal-auto-fill-function 'lisp-mode-auto-fill)
 (make-local-variable 'indent-line-function)
 (setq indent-line-function 'lisp-indent-line)
 (make-local-variable 'indent-region-function)
 (setq indent-region-function 'lisp-indent-region)
 (make-local-variable 'parse-sexp-ignore-comments)
 (setq parse-sexp-ignore-comments t)
 (make-local-variable 'outline-regexp)
-(setq outline-regexp ";;;;* \\|(")
+(setq outline-regexp ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(")
 (make-local-variable 'outline-level)
 (setq outline-level 'lisp-outline-level)
 (make-local-variable 'comment-start)
 (setq comment-start ";")
 (make-local-variable 'comment-start-skip)
 ;; 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 'font-lock-comment-start-skip)
+;; Font lock mode uses this only when it KNOWS a comment is starting.
+(setq font-lock-comment-start-skip ";+ *")
 (make-local-variable 'comment-add)
 (setq comment-add 1)			;default to `;;' in comment-region
 (make-local-variable 'comment-column)
 (setq comment-column 40)
-(make-local-variable 'comment-indent-function)
+;; Don't get confused by `;' in doc strings when paragraph-filling.
-(setq comment-indent-function 'lisp-comment-indent)
+(set (make-local-variable 'comment-use-global-state) t)
 (make-local-variable 'imenu-generic-expression)
 (setq imenu-generic-expression lisp-imenu-generic-expression)
 (make-local-variable 'multibyte-syntax-as-symbol)
 (setq multibyte-syntax-as-symbol t)
 (set (make-local-variable 'syntax-begin-function) 'beginning-of-defun)
 (setq font-lock-defaults
 	'((lisp-font-lock-keywords
 	   lisp-font-lock-keywords-1 lisp-font-lock-keywords-2)
-	  nil nil (("+-*/.<>=!?$%_&~^:" . "w")) beginning-of-defun
+	  nil nil (("+-*/.<>=!?$%_&~^:@" . "w")) nil
 	  (font-lock-mark-block-function . mark-defun)
 	  (font-lock-syntactic-face-function
 	   . lisp-font-lock-syntactic-face-function))))
 (defun lisp-outline-level ()
 "Lisp mode `outline-level' function."
-(if (looking-at "(")
+(let ((len (- (match-end 0) (match-beginning 0))))
-1000
+(if (looking-at "(\\|;;;###autoload")
-(looking-at outline-regexp)
+	1000
-(- (match-end 0) (match-beginning 0))))
+len)))
 (defvar lisp-mode-shared-map
 (let ((map (make-sparse-keymap)))
 (define-key map "\t" 'lisp-indent-line)
 (define-key map "\e\C-q" 'indent-sexp)
 (let ((map (make-sparse-keymap "Emacs-Lisp")))
 (setq emacs-lisp-mode-map (make-sparse-keymap))
 (set-keymap-parent emacs-lisp-mode-map lisp-mode-shared-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-q" 'indent-pp-sexp)
 (define-key emacs-lisp-mode-map [menu-bar] (make-sparse-keymap))
 (define-key emacs-lisp-mode-map [menu-bar emacs-lisp]
 (cons "Emacs-Lisp" map))
 (define-key map [edebug-defun]
 '("Instrument Function for Debugging" . edebug-defun))
 (set-syntax-table emacs-lisp-mode-syntax-table)
 (setq major-mode 'emacs-lisp-mode)
 (setq mode-name "Emacs-Lisp")
 (lisp-mode-variables)
 (setq imenu-case-fold-search nil)
-(run-hooks 'emacs-lisp-mode-hook))
+(run-mode-hooks 'emacs-lisp-mode-hook))
+(put 'emacs-lisp-mode 'custom-mode-group 'lisp)
 (defvar lisp-mode-map
 (let ((map (make-sparse-keymap)))
 (set-keymap-parent map lisp-mode-shared-map)
 (define-key map "\e\C-x" 'lisp-eval-defun)
 "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
 (make-local-variable 'font-lock-keywords-case-fold-search)
 (setq font-lock-keywords-case-fold-search t)
 (setq imenu-case-fold-search t)
 (set-syntax-table lisp-mode-syntax-table)
-(run-hooks 'lisp-mode-hook))
+(run-mode-hooks 'lisp-mode-hook))
+(put 'lisp-mode 'find-tag-default-function 'lisp-find-tag-default)
+(defun lisp-find-tag-default ()
+(let ((default (find-tag-default)))
+(when (stringp default)
+(if (string-match ":+" default)
+(substring default (match-end 0))
+	default))))
+;; Used in old LispM code.
+(defalias 'common-lisp-mode 'lisp-mode)
 ;; This will do unless inf-lisp.el is loaded.
 (defun lisp-eval-defun (&optional and-go)
 "Send the current defun to the Lisp process made by \\[run-lisp]."
 (interactive)
 (defvar lisp-interaction-mode-map
 (let ((map (make-sparse-keymap)))
 (set-keymap-parent map lisp-mode-shared-map)
 (define-key map "\e\C-x" 'eval-defun)
+(define-key map "\e\C-q" 'indent-pp-sexp)
 (define-key map "\e\t" 'lisp-complete-symbol)
 (define-key map "\n" 'eval-print-last-sexp)
 map)
 "Keymap for Lisp Interaction mode.
 All commands in `lisp-mode-shared-map' are inherited by this map.")
 		     help-echo "RET, mouse-2: toggle abbreviated display"
 		     rear-nonsticky (mouse-face keymap help-echo
 						printed-value)))))
-(defun last-sexp-toggle-display ()
+(defun last-sexp-toggle-display (&optional arg)
 "Toggle between abbreviated and unabbreviated printed representations."
-(interactive)
+(interactive "P")
-(let ((value (get-text-property (point) 'printed-value)))
+(save-restriction
-(when value
+(widen)
-(let ((beg (or (previous-single-property-change (point) 'printed-value) (point)))
+(let ((value (get-text-property (point) 'printed-value)))
-	    (end (or (next-single-char-property-change (point) 'printed-value) (point)))
+(when value
-	    (standard-output (current-buffer))
+	(let ((beg (or (previous-single-property-change (min (point-max) (1+ (point)))
-	    (point (point)))
+							'printed-value)
-	(delete-region beg end)
+		       (point)))
-	(insert (nth 1 value))
+	      (end (or (next-single-char-property-change (point) 'printed-value) (point)))
-	(last-sexp-setup-props beg (point)
+	      (standard-output (current-buffer))
-			       (nth 0 value)
+	      (point (point)))
-			       (nth 2 value)
+	  (delete-region beg end)
-			       (nth 1 value))
+	  (insert (nth 1 value))
-	(goto-char (min (point-max) point))))))
+	  (last-sexp-setup-props beg (point)
+				 (nth 0 value)
+				 (nth 2 value)
+				 (nth 1 value))
+	  (goto-char (min (point-max) point)))))))
+(defun prin1-char (char)
+"Return a string representing CHAR as a character rather than as an integer.
+If CHAR is not a character, return nil."
+(and (integerp char)
+(eventp char)
+(let ((c (event-basic-type char))
+	     (mods (event-modifiers char))
+	     string)
+	 ;; Prevent ?A from turning into ?\S-a.
+	 (if (and (memq 'shift mods)
+		  (zerop (logand char ?\S-\^@))
+		  (not (let ((case-fold-search nil))
+			 (char-equal c (upcase c)))))
+	     (setq c (upcase c) mods nil))
+	 ;; What string are we considering using?
+	 (condition-case nil
+	     (setq string
+		   (concat
+		    "?"
+		    (mapconcat
+		     (lambda (modif)
+		       (cond ((eq modif 'super) "\\s-")
+			     (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-))))
+		     mods "")
+		    (cond
+		     ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c))
+		     ((eq c 127) "\\C-?")
+		     (t
+		      (string c)))))
+	   (error nil))
+	 ;; Verify the string reads a CHAR, not to some other character.
+	 ;; If it doesn't, return nil instead.
+	 (and string
+	      (= (car (read-from-string string)) char)
+	      string))))
 (defun eval-last-sexp-1 (eval-last-sexp-arg-internal)
 "Evaluate sexp before point; print value in minibuffer.
 With argument, print output into current buffer."
 (let ((value
 	   (eval (let ((stab (syntax-table))
 		       (opoint (point))
 		       ignore-quotes
 		       expr)
-		   (unwind-protect
+		   (save-excursion
-		       (save-excursion
+		     (with-syntax-table emacs-lisp-mode-syntax-table
-			 (set-syntax-table emacs-lisp-mode-syntax-table)
+		       ;; If this sexp appears to be enclosed in `...'
-			 ;; If this sexp appears to be enclosed in `...'
+		       ;; then ignore the surrounding quotes.
-			 ;; then ignore the surrounding quotes.
+		       (setq ignore-quotes
-			 (setq ignore-quotes
+			     (or (eq (following-char) ?\')
-			       (or (eq (following-char) ?\')
+				 (eq (preceding-char) ?\')))
-				   (eq (preceding-char) ?\')))
+		       (forward-sexp -1)
-			 (forward-sexp -1)
+		       ;; If we were after `?\e' (or similar case),
-			 ;; If we were after `?\e' (or similar case),
+		       ;; use the whole thing, not just the `e'.
-			 ;; use the whole thing, not just the `e'.
+		       (when (eq (preceding-char) ?\\)
-			 (when (eq (preceding-char) ?\\)
+			 (forward-char -1)
-			   (forward-char -1)
+			 (when (eq (preceding-char) ??)
-			   (when (eq (preceding-char) ??)
+			   (forward-char -1)))
-			     (forward-char -1)))
+		       ;; Skip over `#N='s.
-			 ;; Skip over `#N='s.
+		       (when (eq (preceding-char) ?=)
-			 (when (eq (preceding-char) ?=)
+			 (let (labeled-p)
-			   (let (labeled-p)
+			   (save-excursion
-			     (save-excursion
+			     (skip-chars-backward "0-9#=")
-			       (skip-chars-backward "0-9#=")
+			     (setq labeled-p (looking-at "\\(#[0-9]+=\\)+")))
-			       (setq labeled-p (looking-at "\\(#[0-9]+=\\)+")))
+			   (when labeled-p
-			     (when labeled-p
+			     (forward-sexp -1))))
-			       (forward-sexp -1))))
+		       (save-restriction
-			 (save-restriction
+			 ;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in
-			   ;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in
+			 ;; `variable' so that the value is returned, not the
-			   ;; `variable' so that the value is returned, not the
+			 ;; name
-			   ;; name
+			 (if (and ignore-quotes
-			   (if (and ignore-quotes
+				  (eq (following-char) ?`))
-				    (eq (following-char) ?`))
+			     (forward-char))
-			       (forward-char))
+			 (narrow-to-region (point-min) opoint)
-			   (narrow-to-region (point-min) opoint)
+			 (setq expr (read (current-buffer)))
-			   (setq expr (read (current-buffer)))
+			 ;; If it's an (interactive ...) form, it's more
-			   ;; If it's an (interactive ...) form, it's more
+			 ;; useful to show how an interactive call would
-			   ;; useful to show how an interactive call would
+			 ;; use it.
-			   ;; use it.
+			 (and (consp expr)
-			   (and (consp expr)
+			      (eq (car expr) 'interactive)
-				(eq (car expr) 'interactive)
+			      (setq expr
-				(setq expr
+				    (list 'call-interactively
-				      (list 'call-interactively
+					  (list 'quote
-					    (list 'quote
+						(list 'lambda
-						  (list 'lambda
+						      '(&rest args)
-							'(&rest args)
+						      expr
-							expr
+						      'args)))))
-							'args)))))
+			 expr)))))))
-			   expr))
+(eval-last-sexp-print-value value))))
-		     (set-syntax-table stab))))))
-(let ((unabbreviated (let ((print-length nil) (print-level nil))
+(defun eval-last-sexp-print-value (value)
-			     (prin1-to-string value)))
+(let ((unabbreviated (let ((print-length nil) (print-level nil))
-	    (print-length eval-expression-print-length)
+			 (prin1-to-string value)))
-	    (print-level eval-expression-print-level)
+	(print-length eval-expression-print-length)
-	    (beg (point))
+	(print-level eval-expression-print-level)
-	    end)
+	(beg (point))
-	(prog1
+	end)
-	    (prin1 value)
+(prog1
-	  (setq end (point))
+	(prin1 value)
-	  (when (and (bufferp standard-output)
+(let ((str (eval-expression-print-format value)))
-		     (or (not (null print-length))
+	(if str (princ str)))
-			 (not (null print-level)))
+(setq end (point))
-		     (not (string= unabbreviated
+(when (and (bufferp standard-output)
-				   (buffer-substring-no-properties beg end))))
+		 (or (not (null print-length))
-	    (last-sexp-setup-props beg end value
+		     (not (null print-level)))
-				   unabbreviated
+		 (not (string= unabbreviated
-				   (buffer-substring-no-properties beg end))
+			       (buffer-substring-no-properties beg end))))
-	    ))))))
+	(last-sexp-setup-props beg end value
+			       unabbreviated
+			       (buffer-substring-no-properties beg end))
+	))))
+(defvar eval-last-sexp-fake-value (make-symbol "t"))
 (defun eval-last-sexp (eval-last-sexp-arg-internal)
 "Evaluate sexp before point; print value in minibuffer.
 Interactively, with prefix argument, print output into current buffer."
 (interactive "P")
 (if (null eval-expression-debug-on-error)
 (eval-last-sexp-1 eval-last-sexp-arg-internal)
-(let ((old-value (make-symbol "t")) new-value value)
+(let ((old-value eval-last-sexp-fake-value) new-value value)
 (let ((debug-on-error old-value))
 	(setq value (eval-last-sexp-1 eval-last-sexp-arg-internal))
 	(setq new-value debug-on-error))
 (unless (eq old-value new-value)
 	(setq debug-on-error new-value))
 value)))
 (defun eval-defun-1 (form)
-"Change defvar into defconst within FORM.
+"Treat some expressions specially.
-Likewise for other constructs as necessary."
+Reset the `defvar' and `defcustom' variables to the initial value.
+Reinitialize the face according to the `defface' specification."
 ;; The code in edebug-defun should be consistent with this, but not
 ;; the same, since this gets a macroexpended form.
 (cond ((not (listp form))
 	 form)
 	((and (eq (car form) 'defvar)
-	      (cdr-safe (cdr-safe form)))
+	      (cdr-safe (cdr-safe form))
-	 ;; Force variable to be bound.
+	      (boundp (cadr form)))
-	 (cons 'defconst (cdr form)))
+	 ;; Force variable to be re-set.
+	 `(progn (defvar ,(nth 1 form) nil ,@(nthcdr 3 form))
+		 (setq-default ,(nth 1 form) ,(nth 2 form))))
 	;; `defcustom' is now macroexpanded to
 	;; `custom-declare-variable' with a quoted value arg.
 	((and (eq (car form) 'custom-declare-variable)
 	      (default-boundp (eval (nth 1 form))))
 	 ;; Force variable to be bound.
 	 (set-default (eval (nth 1 form)) (eval (nth 1 (nth 2 form))))
 	 form)
+	;; `defface' is macroexpanded to `custom-declare-face'.
+	((eq (car form) 'custom-declare-face)
+	 ;; Reset the face.
+	 (setq face-new-frame-defaults
+	       (assq-delete-all (eval (nth 1 form)) face-new-frame-defaults))
+	 (put (eval (nth 1 form)) 'face-defface-spec nil)
+	 ;; Setting `customized-face' to the new spec after calling
+	 ;; the form, but preserving the old saved spec in `saved-face',
+	 ;; imitates the situation when the new face spec is set
+	 ;; temporarily for the current session in the customize
+	 ;; buffer, thus allowing `face-user-default-spec' to use the
+	 ;; new customized spec instead of the saved spec.
+	 ;; Resetting `saved-face' temporarily to nil is needed to let
+	 ;; `defface' change the spec, regardless of a saved spec.
+	 (prog1 `(prog1 ,form
+		   (put ,(nth 1 form) 'saved-face
+			',(get (eval (nth 1 form)) 'saved-face))
+		   (put ,(nth 1 form) 'customized-face
+			,(nth 2 form)))
+	   (put (eval (nth 1 form)) 'saved-face nil)))
 	((eq (car form) 'progn)
 	 (cons 'progn (mapcar 'eval-defun-1 (cdr form))))
 	(t form)))
 (defun eval-defun-2 ()
 	   (end-of-defun)
 	   (beginning-of-defun)
 	   (setq beg (point))
 	   (setq form (read (current-buffer)))
 	   (setq end (point)))
-	 ;; Alter the form if necessary, changing defvar into defconst, etc.
+	 ;; Alter the form if necessary.
 	 (setq form (eval-defun-1 (macroexpand form)))
 	 (list beg end standard-output
 	       `(lambda (ignore)
 		 ;; Skipping to the end of the specified region
 		 ;; will make eval-region return.
 	       (setq new-value debug-on-error))
 	     (unless (eq old-value new-value)
 	       (setq debug-on-error new-value))
 	     value)))))
+;; May still be used by some external Lisp-mode variant.
-(defun lisp-comment-indent ()
+(define-obsolete-function-alias 'lisp-comment-indent 'comment-indent-default)
-(if (looking-at "\\s<\\s<\\s<")
-(current-column)
-(if (looking-at "\\s<\\s<")
-	(let ((tem (or (calculate-lisp-indent) (current-column))))
-	  (if (listp tem) (car tem) tem))
-(skip-chars-backward " \t")
-(max (if (bolp) 0 (1+ (current-column)))
-	   comment-column))))
 ;; This function just forces a more costly detection of comments (using
 ;; parse-partial-sexp from beginning-of-defun).  I.e. It avoids the problem of
 ;; taking a `;' inside a string started on another line for a comment starter.
-;; Note: `newcomment' gets it right in 99% of the cases if you're using
+;; Note: `newcomment' gets it right now since we set comment-use-global-state
-;;       font-lock, anyway, so we could get rid of it.   -stef
+;; so we could get rid of it.   -stef
 (defun lisp-mode-auto-fill ()
 (if (> (current-column) (current-fill-column))
 (if (save-excursion
 	    (nth 4 (syntax-ppss (point))))
 	  (do-auto-fill)
 If the current line is in a call to a Lisp function
 which has a non-nil property `lisp-indent-function',
 that specifies how to do the indentation.  The property value can be
 * `defun', meaning indent `defun'-style;
 * an integer N, meaning indent the first N arguments specially
 like ordinary function arguments and then indent any further
-aruments like a body;
+arguments like a body;
 * a function to call just as this function was called.
 If that function returns nil, that means it doesn't specify
 the indentation.
 This function also returns nil meaning don't specify the indentation."
 (let ((normal-indent (current-column)))
 (goto-char (1+ (elt state 1)))
 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
 (not (looking-at "\\sw\\|\\s_")))
 ;; car of form doesn't seem to be a symbol
 (progn
 (if (not (> (save-excursion (forward-line 1) (point))
 calculate-lisp-indent-last-sexp))
-(progn (goto-char calculate-lisp-indent-last-sexp)
+		(progn (goto-char calculate-lisp-indent-last-sexp)
-(beginning-of-line)
+		       (beginning-of-line)
-(parse-partial-sexp (point)
+		       (parse-partial-sexp (point)
-					 calculate-lisp-indent-last-sexp 0 t)))
+					   calculate-lisp-indent-last-sexp 0 t)))
-;; Indent under the list or under the first sexp on the same
+	    ;; Indent under the list or under the first sexp on the same
-;; line as calculate-lisp-indent-last-sexp.  Note that first
+	    ;; line as calculate-lisp-indent-last-sexp.  Note that first
-;; thing on that line has to be complete sexp since we are
+	    ;; thing on that line has to be complete sexp since we are
 ;; inside the innermost containing sexp.
 (backward-prefix-chars)
 (current-column))
 (let ((function (buffer-substring (point)
 					(progn (forward-sexp 1) (point))))
 	       (lisp-indent-defform state indent-point))
 	      ((integerp method)
 	       (lisp-indent-specform method state
 				     indent-point normal-indent))
 	      (method
-		(funcall method state indent-point)))))))
+		(funcall method indent-point state)))))))
 (defvar lisp-body-indent 2
 "Number of columns to indent the second line of a `(def...)' form.")
 (defun lisp-indent-specform (count state indent-point normal-indent)
 (and (bolp) (not (eolp))
 	   (lisp-indent-line))
 (indent-sexp endmark)
 (set-marker endmark nil))))
+(defun indent-pp-sexp (&optional arg)
+"Indent each line of the list starting just after point, or prettyprint it.
+A prefix argument specifies pretty-printing."
+(interactive "P")
+(if arg
+(save-excursion
+(save-restriction
+(narrow-to-region (point) (progn (forward-sexp 1) (point)))
+(pp-buffer)
+(goto-char (point-max))
+(if (eq (char-before) ?\n)
+(delete-char -1)))))
+(indent-sexp))
 ;;;; Lisp paragraph filling commands.
+(defcustom emacs-lisp-docstring-fill-column 65
+"Value of `fill-column' to use when filling a docstring.
+Any non-integer value means do not use a different value of
+`fill-column' when filling docstrings."
+:type '(choice (integer)
+(const :tag "Use the current `fill-column'" t))
+:group 'lisp)
 (defun lisp-fill-paragraph (&optional justify)
-"Like \\[fill-paragraph], but handle Emacs Lisp comments.
+"Like \\[fill-paragraph], but handle Emacs Lisp comments and docstrings.
 If any of the current line is a comment, fill the comment or the
 paragraph of it that point is in, preserving the comment's indentation
 and initial semicolons."
 (interactive "P")
 (or (fill-comment-paragraph justify)
-;; `paragraph-start' is set here (not in the buffer-local
+;; Since fill-comment-paragraph returned nil, that means we're not in
-;; variable so that `forward-paragraph' et al work as
+;; a comment: Point is on a program line; we are interested
-;; expected) so that filling (doc) strings works sensibly.
+;; particularly in docstring lines.
-;; Adding the opening paren to avoid the following sexp being
+;;
-;; filled means that sexps generally aren't filled as normal
+;; We bind `paragraph-start' and `paragraph-separate' temporarily.  They
-;; text, which is probably sensible.  The `;' and `:' stop the
+;; are buffer-local, but we avoid changing them so that they can be set
-;; filled para at following comment lines and keywords
+;; to make `forward-paragraph' and friends do something the user wants.
-;; (typically in `defcustom').
+;;
+;; `paragraph-start': The `(' in the character alternative and the
+;; left-singlequote plus `(' sequence after the \\| alternative prevent
+;; sexps and backquoted sexps that follow a docstring from being filled
+;; with the docstring.  This setting has the consequence of inhibiting
+;; filling many program lines that are not docstrings, which is sensible,
+;; because the user probably asked to fill program lines by accident, or
+;; expecting indentation (perhaps we should try to do indenting in that
+;; case).  The `;' and `:' stop the paragraph being filled at following
+;; comment lines and at keywords (e.g., in `defcustom').  Left parens are
+;; escaped to keep font-locking, filling, & paren matching in the source
+;; file happy.
+;;
+;; `paragraph-separate': A clever regexp distinguishes the first line of
+;; a docstring and identifies it as a paragraph separator, so that it
+;; won't be filled.  (Since the first line of documentation stands alone
+;; in some contexts, filling should not alter the contents the author has
+;; chosen.)  Only the first line of a docstring begins with whitespace
+;; and a quotation mark and ends with a period or (rarely) a comma.
+;;
+;; The `fill-column' is temporarily bound to
+;; `emacs-lisp-docstring-fill-column' if that value is an integer.
 (let ((paragraph-start (concat paragraph-start
-				     "\\|\\s-*[\(;:\"]"))
+				     "\\|\\s-*\\([(;:\"]\\|`(\\|#'(\\)"))
-	    ;; Avoid filling the first line of docstring.
 	    (paragraph-separate
-	     (concat paragraph-separate "\\|\\s-*\".*\\.$")))
+	     (concat paragraph-separate "\\|\\s-*\".*[,\\.]$"))
+(fill-column (if (integerp emacs-lisp-docstring-fill-column)
+emacs-lisp-docstring-fill-column
+fill-column)))
 	(fill-paragraph justify))
 ;; Never return nil.
 t))
 (defun indent-code-rigidly (start end arg &optional nochange-regexp)
 					  (forward-line 1) (point))
 					nil nil state))))))
 (provide 'lisp-mode)
+;; arch-tag: 414c7f93-c245-4b77-8ed5-ed05ef7ff1bf
 ;;; lisp-mode.el ends here

Mercurial > emacs

comparison lisp/emacs-lisp/lisp-mode.el @ 88155:d7ddb3e565de