]> 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 d6ac05642ba66e4817f47bf6309f5c553910d224..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)))
@@ -363,7 +364,7 @@ if that value is non-nil."
     (when (stringp default)
       (if (string-match ":+" default)
           (substring default (match-end 0))
-          default))))
+       default))))
 
 ;; Used in old LispM code.
 (defalias 'common-lisp-mode 'lisp-mode)
@@ -459,21 +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
-           (condition-case nil
-               (string c)
-             (error nil))))))))
+       (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.
@@ -555,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))
@@ -570,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))
@@ -581,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)
@@ -589,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)))
@@ -624,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)
@@ -853,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)))
@@ -893,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.")
@@ -1097,7 +1124,8 @@ ENDPOS is encountered."
       (set-marker endmark nil))))
 
 (defun indent-pp-sexp (&optional arg)
-  "Indent each line of the list or, with prefix ARG, pretty-printify the list."
+  "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
@@ -1126,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
@@ -1155,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)
@@ -1200,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