]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/lisp-mode.el
(debug): Set debug-on-exit before calling debugger-setup-buffer so
[gnu-emacs] / lisp / emacs-lisp / lisp-mode.el
index 4057fe2968e52c5c8ed056d76f3622280bb0f794..1a7da113c1216bed42a2d8e56410481c8f1f489a 100644 (file)
@@ -1,6 +1,7 @@
 ;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands
 
-;; Copyright (C) 1985,86,1999,2000,01,03,2004  Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1999, 2000, 2001, 2003, 2004, 2005
+;;           Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: lisp, languages
 (put 'defsubst 'doc-string-elt 3)
 (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 'define-generic-mode 'doc-string-elt 7)
   (make-local-variable 'parse-sexp-ignore-comments)
   (setq parse-sexp-ignore-comments t)
   (make-local-variable 'outline-regexp)
-  (setq outline-regexp ";;;;* [^ \t\n]\\|(")
+  (setq outline-regexp ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(")
   (make-local-variable 'outline-level)
   (setq outline-level 'lisp-outline-level)
   (make-local-variable 'comment-start)
 
 (defun lisp-outline-level ()
   "Lisp mode `outline-level' function."
-  (if (looking-at "(\\|;;;###autoload")
-      1000
-    (looking-at outline-regexp)
-    (- (match-end 0) (match-beginning 0))))
-
+  (let ((len (- (match-end 0) (match-beginning 0))))
+    (if (looking-at "(\\|;;;###autoload")
+       1000
+      len)))
 
 (defvar lisp-mode-shared-map
   (let ((map (make-sparse-keymap)))
@@ -239,6 +240,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
     (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))
@@ -355,6 +357,14 @@ if that value is non-nil."
   (setq imenu-case-fold-search t)
   (set-syntax-table lisp-mode-syntax-table)
   (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)
@@ -369,6 +379,7 @@ if that value is non-nil."
   (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)
@@ -449,18 +460,37 @@ alternative printed representations that can be displayed."
 If CHAR is not a character, return nil."
   (and (integerp char)
        (eventp char)
-       (let ((c (event-basic-type char)))
-        (concat
-         "?"
-         (mapconcat
-          (lambda (modif)
-            (cond ((eq modif 'super) "\\s-")
-                  (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-))))
-          (event-modifiers char) "")
-         (cond
-          ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c))
-          ((eq c 127) "\\C-?")
-          (t (string c)))))))
+       (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.
@@ -524,13 +554,12 @@ With argument, print output into current buffer."
                         (prin1-to-string value)))
        (print-length eval-expression-print-length)
        (print-level eval-expression-print-level)
-       (char-string (prin1-char value))
        (beg (point))
        end)
     (prog1
        (prin1 value)
-      (if (and (eq standard-output t) char-string)
-         (princ (concat " = " char-string)))
+      (let ((str (eval-expression-print-format value)))
+       (if str (princ str)))
       (setq end (point))
       (when (and (bufferp standard-output)
                 (or (not (null print-length))
@@ -543,13 +572,15 @@ With argument, print output into current buffer."
        ))))
 
 
+(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))
@@ -558,8 +589,9 @@ Interactively, with prefix argument, print output into current buffer."
       value)))
 
 (defun eval-defun-1 (form)
-  "Change defvar into defconst within FORM.
-Likewise for other constructs as necessary."
+  "Treat some expressions specially.
+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))
@@ -569,7 +601,7 @@ Likewise for other constructs as necessary."
              (boundp (cadr form)))
         ;; Force variable to be re-set.
         `(progn (defvar ,(nth 1 form) nil ,@(nthcdr 3 form))
-                (setq ,(nth 1 form) ,(nth 2 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)
@@ -577,6 +609,13 @@ Likewise for other constructs as necessary."
         ;; 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.
+        (put (eval (nth 1 form)) 'face-defface-spec nil)
+        (setq face-new-frame-defaults
+              (assq-delete-all (eval (nth 1 form)) face-new-frame-defaults))
+        form)
        ((eq (car form) 'progn)
         (cons 'progn (mapcar 'eval-defun-1 (cdr form))))
        (t form)))
@@ -612,7 +651,7 @@ Return the result of evaluation."
           (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)
@@ -841,11 +880,11 @@ 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;
+  like ordinary function arguments and then indent any further
+  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.
+  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)))
@@ -881,7 +920,7 @@ This function also returns nil meaning don't specify the indentation."
               (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.")
@@ -1084,6 +1123,20 @@ ENDPOS is encountered."
       (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
@@ -1101,7 +1154,8 @@ paragraph of it that point is in, preserving the comment's indentation
 and initial semicolons."
   (interactive "P")
   (or (fill-comment-paragraph justify)
-      ;; Point is on a program line (a line no comment); we are interested
+      ;; Since fill-comment-paragraph returned nil, that means we're not in
+      ;; a comment: Point is on a program line; we are interested
       ;; particularly in docstring lines.
       ;;
       ;; We bind `paragraph-start' and `paragraph-separate' temporarily.  They
@@ -1130,7 +1184,7 @@ and initial semicolons."
       ;; 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-*\\([(;:\"]\\|`(\\|#'(\\)"))
            (paragraph-separate
             (concat paragraph-separate "\\|\\s-*\".*[,\\.]$"))
             (fill-column (if (integerp emacs-lisp-docstring-fill-column)
@@ -1175,5 +1229,5 @@ means don't indent that line."
 
 (provide 'lisp-mode)
 
-;;; arch-tag: 414c7f93-c245-4b77-8ed5-ed05ef7ff1bf
+;; arch-tag: 414c7f93-c245-4b77-8ed5-ed05ef7ff1bf
 ;;; lisp-mode.el ends here