-;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands\r
-\r
-;; Copyright (C) 1985, 1986, 1999, 2000, 2001, 2002, 2003, 2004,\r
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.\r
-\r
-;; Maintainer: FSF\r
-;; Keywords: lisp, languages\r
-\r
-;; This file is part of GNU Emacs.\r
-\r
-;; GNU Emacs is free software: you can redistribute it and/or modify\r
-;; it under the terms of the GNU General Public License as published by\r
-;; the Free Software Foundation, either version 3 of the License, or\r
-;; (at your option) any later version.\r
-\r
-;; GNU Emacs is distributed in the hope that it will be useful,\r
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of\r
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\r
-;; GNU General Public License for more details.\r
-\r
-;; You should have received a copy of the GNU General Public License\r
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.\r
-\r
-;;; Commentary:\r
-\r
-;; The base major mode for editing Lisp code (used also for Emacs Lisp).\r
-;; This mode is documented in the Emacs manual.\r
-\r
-;;; Code:\r
-\r
-(defvar font-lock-comment-face)\r
-(defvar font-lock-doc-face)\r
-(defvar font-lock-keywords-case-fold-search)\r
-(defvar font-lock-string-face)\r
-\r
-(defvar lisp-mode-abbrev-table nil)\r
-\r
-(define-abbrev-table 'lisp-mode-abbrev-table ())\r
-\r
-(defvar emacs-lisp-mode-syntax-table\r
- (let ((table (make-syntax-table)))\r
- (let ((i 0))\r
- (while (< i ?0)\r
- (modify-syntax-entry i "_ " table)\r
- (setq i (1+ i)))\r
- (setq i (1+ ?9))\r
- (while (< i ?A)\r
- (modify-syntax-entry i "_ " table)\r
- (setq i (1+ i)))\r
- (setq i (1+ ?Z))\r
- (while (< i ?a)\r
- (modify-syntax-entry i "_ " table)\r
- (setq i (1+ i)))\r
- (setq i (1+ ?z))\r
- (while (< i 128)\r
- (modify-syntax-entry i "_ " table)\r
- (setq i (1+ i)))\r
- (modify-syntax-entry ?\s " " table)\r
- ;; Non-break space acts as whitespace.\r
- (modify-syntax-entry ?\x8a0 " " table)\r
- (modify-syntax-entry ?\t " " table)\r
- (modify-syntax-entry ?\f " " table)\r
- (modify-syntax-entry ?\n "> " table)\r
- ;; This is probably obsolete since nowadays such features use overlays.\r
- ;; ;; Give CR the same syntax as newline, for selective-display.\r
- ;; (modify-syntax-entry ?\^m "> " table)\r
- (modify-syntax-entry ?\; "< " table)\r
- (modify-syntax-entry ?` "' " table)\r
- (modify-syntax-entry ?' "' " table)\r
- (modify-syntax-entry ?, "' " table)\r
- (modify-syntax-entry ?@ "' " table)\r
- ;; Used to be singlequote; changed for flonums.\r
- (modify-syntax-entry ?. "_ " table)\r
- (modify-syntax-entry ?# "' " table)\r
- (modify-syntax-entry ?\" "\" " table)\r
- (modify-syntax-entry ?\\ "\\ " table)\r
- (modify-syntax-entry ?\( "() " table)\r
- (modify-syntax-entry ?\) ")( " table)\r
- (modify-syntax-entry ?\[ "(] " table)\r
- (modify-syntax-entry ?\] ")[ " table))\r
- table))\r
-\r
-(defvar lisp-mode-syntax-table\r
- (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))\r
- (modify-syntax-entry ?\[ "_ " table)\r
- (modify-syntax-entry ?\] "_ " table)\r
- (modify-syntax-entry ?# "' 14b" table)\r
- (modify-syntax-entry ?| "\" 23bn" table)\r
- table))\r
-\r
-(defvar lisp-imenu-generic-expression\r
- (list\r
- (list nil\r
- (purecopy (concat "^\\s-*("\r
- (eval-when-compile\r
- (regexp-opt\r
- '("defun" "defun*" "defsubst" "defmacro"\r
- "defadvice" "define-skeleton"\r
- "define-minor-mode" "define-global-minor-mode"\r
- "define-globalized-minor-mode"\r
- "define-derived-mode" "define-generic-mode"\r
- "define-compiler-macro" "define-modify-macro"\r
- "defsetf" "define-setf-expander"\r
- "define-method-combination"\r
- "defgeneric" "defmethod") t))\r
- "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"))\r
- 2)\r
- (list (purecopy "Variables")\r
- (purecopy (concat "^\\s-*("\r
- (eval-when-compile\r
- (regexp-opt\r
- '("defvar" "defconst" "defconstant" "defcustom"\r
- "defparameter" "define-symbol-macro") t))\r
- "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"))\r
- 2)\r
- (list (purecopy "Types")\r
- (purecopy (concat "^\\s-*("\r
- (eval-when-compile\r
- (regexp-opt\r
- '("defgroup" "deftheme" "deftype" "defstruct"\r
- "defclass" "define-condition" "define-widget"\r
- "defface" "defpackage") t))\r
- "\\s-+'?\\(\\(\\sw\\|\\s_\\)+\\)"))\r
- 2))\r
-\r
- "Imenu generic expression for Lisp mode. See `imenu-generic-expression'.")\r
-\r
-;; This was originally in autoload.el and is still used there.\r
-(put 'autoload 'doc-string-elt 3)\r
-(put 'defun 'doc-string-elt 3)\r
-(put 'defun* 'doc-string-elt 3)\r
-(put 'defvar 'doc-string-elt 3)\r
-(put 'defcustom 'doc-string-elt 3)\r
-(put 'deftheme 'doc-string-elt 2)\r
-(put 'defconst 'doc-string-elt 3)\r
-(put 'defmacro 'doc-string-elt 3)\r
-(put 'defmacro* 'doc-string-elt 3)\r
-(put 'defsubst 'doc-string-elt 3)\r
-(put 'defstruct 'doc-string-elt 2)\r
-(put 'define-skeleton 'doc-string-elt 2)\r
-(put 'define-derived-mode 'doc-string-elt 4)\r
-(put 'define-compilation-mode 'doc-string-elt 3)\r
-(put 'easy-mmode-define-minor-mode 'doc-string-elt 2)\r
-(put 'define-minor-mode 'doc-string-elt 2)\r
-(put 'easy-mmode-define-global-mode 'doc-string-elt 2)\r
-(put 'define-global-minor-mode 'doc-string-elt 2)\r
-(put 'define-globalized-minor-mode 'doc-string-elt 2)\r
-(put 'define-generic-mode 'doc-string-elt 7)\r
-(put 'define-ibuffer-filter 'doc-string-elt 2)\r
-(put 'define-ibuffer-op 'doc-string-elt 3)\r
-(put 'define-ibuffer-sorter 'doc-string-elt 2)\r
-(put 'lambda 'doc-string-elt 2)\r
-(put 'defalias 'doc-string-elt 3)\r
-(put 'defvaralias 'doc-string-elt 3)\r
-(put 'define-category 'doc-string-elt 2)\r
-\r
-(defvar lisp-doc-string-elt-property 'doc-string-elt\r
- "The symbol property that holds the docstring position info.")\r
-\r
-(defun lisp-font-lock-syntactic-face-function (state)\r
- (if (nth 3 state)\r
- ;; This might be a (doc)string or a |...| symbol.\r
- (let ((startpos (nth 8 state)))\r
- (if (eq (char-after startpos) ?|)\r
- ;; This is not a string, but a |...| symbol.\r
- nil\r
- (let* ((listbeg (nth 1 state))\r
- (firstsym (and listbeg\r
- (save-excursion\r
- (goto-char listbeg)\r
- (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)")\r
- (match-string 1)))))\r
- (docelt (and firstsym (get (intern-soft firstsym)\r
- lisp-doc-string-elt-property))))\r
- (if (and docelt\r
- ;; It's a string in a form that can have a docstring.\r
- ;; Check whether it's in docstring position.\r
- (save-excursion\r
- (when (functionp docelt)\r
- (goto-char (match-end 1))\r
- (setq docelt (funcall docelt)))\r
- (goto-char listbeg)\r
- (forward-char 1)\r
- (condition-case nil\r
- (while (and (> docelt 0) (< (point) startpos)\r
- (progn (forward-sexp 1) t))\r
- (setq docelt (1- docelt)))\r
- (error nil))\r
- (and (zerop docelt) (<= (point) startpos)\r
- (progn (forward-comment (point-max)) t)\r
- (= (point) (nth 8 state)))))\r
- font-lock-doc-face\r
- font-lock-string-face))))\r
- font-lock-comment-face))\r
-\r
-;; The LISP-SYNTAX argument is used by code in inf-lisp.el and is\r
-;; (uselessly) passed from pp.el, chistory.el, gnus-kill.el and score-mode.el\r
-(defun lisp-mode-variables (&optional lisp-syntax)\r
- (when lisp-syntax\r
- (set-syntax-table lisp-mode-syntax-table))\r
- (setq local-abbrev-table lisp-mode-abbrev-table)\r
- (make-local-variable 'paragraph-ignore-fill-prefix)\r
- (setq paragraph-ignore-fill-prefix t)\r
- (make-local-variable 'fill-paragraph-function)\r
- (setq fill-paragraph-function 'lisp-fill-paragraph)\r
- ;; Adaptive fill mode gets the fill wrong for a one-line paragraph made of\r
- ;; a single docstring. Let's fix it here.\r
- (set (make-local-variable 'adaptive-fill-function)\r
- (lambda () (if (looking-at "\\s-+\"[^\n\"]+\"\\s-*$") "")))\r
- ;; Adaptive fill mode gets in the way of auto-fill,\r
- ;; and should make no difference for explicit fill\r
- ;; because lisp-fill-paragraph should do the job.\r
- ;; I believe that newcomment's auto-fill code properly deals with it -stef\r
- ;;(set (make-local-variable 'adaptive-fill-mode) nil)\r
- (make-local-variable 'indent-line-function)\r
- (setq indent-line-function 'lisp-indent-line)\r
- (make-local-variable 'parse-sexp-ignore-comments)\r
- (setq parse-sexp-ignore-comments t)\r
- (make-local-variable 'outline-regexp)\r
- (setq outline-regexp ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(")\r
- (make-local-variable 'outline-level)\r
- (setq outline-level 'lisp-outline-level)\r
- (make-local-variable 'comment-start)\r
- (setq comment-start ";")\r
- (make-local-variable 'comment-start-skip)\r
- ;; Look within the line for a ; following an even number of backslashes\r
- ;; after either a non-backslash or the line beginning.\r
- (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")\r
- (make-local-variable 'font-lock-comment-start-skip)\r
- ;; Font lock mode uses this only when it KNOWS a comment is starting.\r
- (setq font-lock-comment-start-skip ";+ *")\r
- (make-local-variable 'comment-add)\r
- (setq comment-add 1) ;default to `;;' in comment-region\r
- (make-local-variable 'comment-column)\r
- (setq comment-column 40)\r
- ;; Don't get confused by `;' in doc strings when paragraph-filling.\r
- (set (make-local-variable 'comment-use-global-state) t)\r
- (make-local-variable 'imenu-generic-expression)\r
- (setq imenu-generic-expression lisp-imenu-generic-expression)\r
- (make-local-variable 'multibyte-syntax-as-symbol)\r
- (setq multibyte-syntax-as-symbol t)\r
- (set (make-local-variable 'syntax-begin-function) 'beginning-of-defun)\r
- (setq font-lock-defaults\r
- '((lisp-font-lock-keywords\r
- lisp-font-lock-keywords-1 lisp-font-lock-keywords-2)\r
- nil nil (("+-*/.<>=!?$%_&~^:@" . "w")) nil\r
- (font-lock-mark-block-function . mark-defun)\r
- (font-lock-syntactic-face-function\r
- . lisp-font-lock-syntactic-face-function))))\r
-\r
-(defun lisp-outline-level ()\r
- "Lisp mode `outline-level' function."\r
- (let ((len (- (match-end 0) (match-beginning 0))))\r
- (if (looking-at "(\\|;;;###autoload")\r
- 1000\r
- len)))\r
-\r
-(defvar lisp-mode-shared-map\r
- (let ((map (make-sparse-keymap)))\r
- (define-key map "\e\C-q" 'indent-sexp)\r
- (define-key map "\177" 'backward-delete-char-untabify)\r
- ;; This gets in the way when viewing a Lisp file in view-mode. As\r
- ;; long as [backspace] is mapped into DEL via the\r
- ;; function-key-map, this should remain disabled!!\r
- ;;;(define-key map [backspace] 'backward-delete-char-untabify)\r
- map)\r
- "Keymap for commands shared by all sorts of Lisp modes.")\r
-\r
-(defvar emacs-lisp-mode-map\r
- (let ((map (make-sparse-keymap "Emacs-Lisp"))\r
- (menu-map (make-sparse-keymap "Emacs-Lisp"))\r
- (prof-map (make-sparse-keymap))\r
- (tracing-map (make-sparse-keymap)))\r
- (set-keymap-parent map lisp-mode-shared-map)\r
- (define-key map "\e\t" 'lisp-complete-symbol)\r
- (define-key map "\e\C-x" 'eval-defun)\r
- (define-key map "\e\C-q" 'indent-pp-sexp)\r
- (define-key map [menu-bar emacs-lisp] (cons "Emacs-Lisp" menu-map))\r
- (define-key menu-map [eldoc]\r
- '(menu-item "Auto-Display Documentation Strings" eldoc-mode\r
- :button (:toggle . (bound-and-true-p eldoc-mode))\r
- :help "Display the documentation string for the item under cursor"))\r
- (define-key menu-map [checkdoc]\r
- '(menu-item "Check Documentation Strings" checkdoc\r
- :help "Check documentation strings for style requirements"))\r
- (define-key menu-map [re-builder]\r
- '(menu-item "Construct Regexp" re-builder\r
- :help "Construct a regexp interactively"))\r
- (define-key menu-map [tracing] (cons "Tracing" tracing-map))\r
- (define-key tracing-map [tr-a]\r
- '(menu-item "Untrace all" untrace-all\r
- :help "Untraces all currently traced functions"))\r
- (define-key tracing-map [tr-uf]\r
- '(menu-item "Untrace function..." untrace-function\r
- :help "Untraces FUNCTION and possibly activates all remaining advice"))\r
- (define-key tracing-map [tr-sep] '("--"))\r
- (define-key tracing-map [tr-q]\r
- '(menu-item "Trace function quietly..." trace-function-background\r
- :help "Trace the function with trace output going quietly to a buffer"))\r
- (define-key tracing-map [tr-f]\r
- '(menu-item "Trace function..." trace-function\r
- :help "Trace the function given as a argument"))\r
- (define-key menu-map [profiling] (cons "Profiling" prof-map))\r
- (define-key prof-map [prof-restall]\r
- '(menu-item "Remove Instrumentation for All Functions" elp-restore-all\r
- :help "Restore the original definitions of all functions being profiled"))\r
- (define-key prof-map [prof-restfunc]\r
- '(menu-item "Remove Instrumentation for Function..." elp-restore-function\r
- :help "Restore an instrumented function to its original definition"))\r
-\r
- (define-key prof-map [sep-rem] '("--"))\r
- (define-key prof-map [prof-resall]\r
- '(menu-item "Reset Counters for All Functions" elp-reset-all\r
- :help "Reset the profiling information for all functions being profiled"))\r
- (define-key prof-map [prof-resfunc]\r
- '(menu-item "Reset Counters for Function..." elp-reset-function\r
- :help "Reset the profiling information for a function"))\r
- (define-key prof-map [prof-res]\r
- '(menu-item "Show Profiling Results" elp-results\r
- :help "Display current profiling results"))\r
- (define-key prof-map [prof-pack]\r
- '(menu-item "Instrument Package..." elp-instrument-package\r
- :help "Instrument for profiling all function that start with a prefix"))\r
- (define-key prof-map [prof-func]\r
- '(menu-item "Instrument Function..." elp-instrument-function\r
- :help "Instrument a function for profiling"))\r
- (define-key menu-map [edebug-defun]\r
- '(menu-item "Instrument Function for Debugging" edebug-defun\r
- :help "Evaluate the top level form point is in, stepping through with Edebug"\r
- :keys "C-u C-M-x"))\r
- (define-key menu-map [separator-byte] '("--"))\r
- (define-key menu-map [disas]\r
- '(menu-item "Disassemble byte compiled object..." disassemble\r
- :help "Print disassembled code for OBJECT in a buffer"))\r
- (define-key menu-map [byte-recompile]\r
- '(menu-item "Byte-recompile Directory..." byte-recompile-directory\r
- :help "Recompile every `.el' file in DIRECTORY that needs recompilation"))\r
- (define-key menu-map [emacs-byte-compile-and-load]\r
- '(menu-item "Byte-compile And Load" emacs-lisp-byte-compile-and-load\r
- :help "Byte-compile the current file (if it has changed), then load compiled code"))\r
- (define-key menu-map [byte-compile]\r
- '(menu-item "Byte-compile This File" emacs-lisp-byte-compile\r
- :help "Byte compile the file containing the current buffer"))\r
- (define-key menu-map [separator-eval] '("--"))\r
- (define-key menu-map [ielm]\r
- '(menu-item "Interactive Expression Evaluation" ielm\r
- :help "Interactively evaluate Emacs Lisp expressions"))\r
- (define-key menu-map [eval-buffer]\r
- '(menu-item "Evaluate Buffer" eval-buffer\r
- :help "Execute the current buffer as Lisp code"))\r
- (define-key menu-map [eval-region]\r
- '(menu-item "Evaluate Region" eval-region\r
- :help "Execute the region as Lisp code"\r
- :enable mark-active))\r
- (define-key menu-map [eval-sexp]\r
- '(menu-item "Evaluate Last S-expression" eval-last-sexp\r
- :help "Evaluate sexp before point; print value in minibuffer"))\r
- (define-key menu-map [separator-format] '("--"))\r
- (define-key menu-map [comment-region]\r
- '(menu-item "Comment Out Region" comment-region\r
- :help "Comment or uncomment each line in the region"\r
- :enable mark-active))\r
- (define-key menu-map [indent-region]\r
- '(menu-item "Indent Region" indent-region\r
- :help "Indent each nonblank line in the region"\r
- :enable mark-active))\r
- (define-key menu-map [indent-line] '("Indent Line" . lisp-indent-line))\r
- map)\r
- "Keymap for Emacs Lisp mode.\r
-All commands in `lisp-mode-shared-map' are inherited by this map.")\r
-\r
-(defun emacs-lisp-byte-compile ()\r
- "Byte compile the file containing the current buffer."\r
- (interactive)\r
- (if buffer-file-name\r
- (byte-compile-file buffer-file-name)\r
- (error "The buffer must be saved in a file first")))\r
-\r
-(defun emacs-lisp-byte-compile-and-load ()\r
- "Byte-compile the current file (if it has changed), then load compiled code."\r
- (interactive)\r
- (or buffer-file-name\r
- (error "The buffer must be saved in a file first"))\r
- (require 'bytecomp)\r
- ;; Recompile if file or buffer has changed since last compilation.\r
- (if (and (buffer-modified-p)\r
- (y-or-n-p (format "Save buffer %s first? " (buffer-name))))\r
- (save-buffer))\r
- (let ((compiled-file-name (byte-compile-dest-file buffer-file-name)))\r
- (if (file-newer-than-file-p compiled-file-name buffer-file-name)\r
- (load-file compiled-file-name)\r
- (byte-compile-file buffer-file-name t))))\r
-\r
-(defcustom emacs-lisp-mode-hook nil\r
- "Hook run when entering Emacs Lisp mode."\r
- :options '(turn-on-eldoc-mode imenu-add-menubar-index checkdoc-minor-mode)\r
- :type 'hook\r
- :group 'lisp)\r
-\r
-(defcustom lisp-mode-hook nil\r
- "Hook run when entering Lisp mode."\r
- :options '(imenu-add-menubar-index)\r
- :type 'hook\r
- :group 'lisp)\r
-\r
-(defcustom lisp-interaction-mode-hook nil\r
- "Hook run when entering Lisp Interaction mode."\r
- :options '(turn-on-eldoc-mode)\r
- :type 'hook\r
- :group 'lisp)\r
-\r
-(defun emacs-lisp-mode ()\r
- "Major mode for editing Lisp code to run in Emacs.\r
-Commands:\r
-Delete converts tabs to spaces as it moves back.\r
-Blank lines separate paragraphs. Semicolons start comments.\r
-\\{emacs-lisp-mode-map}\r
-Entry to this mode calls the value of `emacs-lisp-mode-hook'\r
-if that value is non-nil."\r
- (interactive)\r
- (kill-all-local-variables)\r
- (use-local-map emacs-lisp-mode-map)\r
- (set-syntax-table emacs-lisp-mode-syntax-table)\r
- (setq major-mode 'emacs-lisp-mode)\r
- (setq mode-name "Emacs-Lisp")\r
- (lisp-mode-variables)\r
- (setq imenu-case-fold-search nil)\r
- (run-mode-hooks 'emacs-lisp-mode-hook))\r
-(put 'emacs-lisp-mode 'custom-mode-group 'lisp)\r
-\r
-(defvar lisp-mode-map\r
- (let ((map (make-sparse-keymap))\r
- (menu-map (make-sparse-keymap "Lisp")))\r
- (set-keymap-parent map lisp-mode-shared-map)\r
- (define-key map "\e\C-x" 'lisp-eval-defun)\r
- (define-key map "\C-c\C-z" 'run-lisp)\r
- (define-key map [menu-bar lisp] (cons "Lisp" menu-map))\r
- (define-key menu-map [run-lisp]\r
- '(menu-item "Run inferior Lisp" run-lisp\r
- :help "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'"))\r
- (define-key menu-map [ev-def]\r
- '(menu-item "Eval defun" lisp-eval-defun\r
- :help "Send the current defun to the Lisp process made by M-x run-lisp"))\r
- (define-key menu-map [ind-sexp]\r
- '(menu-item "Indent sexp" indent-sexp\r
- :help "Indent each line of the list starting just after point"))\r
- map)\r
- "Keymap for ordinary Lisp mode.\r
-All commands in `lisp-mode-shared-map' are inherited by this map.")\r
-\r
-(defun lisp-mode ()\r
- "Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp.\r
-Commands:\r
-Delete converts tabs to spaces as it moves back.\r
-Blank lines separate paragraphs. Semicolons start comments.\r
-\\{lisp-mode-map}\r
-Note that `run-lisp' may be used either to start an inferior Lisp job\r
-or to switch back to an existing one.\r
-\r
-Entry to this mode calls the value of `lisp-mode-hook'\r
-if that value is non-nil."\r
- (interactive)\r
- (kill-all-local-variables)\r
- (use-local-map lisp-mode-map)\r
- (setq major-mode 'lisp-mode)\r
- (setq mode-name "Lisp")\r
- (lisp-mode-variables)\r
- (make-local-variable 'comment-start-skip)\r
- (setq comment-start-skip\r
- "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")\r
- (make-local-variable 'font-lock-keywords-case-fold-search)\r
- (setq font-lock-keywords-case-fold-search t)\r
- (setq imenu-case-fold-search t)\r
- (set-syntax-table lisp-mode-syntax-table)\r
- (run-mode-hooks 'lisp-mode-hook))\r
-(put 'lisp-mode 'find-tag-default-function 'lisp-find-tag-default)\r
-\r
-(defun lisp-find-tag-default ()\r
- (let ((default (find-tag-default)))\r
- (when (stringp default)\r
- (if (string-match ":+" default)\r
- (substring default (match-end 0))\r
- default))))\r
-\r
-;; Used in old LispM code.\r
-(defalias 'common-lisp-mode 'lisp-mode)\r
-\r
-;; This will do unless inf-lisp.el is loaded.\r
-(defun lisp-eval-defun (&optional and-go)\r
- "Send the current defun to the Lisp process made by \\[run-lisp]."\r
- (interactive)\r
- (error "Process lisp does not exist"))\r
-\r
-(defvar lisp-interaction-mode-map\r
- (let ((map (make-sparse-keymap))\r
- (menu-map (make-sparse-keymap "Lisp-Interaction")))\r
- (set-keymap-parent map lisp-mode-shared-map)\r
- (define-key map "\e\C-x" 'eval-defun)\r
- (define-key map "\e\C-q" 'indent-pp-sexp)\r
- (define-key map "\e\t" 'lisp-complete-symbol)\r
- (define-key map "\n" 'eval-print-last-sexp)\r
- (define-key map [menu-bar lisp-interaction] (cons "Lisp-Interaction" menu-map))\r
- (define-key menu-map [eval-defun]\r
- '(menu-item "Evaluate Defun" eval-defun\r
- :help "Evaluate the top-level form containing point, or after point"))\r
- (define-key menu-map [eval-print-last-sexp]\r
- '(menu-item "Evaluate and print" eval-print-last-sexp\r
- :help "Evaluate sexp before point; print value into current buffer"))\r
- (define-key menu-map [edebug-defun-lisp-interaction]\r
- '(menu-item "Instrument Function for Debugging" edebug-defun\r
- :help "Evaluate the top level form point is in, stepping through with Edebug"\r
- :keys "C-u C-M-x"))\r
- (define-key menu-map [indent-pp-sexp]\r
- '(menu-item "Indent or Pretty-Print" indent-pp-sexp\r
- :help "Indent each line of the list starting just after point, or prettyprint it"))\r
- (define-key menu-map [lisp-complete-symbol]\r
- '(menu-item "Complete Lisp Symbol" lisp-complete-symbol\r
- :help "Perform completion on Lisp symbol preceding point"))\r
- map)\r
- "Keymap for Lisp Interaction mode.\r
-All commands in `lisp-mode-shared-map' are inherited by this map.")\r
-\r
-(defvar lisp-interaction-mode-abbrev-table lisp-mode-abbrev-table)\r
-(define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction"\r
- "Major mode for typing and evaluating Lisp forms.\r
-Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression\r
-before point, and prints its value into the buffer, advancing point.\r
-Note that printing is controlled by `eval-expression-print-length'\r
-and `eval-expression-print-level'.\r
-\r
-Commands:\r
-Delete converts tabs to spaces as it moves back.\r
-Paragraphs are separated only by blank lines.\r
-Semicolons start comments.\r
-\\{lisp-interaction-mode-map}\r
-Entry to this mode calls the value of `lisp-interaction-mode-hook'\r
-if that value is non-nil.")\r
-\r
-(defun eval-print-last-sexp ()\r
- "Evaluate sexp before point; print value into current buffer.\r
-\r
-If `eval-expression-debug-on-error' is non-nil, which is the default,\r
-this command arranges for all errors to enter the debugger.\r
-\r
-Note that printing the result is controlled by the variables\r
-`eval-expression-print-length' and `eval-expression-print-level',\r
-which see."\r
- (interactive)\r
- (let ((standard-output (current-buffer)))\r
- (terpri)\r
- (eval-last-sexp t)\r
- (terpri)))\r
-\r
-\r
-(defun last-sexp-setup-props (beg end value alt1 alt2)\r
- "Set up text properties for the output of `eval-last-sexp-1'.\r
-BEG and END are the start and end of the output in current-buffer.\r
-VALUE is the Lisp value printed, ALT1 and ALT2 are strings for the\r
-alternative printed representations that can be displayed."\r
- (let ((map (make-sparse-keymap)))\r
- (define-key map "\C-m" 'last-sexp-toggle-display)\r
- (define-key map [down-mouse-2] 'mouse-set-point)\r
- (define-key map [mouse-2] 'last-sexp-toggle-display)\r
- (add-text-properties\r
- beg end\r
- `(printed-value (,value ,alt1 ,alt2)\r
- mouse-face highlight\r
- keymap ,map\r
- help-echo "RET, mouse-2: toggle abbreviated display"\r
- rear-nonsticky (mouse-face keymap help-echo\r
- printed-value)))))\r
-\r
-\r
-(defun last-sexp-toggle-display (&optional arg)\r
- "Toggle between abbreviated and unabbreviated printed representations."\r
- (interactive "P")\r
- (save-restriction\r
- (widen)\r
- (let ((value (get-text-property (point) 'printed-value)))\r
- (when value\r
- (let ((beg (or (previous-single-property-change (min (point-max) (1+ (point)))\r
- 'printed-value)\r
- (point)))\r
- (end (or (next-single-char-property-change (point) 'printed-value) (point)))\r
- (standard-output (current-buffer))\r
- (point (point)))\r
- (delete-region beg end)\r
- (insert (nth 1 value))\r
- (or (= beg point)\r
- (setq point (1- (point))))\r
- (last-sexp-setup-props beg (point)\r
- (nth 0 value)\r
- (nth 2 value)\r
- (nth 1 value))\r
- (goto-char (min (point-max) point)))))))\r
-\r
-(defun prin1-char (char)\r
- "Return a string representing CHAR as a character rather than as an integer.\r
-If CHAR is not a character, return nil."\r
- (and (integerp char)\r
- (eventp char)\r
- (let ((c (event-basic-type char))\r
- (mods (event-modifiers char))\r
- string)\r
- ;; Prevent ?A from turning into ?\S-a.\r
- (if (and (memq 'shift mods)\r
- (zerop (logand char ?\S-\^@))\r
- (not (let ((case-fold-search nil))\r
- (char-equal c (upcase c)))))\r
- (setq c (upcase c) mods nil))\r
- ;; What string are we considering using?\r
- (condition-case nil\r
- (setq string\r
- (concat\r
- "?"\r
- (mapconcat\r
- (lambda (modif)\r
- (cond ((eq modif 'super) "\\s-")\r
- (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-))))\r
- mods "")\r
- (cond\r
- ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c))\r
- ((eq c 127) "\\C-?")\r
- (t\r
- (string c)))))\r
- (error nil))\r
- ;; Verify the string reads a CHAR, not to some other character.\r
- ;; If it doesn't, return nil instead.\r
- (and string\r
- (= (car (read-from-string string)) char)\r
- string))))\r
-\r
-\r
-(defun preceding-sexp ()\r
- "Return sexp before the point."\r
- (let ((opoint (point))\r
- ignore-quotes\r
- expr)\r
- (save-excursion\r
- (with-syntax-table emacs-lisp-mode-syntax-table\r
- ;; If this sexp appears to be enclosed in `...'\r
- ;; then ignore the surrounding quotes.\r
- (setq ignore-quotes\r
- (or (eq (following-char) ?\')\r
- (eq (preceding-char) ?\')))\r
- (forward-sexp -1)\r
- ;; If we were after `?\e' (or similar case),\r
- ;; use the whole thing, not just the `e'.\r
- (when (eq (preceding-char) ?\\)\r
- (forward-char -1)\r
- (when (eq (preceding-char) ??)\r
- (forward-char -1)))\r
-\r
- ;; Skip over `#N='s.\r
- (when (eq (preceding-char) ?=)\r
- (let (labeled-p)\r
- (save-excursion\r
- (skip-chars-backward "0-9#=")\r
- (setq labeled-p (looking-at "\\(#[0-9]+=\\)+")))\r
- (when labeled-p\r
- (forward-sexp -1))))\r
-\r
- (save-restriction\r
- ;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in\r
- ;; `variable' so that the value is returned, not the\r
- ;; name\r
- (if (and ignore-quotes\r
- (eq (following-char) ?`))\r
- (forward-char))\r
- (narrow-to-region (point-min) opoint)\r
- (setq expr (read (current-buffer)))\r
- ;; If it's an (interactive ...) form, it's more\r
- ;; useful to show how an interactive call would\r
- ;; use it.\r
- (and (consp expr)\r
- (eq (car expr) 'interactive)\r
- (setq expr\r
- (list 'call-interactively\r
- (list 'quote\r
- (list 'lambda\r
- '(&rest args)\r
- expr\r
- 'args)))))\r
- expr)))))\r
-\r
-\r
-(defun eval-last-sexp-1 (eval-last-sexp-arg-internal)\r
- "Evaluate sexp before point; print value in minibuffer.\r
-With argument, print output into current buffer."\r
- (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)))\r
- (eval-last-sexp-print-value (eval (preceding-sexp)))))\r
-\r
-\r
-(defun eval-last-sexp-print-value (value)\r
- (let ((unabbreviated (let ((print-length nil) (print-level nil))\r
- (prin1-to-string value)))\r
- (print-length eval-expression-print-length)\r
- (print-level eval-expression-print-level)\r
- (beg (point))\r
- end)\r
- (prog1\r
- (prin1 value)\r
- (let ((str (eval-expression-print-format value)))\r
- (if str (princ str)))\r
- (setq end (point))\r
- (when (and (bufferp standard-output)\r
- (or (not (null print-length))\r
- (not (null print-level)))\r
- (not (string= unabbreviated\r
- (buffer-substring-no-properties beg end))))\r
- (last-sexp-setup-props beg end value\r
- unabbreviated\r
- (buffer-substring-no-properties beg end))\r
- ))))\r
-\r
-\r
-(defvar eval-last-sexp-fake-value (make-symbol "t"))\r
-\r
-(defun eval-last-sexp (eval-last-sexp-arg-internal)\r
- "Evaluate sexp before point; print value in minibuffer.\r
-Interactively, with prefix argument, print output into current buffer.\r
-\r
-If `eval-expression-debug-on-error' is non-nil, which is the default,\r
-this command arranges for all errors to enter the debugger."\r
- (interactive "P")\r
- (if (null eval-expression-debug-on-error)\r
- (eval-last-sexp-1 eval-last-sexp-arg-internal)\r
- (let ((value\r
- (let ((debug-on-error eval-last-sexp-fake-value))\r
- (cons (eval-last-sexp-1 eval-last-sexp-arg-internal)\r
- debug-on-error))))\r
- (unless (eq (cdr value) eval-last-sexp-fake-value)\r
- (setq debug-on-error (cdr value)))\r
- (car value))))\r
-\r
-(defun eval-defun-1 (form)\r
- "Treat some expressions specially.\r
-Reset the `defvar' and `defcustom' variables to the initial value.\r
-Reinitialize the face according to the `defface' specification."\r
- ;; The code in edebug-defun should be consistent with this, but not\r
- ;; the same, since this gets a macroexpended form.\r
- (cond ((not (listp form))\r
- form)\r
- ((and (eq (car form) 'defvar)\r
- (cdr-safe (cdr-safe form))\r
- (boundp (cadr form)))\r
- ;; Force variable to be re-set.\r
- `(progn (defvar ,(nth 1 form) nil ,@(nthcdr 3 form))\r
- (setq-default ,(nth 1 form) ,(nth 2 form))))\r
- ;; `defcustom' is now macroexpanded to\r
- ;; `custom-declare-variable' with a quoted value arg.\r
- ((and (eq (car form) 'custom-declare-variable)\r
- (default-boundp (eval (nth 1 form))))\r
- ;; Force variable to be bound.\r
- (set-default (eval (nth 1 form)) (eval (nth 1 (nth 2 form))))\r
- form)\r
- ;; `defface' is macroexpanded to `custom-declare-face'.\r
- ((eq (car form) 'custom-declare-face)\r
- ;; Reset the face.\r
- (setq face-new-frame-defaults\r
- (assq-delete-all (eval (nth 1 form)) face-new-frame-defaults))\r
- (put (eval (nth 1 form)) 'face-defface-spec nil)\r
- ;; Setting `customized-face' to the new spec after calling\r
- ;; the form, but preserving the old saved spec in `saved-face',\r
- ;; imitates the situation when the new face spec is set\r
- ;; temporarily for the current session in the customize\r
- ;; buffer, thus allowing `face-user-default-spec' to use the\r
- ;; new customized spec instead of the saved spec.\r
- ;; Resetting `saved-face' temporarily to nil is needed to let\r
- ;; `defface' change the spec, regardless of a saved spec.\r
- (prog1 `(prog1 ,form\r
- (put ,(nth 1 form) 'saved-face\r
- ',(get (eval (nth 1 form)) 'saved-face))\r
- (put ,(nth 1 form) 'customized-face\r
- ,(nth 2 form)))\r
- (put (eval (nth 1 form)) 'saved-face nil)))\r
- ((eq (car form) 'progn)\r
- (cons 'progn (mapcar 'eval-defun-1 (cdr form))))\r
- (t form)))\r
-\r
-(defun eval-defun-2 ()\r
- "Evaluate defun that point is in or before.\r
-The value is displayed in the minibuffer.\r
-If the current defun is actually a call to `defvar',\r
-then reset the variable using the initial value expression\r
-even if the variable already has some other value.\r
-\(Normally `defvar' does not change the variable's value\r
-if it already has a value.\)\r
-\r
-With argument, insert value in current buffer after the defun.\r
-Return the result of evaluation."\r
- (interactive "P")\r
- ;; FIXME: the print-length/level bindings should only be applied while\r
- ;; printing, not while evaluating.\r
- (let ((debug-on-error eval-expression-debug-on-error)\r
- (print-length eval-expression-print-length)\r
- (print-level eval-expression-print-level))\r
- (save-excursion\r
- ;; Arrange for eval-region to "read" the (possibly) altered form.\r
- ;; eval-region handles recording which file defines a function or\r
- ;; variable. Re-written using `apply' to avoid capturing\r
- ;; variables like `end'.\r
- (apply\r
- #'eval-region\r
- (let ((standard-output t)\r
- beg end form)\r
- ;; Read the form from the buffer, and record where it ends.\r
- (save-excursion\r
- (end-of-defun)\r
- (beginning-of-defun)\r
- (setq beg (point))\r
- (setq form (read (current-buffer)))\r
- (setq end (point)))\r
- ;; Alter the form if necessary.\r
- (setq form (eval-defun-1 (macroexpand form)))\r
- (list beg end standard-output\r
- `(lambda (ignore)\r
- ;; Skipping to the end of the specified region\r
- ;; will make eval-region return.\r
- (goto-char ,end)\r
- ',form))))))\r
- ;; The result of evaluation has been put onto VALUES. So return it.\r
- (car values))\r
-\r
-(defun eval-defun (edebug-it)\r
- "Evaluate the top-level form containing point, or after point.\r
-\r
-If the current defun is actually a call to `defvar' or `defcustom',\r
-evaluating it this way resets the variable using its initial value\r
-expression even if the variable already has some other value.\r
-\(Normally `defvar' and `defcustom' do not alter the value if there\r
-already is one.) In an analogous way, evaluating a `defface'\r
-overrides any customizations of the face, so that it becomes\r
-defined exactly as the `defface' expression says.\r
-\r
-If `eval-expression-debug-on-error' is non-nil, which is the default,\r
-this command arranges for all errors to enter the debugger.\r
-\r
-With a prefix argument, instrument the code for Edebug.\r
-\r
-If acting on a `defun' for FUNCTION, and the function was\r
-instrumented, `Edebug: FUNCTION' is printed in the minibuffer. If not\r
-instrumented, just FUNCTION is printed.\r
-\r
-If not acting on a `defun', the result of evaluation is displayed in\r
-the minibuffer. This display is controlled by the variables\r
-`eval-expression-print-length' and `eval-expression-print-level',\r
-which see."\r
- (interactive "P")\r
- (cond (edebug-it\r
- (require 'edebug)\r
- (eval-defun (not edebug-all-defs)))\r
- (t\r
- (if (null eval-expression-debug-on-error)\r
- (eval-defun-2)\r
- (let ((old-value (make-symbol "t")) new-value value)\r
- (let ((debug-on-error old-value))\r
- (setq value (eval-defun-2))\r
- (setq new-value debug-on-error))\r
- (unless (eq old-value new-value)\r
- (setq debug-on-error new-value))\r
- value)))))\r
-\r
-;; May still be used by some external Lisp-mode variant.\r
-(define-obsolete-function-alias 'lisp-comment-indent\r
- 'comment-indent-default "22.1")\r
-(define-obsolete-function-alias 'lisp-mode-auto-fill 'do-auto-fill "23.1")\r
-\r
-(defcustom lisp-indent-offset nil\r
- "If non-nil, indent second line of expressions that many more columns."\r
- :group 'lisp\r
- :type '(choice (const nil) integer))\r
-(put 'lisp-body-indent 'safe-local-variable\r
- (lambda (x) (or (null x) (integerp x))))\r
-\r
-(defvar lisp-indent-function 'lisp-indent-function)\r
-\r
-(defun lisp-indent-line (&optional whole-exp)\r
- "Indent current line as Lisp code.\r
-With argument, indent any additional lines of the same expression\r
-rigidly along with this one."\r
- (interactive "P")\r
- (let ((indent (calculate-lisp-indent)) shift-amt end\r
- (pos (- (point-max) (point)))\r
- (beg (progn (beginning-of-line) (point))))\r
- (skip-chars-forward " \t")\r
- (if (or (null indent) (looking-at "\\s<\\s<\\s<"))\r
- ;; Don't alter indentation of a ;;; comment line\r
- ;; or a line that starts in a string.\r
- (goto-char (- (point-max) pos))\r
- (if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<")))\r
- ;; Single-semicolon comment lines should be indented\r
- ;; as comment lines, not as code.\r
- (progn (indent-for-comment) (forward-char -1))\r
- (if (listp indent) (setq indent (car indent)))\r
- (setq shift-amt (- indent (current-column)))\r
- (if (zerop shift-amt)\r
- nil\r
- (delete-region beg (point))\r
- (indent-to indent)))\r
- ;; If initial point was within line's indentation,\r
- ;; position after the indentation. Else stay at same point in text.\r
- (if (> (- (point-max) pos) (point))\r
- (goto-char (- (point-max) pos)))\r
- ;; If desired, shift remaining lines of expression the same amount.\r
- (and whole-exp (not (zerop shift-amt))\r
- (save-excursion\r
- (goto-char beg)\r
- (forward-sexp 1)\r
- (setq end (point))\r
- (goto-char beg)\r
- (forward-line 1)\r
- (setq beg (point))\r
- (> end beg))\r
- (indent-code-rigidly beg end shift-amt)))))\r
-\r
-(defvar calculate-lisp-indent-last-sexp)\r
-\r
-(defun calculate-lisp-indent (&optional parse-start)\r
- "Return appropriate indentation for current line as Lisp code.\r
-In usual case returns an integer: the column to indent to.\r
-If the value is nil, that means don't change the indentation\r
-because the line starts inside a string.\r
-\r
-The value can also be a list of the form (COLUMN CONTAINING-SEXP-START).\r
-This means that following lines at the same level of indentation\r
-should not necessarily be indented the same as this line.\r
-Then COLUMN is the column to indent to, and CONTAINING-SEXP-START\r
-is the buffer position of the start of the containing expression."\r
- (save-excursion\r
- (beginning-of-line)\r
- (let ((indent-point (point))\r
- state paren-depth\r
- ;; setting this to a number inhibits calling hook\r
- (desired-indent nil)\r
- (retry t)\r
- calculate-lisp-indent-last-sexp containing-sexp)\r
- (if parse-start\r
- (goto-char parse-start)\r
- (beginning-of-defun))\r
- ;; Find outermost containing sexp\r
- (while (< (point) indent-point)\r
- (setq state (parse-partial-sexp (point) indent-point 0)))\r
- ;; Find innermost containing sexp\r
- (while (and retry\r
- state\r
- (> (setq paren-depth (elt state 0)) 0))\r
- (setq retry nil)\r
- (setq calculate-lisp-indent-last-sexp (elt state 2))\r
- (setq containing-sexp (elt state 1))\r
- ;; Position following last unclosed open.\r
- (goto-char (1+ containing-sexp))\r
- ;; Is there a complete sexp since then?\r
- (if (and calculate-lisp-indent-last-sexp\r
- (> calculate-lisp-indent-last-sexp (point)))\r
- ;; Yes, but is there a containing sexp after that?\r
- (let ((peek (parse-partial-sexp calculate-lisp-indent-last-sexp\r
- indent-point 0)))\r
- (if (setq retry (car (cdr peek))) (setq state peek)))))\r
- (if retry\r
- nil\r
- ;; Innermost containing sexp found\r
- (goto-char (1+ containing-sexp))\r
- (if (not calculate-lisp-indent-last-sexp)\r
- ;; indent-point immediately follows open paren.\r
- ;; Don't call hook.\r
- (setq desired-indent (current-column))\r
- ;; Find the start of first element of containing sexp.\r
- (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)\r
- (cond ((looking-at "\\s(")\r
- ;; First element of containing sexp is a list.\r
- ;; Indent under that list.\r
- )\r
- ((> (save-excursion (forward-line 1) (point))\r
- calculate-lisp-indent-last-sexp)\r
- ;; This is the first line to start within the containing sexp.\r
- ;; It's almost certainly a function call.\r
- (if (= (point) calculate-lisp-indent-last-sexp)\r
- ;; Containing sexp has nothing before this line\r
- ;; except the first element. Indent under that element.\r
- nil\r
- ;; Skip the first element, find start of second (the first\r
- ;; argument of the function call) and indent under.\r
- (progn (forward-sexp 1)\r
- (parse-partial-sexp (point)\r
- calculate-lisp-indent-last-sexp\r
- 0 t)))\r
- (backward-prefix-chars))\r
- (t\r
- ;; Indent beneath first sexp on same line as\r
- ;; `calculate-lisp-indent-last-sexp'. Again, it's\r
- ;; almost certainly a function call.\r
- (goto-char calculate-lisp-indent-last-sexp)\r
- (beginning-of-line)\r
- (parse-partial-sexp (point) calculate-lisp-indent-last-sexp\r
- 0 t)\r
- (backward-prefix-chars)))))\r
- ;; Point is at the point to indent under unless we are inside a string.\r
- ;; Call indentation hook except when overridden by lisp-indent-offset\r
- ;; or if the desired indentation has already been computed.\r
- (let ((normal-indent (current-column)))\r
- (cond ((elt state 3)\r
- ;; Inside a string, don't change indentation.\r
- nil)\r
- ((and (integerp lisp-indent-offset) containing-sexp)\r
- ;; Indent by constant offset\r
- (goto-char containing-sexp)\r
- (+ (current-column) lisp-indent-offset))\r
- ;; in this case calculate-lisp-indent-last-sexp is not nil\r
- (calculate-lisp-indent-last-sexp\r
- (or\r
- ;; try to align the parameters of a known function\r
- (and lisp-indent-function\r
- (not retry)\r
- (funcall lisp-indent-function indent-point state))\r
- ;; If the function has no special alignment\r
- ;; or it does not apply to this argument,\r
- ;; try to align a constant-symbol under the last\r
- ;; preceding constant symbol, if there is such one of\r
- ;; the last 2 preceding symbols, in the previous\r
- ;; uncommented line.\r
- (and (save-excursion\r
- (goto-char indent-point)\r
- (skip-chars-forward " \t")\r
- (looking-at ":"))\r
- ;; The last sexp may not be at the indentation\r
- ;; where it begins, so find that one, instead.\r
- (save-excursion\r
- (goto-char calculate-lisp-indent-last-sexp)\r
- ;; Handle prefix characters and whitespace\r
- ;; following an open paren. (Bug#1012)\r
- (backward-prefix-chars)\r
- (while (and (not (looking-back "^[ \t]*\\|([ \t]+"))\r
- (or (not containing-sexp)\r
- (< (1+ containing-sexp) (point))))\r
- (forward-sexp -1)\r
- (backward-prefix-chars))\r
- (setq calculate-lisp-indent-last-sexp (point)))\r
- (> calculate-lisp-indent-last-sexp\r
- (save-excursion\r
- (goto-char (1+ containing-sexp))\r
- (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)\r
- (point)))\r
- (let ((parse-sexp-ignore-comments t)\r
- indent)\r
- (goto-char calculate-lisp-indent-last-sexp)\r
- (or (and (looking-at ":")\r
- (setq indent (current-column)))\r
- (and (< (save-excursion (beginning-of-line) (point))\r
- (prog2 (backward-sexp) (point)))\r
- (looking-at ":")\r
- (setq indent (current-column))))\r
- indent))\r
- ;; another symbols or constants not preceded by a constant\r
- ;; as defined above.\r
- normal-indent))\r
- ;; in this case calculate-lisp-indent-last-sexp is nil\r
- (desired-indent)\r
- (t\r
- normal-indent))))))\r
-\r
-(defun lisp-indent-function (indent-point state)\r
- "This function is the normal value of the variable `lisp-indent-function'.\r
-It is used when indenting a line within a function call, to see if the\r
-called function says anything special about how to indent the line.\r
-\r
-INDENT-POINT is the position where the user typed TAB, or equivalent.\r
-Point is located at the point to indent under (for default indentation);\r
-STATE is the `parse-partial-sexp' state for that position.\r
-\r
-If the current line is in a call to a Lisp function\r
-which has a non-nil property `lisp-indent-function',\r
-that specifies how to do the indentation. The property value can be\r
-* `defun', meaning indent `defun'-style;\r
-* an integer N, meaning indent the first N arguments specially\r
- like ordinary function arguments and then indent any further\r
- arguments like a body;\r
-* a function to call just as this function was called.\r
- If that function returns nil, that means it doesn't specify\r
- the indentation.\r
-\r
-This function also returns nil meaning don't specify the indentation."\r
- (let ((normal-indent (current-column)))\r
- (goto-char (1+ (elt state 1)))\r
- (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)\r
- (if (and (elt state 2)\r
- (not (looking-at "\\sw\\|\\s_")))\r
- ;; car of form doesn't seem to be a symbol\r
- (progn\r
- (if (not (> (save-excursion (forward-line 1) (point))\r
- calculate-lisp-indent-last-sexp))\r
- (progn (goto-char calculate-lisp-indent-last-sexp)\r
- (beginning-of-line)\r
- (parse-partial-sexp (point)\r
- calculate-lisp-indent-last-sexp 0 t)))\r
- ;; Indent under the list or under the first sexp on the same\r
- ;; line as calculate-lisp-indent-last-sexp. Note that first\r
- ;; thing on that line has to be complete sexp since we are\r
- ;; inside the innermost containing sexp.\r
- (backward-prefix-chars)\r
- (current-column))\r
- (let ((function (buffer-substring (point)\r
- (progn (forward-sexp 1) (point))))\r
- method)\r
- (setq method (or (get (intern-soft function) 'lisp-indent-function)\r
- (get (intern-soft function) 'lisp-indent-hook)))\r
- (cond ((or (eq method 'defun)\r
- (and (null method)\r
- (> (length function) 3)\r
- (string-match "\\`def" function)))\r
- (lisp-indent-defform state indent-point))\r
- ((integerp method)\r
- (lisp-indent-specform method state\r
- indent-point normal-indent))\r
- (method\r
- (funcall method indent-point state)))))))\r
-\r
-(defcustom lisp-body-indent 2\r
- "Number of columns to indent the second line of a `(def...)' form."\r
- :group 'lisp\r
- :type 'integer)\r
-(put 'lisp-body-indent 'safe-local-variable 'integerp)\r
-\r
-(defun lisp-indent-specform (count state indent-point normal-indent)\r
- (let ((containing-form-start (elt state 1))\r
- (i count)\r
- body-indent containing-form-column)\r
- ;; Move to the start of containing form, calculate indentation\r
- ;; to use for non-distinguished forms (> count), and move past the\r
- ;; function symbol. lisp-indent-function guarantees that there is at\r
- ;; least one word or symbol character following open paren of containing\r
- ;; form.\r
- (goto-char containing-form-start)\r
- (setq containing-form-column (current-column))\r
- (setq body-indent (+ lisp-body-indent containing-form-column))\r
- (forward-char 1)\r
- (forward-sexp 1)\r
- ;; Now find the start of the last form.\r
- (parse-partial-sexp (point) indent-point 1 t)\r
- (while (and (< (point) indent-point)\r
- (condition-case ()\r
- (progn\r
- (setq count (1- count))\r
- (forward-sexp 1)\r
- (parse-partial-sexp (point) indent-point 1 t))\r
- (error nil))))\r
- ;; Point is sitting on first character of last (or count) sexp.\r
- (if (> count 0)\r
- ;; A distinguished form. If it is the first or second form use double\r
- ;; lisp-body-indent, else normal indent. With lisp-body-indent bound\r
- ;; to 2 (the default), this just happens to work the same with if as\r
- ;; the older code, but it makes unwind-protect, condition-case,\r
- ;; with-output-to-temp-buffer, et. al. much more tasteful. The older,\r
- ;; less hacked, behavior can be obtained by replacing below with\r
- ;; (list normal-indent containing-form-start).\r
- (if (<= (- i count) 1)\r
- (list (+ containing-form-column (* 2 lisp-body-indent))\r
- containing-form-start)\r
- (list normal-indent containing-form-start))\r
- ;; A non-distinguished form. Use body-indent if there are no\r
- ;; distinguished forms and this is the first undistinguished form,\r
- ;; or if this is the first undistinguished form and the preceding\r
- ;; distinguished form has indentation at least as great as body-indent.\r
- (if (or (and (= i 0) (= count 0))\r
- (and (= count 0) (<= body-indent normal-indent)))\r
- body-indent\r
- normal-indent))))\r
-\r
-(defun lisp-indent-defform (state indent-point)\r
- (goto-char (car (cdr state)))\r
- (forward-line 1)\r
- (if (> (point) (car (cdr (cdr state))))\r
- (progn\r
- (goto-char (car (cdr state)))\r
- (+ lisp-body-indent (current-column)))))\r
-\r
-\r
-;; (put 'progn 'lisp-indent-function 0), say, causes progn to be indented\r
-;; like defun if the first form is placed on the next line, otherwise\r
-;; it is indented like any other form (i.e. forms line up under first).\r
-\r
-(put 'lambda 'lisp-indent-function 'defun)\r
-(put 'autoload 'lisp-indent-function 'defun)\r
-(put 'progn 'lisp-indent-function 0)\r
-(put 'prog1 'lisp-indent-function 1)\r
-(put 'prog2 'lisp-indent-function 2)\r
-(put 'save-excursion 'lisp-indent-function 0)\r
-(put 'save-window-excursion 'lisp-indent-function 0)\r
-(put 'save-selected-window 'lisp-indent-function 0)\r
-(put 'save-restriction 'lisp-indent-function 0)\r
-(put 'save-match-data 'lisp-indent-function 0)\r
-(put 'save-current-buffer 'lisp-indent-function 0)\r
-(put 'with-current-buffer 'lisp-indent-function 1)\r
-(put 'combine-after-change-calls 'lisp-indent-function 0)\r
-(put 'with-output-to-string 'lisp-indent-function 0)\r
-(put 'with-temp-file 'lisp-indent-function 1)\r
-(put 'with-temp-buffer 'lisp-indent-function 0)\r
-(put 'with-temp-message 'lisp-indent-function 1)\r
-(put 'with-syntax-table 'lisp-indent-function 1)\r
-(put 'let 'lisp-indent-function 1)\r
-(put 'let* 'lisp-indent-function 1)\r
-(put 'while 'lisp-indent-function 1)\r
-(put 'if 'lisp-indent-function 2)\r
-(put 'read-if 'lisp-indent-function 2)\r
-(put 'catch 'lisp-indent-function 1)\r
-(put 'condition-case 'lisp-indent-function 2)\r
-(put 'unwind-protect 'lisp-indent-function 1)\r
-(put 'with-output-to-temp-buffer 'lisp-indent-function 1)\r
-(put 'eval-after-load 'lisp-indent-function 1)\r
-(put 'dolist 'lisp-indent-function 1)\r
-(put 'dotimes 'lisp-indent-function 1)\r
-(put 'when 'lisp-indent-function 1)\r
-(put 'unless 'lisp-indent-function 1)\r
-\r
-(defun indent-sexp (&optional endpos)\r
- "Indent each line of the list starting just after point.\r
-If optional arg ENDPOS is given, indent each line, stopping when\r
-ENDPOS is encountered."\r
- (interactive)\r
- (let ((indent-stack (list nil))\r
- (next-depth 0)\r
- ;; If ENDPOS is non-nil, use nil as STARTING-POINT\r
- ;; so that calculate-lisp-indent will find the beginning of\r
- ;; the defun we are in.\r
- ;; If ENDPOS is nil, it is safe not to scan before point\r
- ;; since every line we indent is more deeply nested than point is.\r
- (starting-point (if endpos nil (point)))\r
- (last-point (point))\r
- last-depth bol outer-loop-done inner-loop-done state this-indent)\r
- (or endpos\r
- ;; Get error now if we don't have a complete sexp after point.\r
- (save-excursion (forward-sexp 1)))\r
- (save-excursion\r
- (setq outer-loop-done nil)\r
- (while (if endpos (< (point) endpos)\r
- (not outer-loop-done))\r
- (setq last-depth next-depth\r
- inner-loop-done nil)\r
- ;; Parse this line so we can learn the state\r
- ;; to indent the next line.\r
- ;; This inner loop goes through only once\r
- ;; unless a line ends inside a string.\r
- (while (and (not inner-loop-done)\r
- (not (setq outer-loop-done (eobp))))\r
- (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))\r
- nil nil state))\r
- (setq next-depth (car state))\r
- ;; If the line contains a comment other than the sort\r
- ;; that is indented like code,\r
- ;; indent it now with indent-for-comment.\r
- ;; Comments indented like code are right already.\r
- ;; In any case clear the in-comment flag in the state\r
- ;; because parse-partial-sexp never sees the newlines.\r
- (if (car (nthcdr 4 state))\r
- (progn (indent-for-comment)\r
- (end-of-line)\r
- (setcar (nthcdr 4 state) nil)))\r
- ;; If this line ends inside a string,\r
- ;; go straight to next line, remaining within the inner loop,\r
- ;; and turn off the \-flag.\r
- (if (car (nthcdr 3 state))\r
- (progn\r
- (forward-line 1)\r
- (setcar (nthcdr 5 state) nil))\r
- (setq inner-loop-done t)))\r
- (and endpos\r
- (<= next-depth 0)\r
- (progn\r
- (setq indent-stack (nconc indent-stack\r
- (make-list (- next-depth) nil))\r
- last-depth (- last-depth next-depth)\r
- next-depth 0)))\r
- (forward-line 1)\r
- ;; Decide whether to exit.\r
- (if endpos\r
- ;; If we have already reached the specified end,\r
- ;; give up and do not reindent this line.\r
- (if (<= endpos (point))\r
- (setq outer-loop-done t))\r
- ;; If no specified end, we are done if we have finished one sexp.\r
- (if (<= next-depth 0)\r
- (setq outer-loop-done t)))\r
- (unless outer-loop-done\r
- (while (> last-depth next-depth)\r
- (setq indent-stack (cdr indent-stack)\r
- last-depth (1- last-depth)))\r
- (while (< last-depth next-depth)\r
- (setq indent-stack (cons nil indent-stack)\r
- last-depth (1+ last-depth)))\r
- ;; Now indent the next line according\r
- ;; to what we learned from parsing the previous one.\r
- (setq bol (point))\r
- (skip-chars-forward " \t")\r
- ;; But not if the line is blank, or just a comment\r
- ;; (except for double-semi comments; indent them as usual).\r
- (if (or (eobp) (looking-at "\\s<\\|\n"))\r
- nil\r
- (if (and (car indent-stack)\r
- (>= (car indent-stack) 0))\r
- (setq this-indent (car indent-stack))\r
- (let ((val (calculate-lisp-indent\r
- (if (car indent-stack) (- (car indent-stack))\r
- starting-point))))\r
- (if (null val)\r
- (setq this-indent val)\r
- (if (integerp val)\r
- (setcar indent-stack\r
- (setq this-indent val))\r
- (setcar indent-stack (- (car (cdr val))))\r
- (setq this-indent (car val))))))\r
- (if (and this-indent (/= (current-column) this-indent))\r
- (progn (delete-region bol (point))\r
- (indent-to this-indent)))))\r
- (or outer-loop-done\r
- (setq outer-loop-done (= (point) last-point))\r
- (setq last-point (point)))))))\r
-\r
-(defun lisp-indent-region (start end)\r
- "Indent every line whose first char is between START and END inclusive."\r
- (save-excursion\r
- (let ((endmark (copy-marker end)))\r
- (goto-char start)\r
- (and (bolp) (not (eolp))\r
- (lisp-indent-line))\r
- (indent-sexp endmark)\r
- (set-marker endmark nil))))\r
-\r
-(defun indent-pp-sexp (&optional arg)\r
- "Indent each line of the list starting just after point, or prettyprint it.\r
-A prefix argument specifies pretty-printing."\r
- (interactive "P")\r
- (if arg\r
- (save-excursion\r
- (save-restriction\r
- (narrow-to-region (point) (progn (forward-sexp 1) (point)))\r
- (pp-buffer)\r
- (goto-char (point-max))\r
- (if (eq (char-before) ?\n)\r
- (delete-char -1)))))\r
- (indent-sexp))\r
-\r
-;;;; Lisp paragraph filling commands.\r
-\r
-(defcustom emacs-lisp-docstring-fill-column 65\r
- "Value of `fill-column' to use when filling a docstring.\r
-Any non-integer value means do not use a different value of\r
-`fill-column' when filling docstrings."\r
- :type '(choice (integer)\r
- (const :tag "Use the current `fill-column'" t))\r
- :group 'lisp)\r
-\r
-(defun lisp-fill-paragraph (&optional justify)\r
- "Like \\[fill-paragraph], but handle Emacs Lisp comments and docstrings.\r
-If any of the current line is a comment, fill the comment or the\r
-paragraph of it that point is in, preserving the comment's indentation\r
-and initial semicolons."\r
- (interactive "P")\r
- (or (fill-comment-paragraph justify)\r
- ;; Since fill-comment-paragraph returned nil, that means we're not in\r
- ;; a comment: Point is on a program line; we are interested\r
- ;; particularly in docstring lines.\r
- ;;\r
- ;; We bind `paragraph-start' and `paragraph-separate' temporarily. They\r
- ;; are buffer-local, but we avoid changing them so that they can be set\r
- ;; to make `forward-paragraph' and friends do something the user wants.\r
- ;;\r
- ;; `paragraph-start': The `(' in the character alternative and the\r
- ;; left-singlequote plus `(' sequence after the \\| alternative prevent\r
- ;; sexps and backquoted sexps that follow a docstring from being filled\r
- ;; with the docstring. This setting has the consequence of inhibiting\r
- ;; filling many program lines that are not docstrings, which is sensible,\r
- ;; because the user probably asked to fill program lines by accident, or\r
- ;; expecting indentation (perhaps we should try to do indenting in that\r
- ;; case). The `;' and `:' stop the paragraph being filled at following\r
- ;; comment lines and at keywords (e.g., in `defcustom'). Left parens are\r
- ;; escaped to keep font-locking, filling, & paren matching in the source\r
- ;; file happy.\r
- ;;\r
- ;; `paragraph-separate': A clever regexp distinguishes the first line of\r
- ;; a docstring and identifies it as a paragraph separator, so that it\r
- ;; won't be filled. (Since the first line of documentation stands alone\r
- ;; in some contexts, filling should not alter the contents the author has\r
- ;; chosen.) Only the first line of a docstring begins with whitespace\r
- ;; and a quotation mark and ends with a period or (rarely) a comma.\r
- ;;\r
- ;; The `fill-column' is temporarily bound to\r
- ;; `emacs-lisp-docstring-fill-column' if that value is an integer.\r
- (let ((paragraph-start (concat paragraph-start\r
- "\\|\\s-*\\([(;:\"]\\|`(\\|#'(\\)"))\r
- (paragraph-separate\r
- (concat paragraph-separate "\\|\\s-*\".*[,\\.]$"))\r
- (fill-column (if (and (integerp emacs-lisp-docstring-fill-column)\r
- (derived-mode-p 'emacs-lisp-mode))\r
- emacs-lisp-docstring-fill-column\r
- fill-column)))\r
- (fill-paragraph justify))\r
- ;; Never return nil.\r
- t))\r
-\r
-(defun indent-code-rigidly (start end arg &optional nochange-regexp)\r
- "Indent all lines of code, starting in the region, sideways by ARG columns.\r
-Does not affect lines starting inside comments or strings, assuming that\r
-the start of the region is not inside them.\r
-\r
-Called from a program, takes args START, END, COLUMNS and NOCHANGE-REGEXP.\r
-The last is a regexp which, if matched at the beginning of a line,\r
-means don't indent that line."\r
- (interactive "r\np")\r
- (let (state)\r
- (save-excursion\r
- (goto-char end)\r
- (setq end (point-marker))\r
- (goto-char start)\r
- (or (bolp)\r
- (setq state (parse-partial-sexp (point)\r
- (progn\r
- (forward-line 1) (point))\r
- nil nil state)))\r
- (while (< (point) end)\r
- (or (car (nthcdr 3 state))\r
- (and nochange-regexp\r
- (looking-at nochange-regexp))\r
- ;; If line does not start in string, indent it\r
- (let ((indent (current-indentation)))\r
- (delete-region (point) (progn (skip-chars-forward " \t") (point)))\r
- (or (eolp)\r
- (indent-to (max 0 (+ indent arg)) 0))))\r
- (setq state (parse-partial-sexp (point)\r
- (progn\r
- (forward-line 1) (point))\r
- nil nil state))))))\r
-\r
-(provide 'lisp-mode)\r
-\r
-;; arch-tag: 414c7f93-c245-4b77-8ed5-ed05ef7ff1bf\r
-;;; lisp-mode.el ends here\r
+;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands
+
+;; Copyright (C) 1985, 1986, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: lisp, languages
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; 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. If not, see <http://www.gnu.org/licenses/>.
+
+;;; 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)
+
+(define-abbrev-table 'lisp-mode-abbrev-table ())
+
+(defvar emacs-lisp-mode-syntax-table
+ (let ((table (make-syntax-table)))
+ (let ((i 0))
+ (while (< i ?0)
+ (modify-syntax-entry i "_ " table)
+ (setq i (1+ i)))
+ (setq i (1+ ?9))
+ (while (< i ?A)
+ (modify-syntax-entry i "_ " table)
+ (setq i (1+ i)))
+ (setq i (1+ ?Z))
+ (while (< i ?a)
+ (modify-syntax-entry i "_ " table)
+ (setq i (1+ i)))
+ (setq i (1+ ?z))
+ (while (< i 128)
+ (modify-syntax-entry i "_ " table)
+ (setq i (1+ i)))
+ (modify-syntax-entry ?\s " " table)
+ ;; Non-break space acts as whitespace.
+ (modify-syntax-entry ?\x8a0 " " table)
+ (modify-syntax-entry ?\t " " table)
+ (modify-syntax-entry ?\f " " table)
+ (modify-syntax-entry ?\n "> " table)
+ ;; This is probably obsolete since nowadays such features use overlays.
+ ;; ;; 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)
+ (modify-syntax-entry ?\( "() " table)
+ (modify-syntax-entry ?\) ")( " table)
+ (modify-syntax-entry ?\[ "(] " table)
+ (modify-syntax-entry ?\] ")[ " table))
+ table)
+ "Syntax table used in `emacs-lisp-mode'.")
+
+(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 ?# "' 14b" table)
+ (modify-syntax-entry ?| "\" 23bn" table)
+ table)
+ "Syntax table used in `lisp-mode'.")
+
+(defvar lisp-imenu-generic-expression
+ (list
+ (list nil
+ (purecopy (concat "^\\s-*("
+ (eval-when-compile
+ (regexp-opt
+ '("defun" "defun*" "defsubst" "defmacro"
+ "defadvice" "define-skeleton"
+ "define-minor-mode" "define-global-minor-mode"
+ "define-globalized-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\\|\\s_\\)+\\)"))
+ 2)
+ (list (purecopy "Variables")
+ (purecopy (concat "^\\s-*("
+ (eval-when-compile
+ (regexp-opt
+ '("defvar" "defconst" "defconstant" "defcustom"
+ "defparameter" "define-symbol-macro") t))
+ "\\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\\|\\s_\\)+\\)"))
+ 2))
+
+ "Imenu generic expression for Lisp mode. See `imenu-generic-expression'.")
+
+;; This was originally in autoload.el and is still used there.
+(put 'autoload 'doc-string-elt 3)
+(put 'defun 'doc-string-elt 3)
+(put 'defun* 'doc-string-elt 3)
+(put 'defvar 'doc-string-elt 3)
+(put 'defcustom 'doc-string-elt 3)
+(put 'deftheme 'doc-string-elt 2)
+(put 'deftype 'doc-string-elt 3)
+(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-globalized-minor-mode 'doc-string-elt 2)
+(put 'define-generic-mode 'doc-string-elt 7)
+(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)
+(put 'define-overloadable-function 'doc-string-elt 3)
+
+(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)
+ ;; This might be a (doc)string or a |...| symbol.
+ (let ((startpos (nth 8 state)))
+ (if (eq (char-after startpos) ?|)
+ ;; This is not a string, but a |...| symbol.
+ nil
+ (let* ((listbeg (nth 1 state))
+ (firstsym (and listbeg
+ (save-excursion
+ (goto-char listbeg)
+ (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)")
+ (match-string 1)))))
+ (docelt (and firstsym (get (intern-soft firstsym)
+ lisp-doc-string-elt-property))))
+ (if (and docelt
+ ;; 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))
+
+(defun lisp-mode-variables (&optional lisp-syntax keywords-case-insensitive)
+ "Common initialization routine for lisp modes.
+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. KEYWORDS-CASE-INSENSITIVE non-nil means that for
+font-lock keywords will not be case sensitive."
+ (when lisp-syntax
+ (set-syntax-table lisp-mode-syntax-table))
+ (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 'indent-line-function)
+ (setq indent-line-function 'lisp-indent-line)
+ (make-local-variable 'parse-sexp-ignore-comments)
+ (setq parse-sexp-ignore-comments t)
+ (make-local-variable '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)
+ ;; Don't get confused by `;' in doc strings when paragraph-filling.
+ (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 ,keywords-case-insensitive (("+-*/.<>=!?$%_&~^:@" . "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."
+ (let ((len (- (match-end 0) (match-beginning 0))))
+ (if (looking-at "(\\|;;;###autoload")
+ 1000
+ len)))
+
+(defvar lisp-mode-shared-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\e\C-q" 'indent-sexp)
+ (define-key map "\177" 'backward-delete-char-untabify)
+ ;; This gets in the way when viewing a Lisp file in view-mode. As
+ ;; long as [backspace] is mapped into DEL via the
+ ;; function-key-map, this should remain disabled!!
+ ;;;(define-key map [backspace] 'backward-delete-char-untabify)
+ map)
+ "Keymap for commands shared by all sorts of Lisp modes.")
+
+(defvar emacs-lisp-mode-map
+ (let ((map (make-sparse-keymap "Emacs-Lisp"))
+ (menu-map (make-sparse-keymap "Emacs-Lisp"))
+ (lint-map (make-sparse-keymap))
+ (prof-map (make-sparse-keymap))
+ (tracing-map (make-sparse-keymap)))
+ (set-keymap-parent map lisp-mode-shared-map)
+ (define-key map "\e\t" 'completion-at-point)
+ (define-key map "\e\C-x" 'eval-defun)
+ (define-key map "\e\C-q" 'indent-pp-sexp)
+ (define-key map [menu-bar emacs-lisp] (cons (purecopy "Emacs-Lisp") menu-map))
+ (define-key menu-map [eldoc]
+ `(menu-item ,(purecopy "Auto-Display Documentation Strings") eldoc-mode
+ :button (:toggle . (bound-and-true-p eldoc-mode))
+ :help ,(purecopy "Display the documentation string for the item under cursor")))
+ (define-key menu-map [checkdoc]
+ `(menu-item ,(purecopy "Check Documentation Strings") checkdoc
+ :help ,(purecopy "Check documentation strings for style requirements")))
+ (define-key menu-map [re-builder]
+ `(menu-item ,(purecopy "Construct Regexp") re-builder
+ :help ,(purecopy "Construct a regexp interactively")))
+ (define-key menu-map [tracing] (cons (purecopy "Tracing") tracing-map))
+ (define-key tracing-map [tr-a]
+ `(menu-item ,(purecopy "Untrace All") untrace-all
+ :help ,(purecopy "Untrace all currently traced functions")))
+ (define-key tracing-map [tr-uf]
+ `(menu-item ,(purecopy "Untrace function...") untrace-function
+ :help ,(purecopy "Untrace function, and possibly activate all remaining advice")))
+ (define-key tracing-map [tr-sep] menu-bar-separator)
+ (define-key tracing-map [tr-q]
+ `(menu-item ,(purecopy "Trace Function Quietly...") trace-function-background
+ :help ,(purecopy "Trace the function with trace output going quietly to a buffer")))
+ (define-key tracing-map [tr-f]
+ `(menu-item ,(purecopy "Trace Function...") trace-function
+ :help ,(purecopy "Trace the function given as an argument")))
+ (define-key menu-map [profiling] (cons (purecopy "Profiling") prof-map))
+ (define-key prof-map [prof-restall]
+ `(menu-item ,(purecopy "Remove Instrumentation for All Functions") elp-restore-all
+ :help ,(purecopy "Restore the original definitions of all functions being profiled")))
+ (define-key prof-map [prof-restfunc]
+ `(menu-item ,(purecopy "Remove Instrumentation for Function...") elp-restore-function
+ :help ,(purecopy "Restore an instrumented function to its original definition")))
+
+ (define-key prof-map [sep-rem] menu-bar-separator)
+ (define-key prof-map [prof-resall]
+ `(menu-item ,(purecopy "Reset Counters for All Functions") elp-reset-all
+ :help ,(purecopy "Reset the profiling information for all functions being profiled")))
+ (define-key prof-map [prof-resfunc]
+ `(menu-item ,(purecopy "Reset Counters for Function...") elp-reset-function
+ :help ,(purecopy "Reset the profiling information for a function")))
+ (define-key prof-map [prof-res]
+ `(menu-item ,(purecopy "Show Profiling Results") elp-results
+ :help ,(purecopy "Display current profiling results")))
+ (define-key prof-map [prof-pack]
+ `(menu-item ,(purecopy "Instrument Package...") elp-instrument-package
+ :help ,(purecopy "Instrument for profiling all function that start with a prefix")))
+ (define-key prof-map [prof-func]
+ `(menu-item ,(purecopy "Instrument Function...") elp-instrument-function
+ :help ,(purecopy "Instrument a function for profiling")))
+ (define-key menu-map [lint] (cons (purecopy "Linting") lint-map))
+ (define-key lint-map [lint-di]
+ `(menu-item ,(purecopy "Lint Directory...") elint-directory
+ :help ,(purecopy "Lint a directory")))
+ (define-key lint-map [lint-f]
+ `(menu-item ,(purecopy "Lint File...") elint-file
+ :help ,(purecopy "Lint a file")))
+ (define-key lint-map [lint-b]
+ `(menu-item ,(purecopy "Lint Buffer") elint-current-buffer
+ :help ,(purecopy "Lint the current buffer")))
+ (define-key lint-map [lint-d]
+ `(menu-item ,(purecopy "Lint Defun") elint-defun
+ :help ,(purecopy "Lint the function at point")))
+ (define-key menu-map [edebug-defun]
+ `(menu-item ,(purecopy "Instrument Function for Debugging") edebug-defun
+ :help ,(purecopy "Evaluate the top level form point is in, stepping through with Edebug")
+ :keys ,(purecopy "C-u C-M-x")))
+ (define-key menu-map [separator-byte] menu-bar-separator)
+ (define-key menu-map [disas]
+ `(menu-item ,(purecopy "Disassemble Byte Compiled Object...") disassemble
+ :help ,(purecopy "Print disassembled code for OBJECT in a buffer")))
+ (define-key menu-map [byte-recompile]
+ `(menu-item ,(purecopy "Byte-recompile Directory...") byte-recompile-directory
+ :help ,(purecopy "Recompile every `.el' file in DIRECTORY that needs recompilation")))
+ (define-key menu-map [emacs-byte-compile-and-load]
+ `(menu-item ,(purecopy "Byte-compile and Load") emacs-lisp-byte-compile-and-load
+ :help ,(purecopy "Byte-compile the current file (if it has changed), then load compiled code")))
+ (define-key menu-map [byte-compile]
+ `(menu-item ,(purecopy "Byte-compile this File") emacs-lisp-byte-compile
+ :help ,(purecopy "Byte compile the file containing the current buffer")))
+ (define-key menu-map [separator-eval] menu-bar-separator)
+ (define-key menu-map [ielm]
+ `(menu-item ,(purecopy "Interactive Expression Evaluation") ielm
+ :help ,(purecopy "Interactively evaluate Emacs Lisp expressions")))
+ (define-key menu-map [eval-buffer]
+ `(menu-item ,(purecopy "Evaluate Buffer") eval-buffer
+ :help ,(purecopy "Execute the current buffer as Lisp code")))
+ (define-key menu-map [eval-region]
+ `(menu-item ,(purecopy "Evaluate Region") eval-region
+ :help ,(purecopy "Execute the region as Lisp code")
+ :enable mark-active))
+ (define-key menu-map [eval-sexp]
+ `(menu-item ,(purecopy "Evaluate Last S-expression") eval-last-sexp
+ :help ,(purecopy "Evaluate sexp before point; print value in minibuffer")))
+ (define-key menu-map [separator-format] menu-bar-separator)
+ (define-key menu-map [comment-region]
+ `(menu-item ,(purecopy "Comment Out Region") comment-region
+ :help ,(purecopy "Comment or uncomment each line in the region")
+ :enable mark-active))
+ (define-key menu-map [indent-region]
+ `(menu-item ,(purecopy "Indent Region") indent-region
+ :help ,(purecopy "Indent each nonblank line in the region")
+ :enable mark-active))
+ (define-key menu-map [indent-line]
+ `(menu-item ,(purecopy "Indent Line") lisp-indent-line))
+ map)
+ "Keymap for Emacs Lisp mode.
+All commands in `lisp-mode-shared-map' are inherited by this map.")
+
+(defun emacs-lisp-byte-compile ()
+ "Byte compile the file containing the current buffer."
+ (interactive)
+ (if buffer-file-name
+ (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))))
+
+(defcustom emacs-lisp-mode-hook nil
+ "Hook run when entering Emacs Lisp mode."
+ :options '(turn-on-eldoc-mode imenu-add-menubar-index checkdoc-minor-mode)
+ :type 'hook
+ :group 'lisp)
+
+(defcustom lisp-mode-hook nil
+ "Hook run when entering Lisp mode."
+ :options '(imenu-add-menubar-index)
+ :type 'hook
+ :group 'lisp)
+
+(defcustom lisp-interaction-mode-hook nil
+ "Hook run when entering Lisp Interaction mode."
+ :options '(turn-on-eldoc-mode)
+ :type 'hook
+ :group 'lisp)
+
+(define-derived-mode emacs-lisp-mode nil "Emacs-Lisp"
+ "Major mode for editing Lisp code to run in Emacs.
+Commands:
+Delete converts tabs to spaces as it moves back.
+Blank lines separate paragraphs. Semicolons start comments.
+
+\\{emacs-lisp-mode-map}
+Entry to this mode calls the value of `emacs-lisp-mode-hook'
+if that value is non-nil."
+ :group 'lisp
+ (lisp-mode-variables)
+ (setq imenu-case-fold-search nil)
+ (add-hook 'completion-at-point-functions
+ 'lisp-completion-at-point nil 'local))
+
+(defvar lisp-mode-map
+ (let ((map (make-sparse-keymap))
+ (menu-map (make-sparse-keymap "Lisp")))
+ (set-keymap-parent map lisp-mode-shared-map)
+ (define-key map "\e\C-x" 'lisp-eval-defun)
+ (define-key map "\C-c\C-z" 'run-lisp)
+ (define-key map [menu-bar lisp] (cons (purecopy "Lisp") menu-map))
+ (define-key menu-map [run-lisp]
+ `(menu-item ,(purecopy "Run inferior Lisp") run-lisp
+ :help ,(purecopy "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'")))
+ (define-key menu-map [ev-def]
+ `(menu-item ,(purecopy "Eval defun") lisp-eval-defun
+ :help ,(purecopy "Send the current defun to the Lisp process made by M-x run-lisp")))
+ (define-key menu-map [ind-sexp]
+ `(menu-item ,(purecopy "Indent sexp") indent-sexp
+ :help ,(purecopy "Indent each line of the list starting just after point")))
+ map)
+ "Keymap for ordinary Lisp mode.
+All commands in `lisp-mode-shared-map' are inherited by this map.")
+
+(defun lisp-mode ()
+ "Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp.
+Commands:
+Delete converts tabs to spaces as it moves back.
+Blank lines separate paragraphs. Semicolons start comments.
+
+\\{lisp-mode-map}
+Note that `run-lisp' may be used either to start an inferior Lisp job
+or to switch back to an existing one.
+
+Entry to this mode calls the value of `lisp-mode-hook'
+if that value is non-nil."
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map lisp-mode-map)
+ (setq major-mode 'lisp-mode)
+ (setq mode-name "Lisp")
+ (lisp-mode-variables nil t)
+ (make-local-variable 'comment-start-skip)
+ (setq comment-start-skip
+ "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
+ (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)
+
+;; 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)
+ (error "Process lisp does not exist"))
+
+(defvar lisp-interaction-mode-map
+ (let ((map (make-sparse-keymap))
+ (menu-map (make-sparse-keymap "Lisp-Interaction")))
+ (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" 'completion-at-point)
+ (define-key map "\n" 'eval-print-last-sexp)
+ (define-key map [menu-bar lisp-interaction] (cons (purecopy "Lisp-Interaction") menu-map))
+ (define-key menu-map [eval-defun]
+ `(menu-item ,(purecopy "Evaluate Defun") eval-defun
+ :help ,(purecopy "Evaluate the top-level form containing point, or after point")))
+ (define-key menu-map [eval-print-last-sexp]
+ `(menu-item ,(purecopy "Evaluate and print") eval-print-last-sexp
+ :help ,(purecopy "Evaluate sexp before point; print value into current buffer")))
+ (define-key menu-map [edebug-defun-lisp-interaction]
+ `(menu-item ,(purecopy "Instrument Function for Debugging") edebug-defun
+ :help ,(purecopy "Evaluate the top level form point is in, stepping through with Edebug")
+ :keys ,(purecopy "C-u C-M-x")))
+ (define-key menu-map [indent-pp-sexp]
+ `(menu-item ,(purecopy "Indent or Pretty-Print") indent-pp-sexp
+ :help ,(purecopy "Indent each line of the list starting just after point, or prettyprint it")))
+ (define-key menu-map [complete-symbol]
+ `(menu-item ,(purecopy "Complete Lisp Symbol") completion-at-point
+ :help ,(purecopy "Perform completion on Lisp symbol preceding point")))
+ map)
+ "Keymap for Lisp Interaction mode.
+All commands in `lisp-mode-shared-map' are inherited by this map.")
+
+(defvar lisp-interaction-mode-abbrev-table lisp-mode-abbrev-table)
+(define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction"
+ "Major mode for typing and evaluating Lisp forms.
+Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression
+before point, and prints its value into the buffer, advancing point.
+Note that printing is controlled by `eval-expression-print-length'
+and `eval-expression-print-level'.
+
+Commands:
+Delete converts tabs to spaces as it moves back.
+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.")
+
+(defun eval-print-last-sexp ()
+ "Evaluate sexp before point; print value into current buffer.
+
+If `eval-expression-debug-on-error' is non-nil, which is the default,
+this command arranges for all errors to enter the debugger.
+
+Note that printing the result is controlled by the variables
+`eval-expression-print-length' and `eval-expression-print-level',
+which see."
+ (interactive)
+ (let ((standard-output (current-buffer)))
+ (terpri)
+ (eval-last-sexp t)
+ (terpri)))
+
+
+(defun last-sexp-setup-props (beg end value alt1 alt2)
+ "Set up text properties for the output of `eval-last-sexp-1'.
+BEG and END are the start and end of the output in current-buffer.
+VALUE is the Lisp value printed, ALT1 and ALT2 are strings for the
+alternative printed representations that can be displayed."
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-m" 'last-sexp-toggle-display)
+ (define-key map [down-mouse-2] 'mouse-set-point)
+ (define-key map [mouse-2] 'last-sexp-toggle-display)
+ (add-text-properties
+ beg end
+ `(printed-value (,value ,alt1 ,alt2)
+ mouse-face highlight
+ keymap ,map
+ help-echo "RET, mouse-2: toggle abbreviated display"
+ rear-nonsticky (mouse-face keymap help-echo
+ printed-value)))))
+
+
+(defun last-sexp-toggle-display (&optional arg)
+ "Toggle between abbreviated and unabbreviated printed representations."
+ (interactive "P")
+ (save-restriction
+ (widen)
+ (let ((value (get-text-property (point) 'printed-value)))
+ (when value
+ (let ((beg (or (previous-single-property-change (min (point-max) (1+ (point)))
+ 'printed-value)
+ (point)))
+ (end (or (next-single-char-property-change (point) 'printed-value) (point)))
+ (standard-output (current-buffer))
+ (point (point)))
+ (delete-region beg end)
+ (insert (nth 1 value))
+ (or (= beg point)
+ (setq point (1- (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 preceding-sexp ()
+ "Return sexp before the point."
+ (let ((opoint (point))
+ ignore-quotes
+ expr)
+ (save-excursion
+ (with-syntax-table emacs-lisp-mode-syntax-table
+ ;; If this sexp appears to be enclosed in `...'
+ ;; then ignore the surrounding quotes.
+ (setq ignore-quotes
+ (or (eq (following-char) ?\')
+ (eq (preceding-char) ?\')))
+ (forward-sexp -1)
+ ;; If we were after `?\e' (or similar case),
+ ;; use the whole thing, not just the `e'.
+ (when (eq (preceding-char) ?\\)
+ (forward-char -1)
+ (when (eq (preceding-char) ??)
+ (forward-char -1)))
+
+ ;; Skip over hash table read syntax.
+ (and (> (point) (1+ (point-min)))
+ (looking-back "#s" (- (point) 2))
+ (forward-char -2))
+
+ ;; Skip over `#N='s.
+ (when (eq (preceding-char) ?=)
+ (let (labeled-p)
+ (save-excursion
+ (skip-chars-backward "0-9#=")
+ (setq labeled-p (looking-at "\\(#[0-9]+=\\)+")))
+ (when labeled-p
+ (forward-sexp -1))))
+
+ (save-restriction
+ ;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in
+ ;; `variable' so that the value is returned, not the
+ ;; name
+ (if (and ignore-quotes
+ (eq (following-char) ?`))
+ (forward-char))
+ (narrow-to-region (point-min) opoint)
+ (setq expr (read (current-buffer)))
+ ;; If it's an (interactive ...) form, it's more
+ ;; useful to show how an interactive call would
+ ;; use it.
+ (and (consp expr)
+ (eq (car expr) 'interactive)
+ (setq expr
+ (list 'call-interactively
+ (list 'quote
+ (list 'lambda
+ '(&rest args)
+ expr
+ 'args)))))
+ expr)))))
+
+
+(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 ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)))
+ (eval-last-sexp-print-value (eval (preceding-sexp)))))
+
+
+(defun eval-last-sexp-print-value (value)
+ (let ((unabbreviated (let ((print-length nil) (print-level nil))
+ (prin1-to-string value)))
+ (print-length eval-expression-print-length)
+ (print-level eval-expression-print-level)
+ (beg (point))
+ end)
+ (prog1
+ (prin1 value)
+ (let ((str (eval-expression-print-format value)))
+ (if str (princ str)))
+ (setq end (point))
+ (when (and (bufferp standard-output)
+ (or (not (null print-length))
+ (not (null print-level)))
+ (not (string= unabbreviated
+ (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.
+Truncates long output according to the value of the variables
+`eval-expression-print-length' and `eval-expression-print-level'.
+
+If `eval-expression-debug-on-error' is non-nil, which is the default,
+this command arranges for all errors to enter the debugger."
+ (interactive "P")
+ (if (null eval-expression-debug-on-error)
+ (eval-last-sexp-1 eval-last-sexp-arg-internal)
+ (let ((value
+ (let ((debug-on-error eval-last-sexp-fake-value))
+ (cons (eval-last-sexp-1 eval-last-sexp-arg-internal)
+ debug-on-error))))
+ (unless (eq (cdr value) eval-last-sexp-fake-value)
+ (setq debug-on-error (cdr value)))
+ (car value))))
+
+(defun eval-defun-1 (form)
+ "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))
+ form)
+ ((and (eq (car form) 'defvar)
+ (cdr-safe (cdr-safe form))
+ (boundp (cadr 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 ()
+ "Evaluate defun that point is in or before.
+The value is displayed in the minibuffer.
+If the current defun is actually a call to `defvar',
+then reset the variable using the initial value expression
+even if the variable already has some other value.
+\(Normally `defvar' does not change the variable's value
+if it already has a value.\)
+
+With argument, insert value in current buffer after the defun.
+Return the result of evaluation."
+ (interactive "P")
+ ;; FIXME: the print-length/level bindings should only be applied while
+ ;; printing, not while evaluating.
+ (let ((debug-on-error eval-expression-debug-on-error)
+ (print-length eval-expression-print-length)
+ (print-level eval-expression-print-level))
+ (save-excursion
+ ;; Arrange for eval-region to "read" the (possibly) altered form.
+ ;; eval-region handles recording which file defines a function or
+ ;; variable. Re-written using `apply' to avoid capturing
+ ;; variables like `end'.
+ (apply
+ #'eval-region
+ (let ((standard-output t)
+ beg end form)
+ ;; Read the form from the buffer, and record where it ends.
+ (save-excursion
+ (end-of-defun)
+ (beginning-of-defun)
+ (setq beg (point))
+ (setq form (read (current-buffer)))
+ (setq end (point)))
+ ;; 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.
+ (goto-char ,end)
+ ',form))))))
+ ;; The result of evaluation has been put onto VALUES. So return it.
+ (car values))
+
+(defun eval-defun (edebug-it)
+ "Evaluate the top-level form containing point, or after point.
+
+If the current defun is actually a call to `defvar' or `defcustom',
+evaluating it this way resets the variable using its initial value
+expression even if the variable already has some other value.
+\(Normally `defvar' and `defcustom' do not alter the value if there
+already is one.) In an analogous way, evaluating a `defface'
+overrides any customizations of the face, so that it becomes
+defined exactly as the `defface' expression says.
+
+If `eval-expression-debug-on-error' is non-nil, which is the default,
+this command arranges for all errors to enter the debugger.
+
+With a prefix argument, instrument the code for Edebug.
+
+If acting on a `defun' for FUNCTION, and the function was
+instrumented, `Edebug: FUNCTION' is printed in the minibuffer. If not
+instrumented, just FUNCTION is printed.
+
+If not acting on a `defun', the result of evaluation is displayed in
+the minibuffer. This display is controlled by the variables
+`eval-expression-print-length' and `eval-expression-print-level',
+which see."
+ (interactive "P")
+ (cond (edebug-it
+ (require 'edebug)
+ (eval-defun (not edebug-all-defs)))
+ (t
+ (if (null eval-expression-debug-on-error)
+ (eval-defun-2)
+ (let ((old-value (make-symbol "t")) new-value value)
+ (let ((debug-on-error old-value))
+ (setq value (eval-defun-2))
+ (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.
+(define-obsolete-function-alias 'lisp-comment-indent
+ 'comment-indent-default "22.1")
+(define-obsolete-function-alias 'lisp-mode-auto-fill 'do-auto-fill "23.1")
+
+(defcustom lisp-indent-offset nil
+ "If non-nil, indent second line of expressions that many more columns."
+ :group 'lisp
+ :type '(choice (const nil) integer))
+(put 'lisp-indent-offset 'safe-local-variable
+ (lambda (x) (or (null x) (integerp x))))
+
+(defcustom lisp-indent-function 'lisp-indent-function
+ "A function to be called by `calculate-lisp-indent'.
+It indents the arguments of a Lisp function call. This function
+should accept two arguments: the indent-point, and the
+`parse-partial-sexp' state at that position. One option for this
+function is `common-lisp-indent-function'."
+ :type 'function
+ :group 'lisp)
+
+(defun lisp-indent-line (&optional whole-exp)
+ "Indent current line as Lisp code.
+With argument, indent any additional lines of the same expression
+rigidly along with this one."
+ (interactive "P")
+ (let ((indent (calculate-lisp-indent)) shift-amt end
+ (pos (- (point-max) (point)))
+ (beg (progn (beginning-of-line) (point))))
+ (skip-chars-forward " \t")
+ (if (or (null indent) (looking-at "\\s<\\s<\\s<"))
+ ;; Don't alter indentation of a ;;; comment line
+ ;; or a line that starts in a string.
+ (goto-char (- (point-max) pos))
+ (if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<")))
+ ;; Single-semicolon comment lines should be indented
+ ;; as comment lines, not as code.
+ (progn (indent-for-comment) (forward-char -1))
+ (if (listp indent) (setq indent (car indent)))
+ (setq shift-amt (- indent (current-column)))
+ (if (zerop shift-amt)
+ nil
+ (delete-region beg (point))
+ (indent-to indent)))
+ ;; If initial point was within line's indentation,
+ ;; position after the indentation. Else stay at same point in text.
+ (if (> (- (point-max) pos) (point))
+ (goto-char (- (point-max) pos)))
+ ;; If desired, shift remaining lines of expression the same amount.
+ (and whole-exp (not (zerop shift-amt))
+ (save-excursion
+ (goto-char beg)
+ (forward-sexp 1)
+ (setq end (point))
+ (goto-char beg)
+ (forward-line 1)
+ (setq beg (point))
+ (> end beg))
+ (indent-code-rigidly beg end shift-amt)))))
+
+(defvar calculate-lisp-indent-last-sexp)
+
+(defun calculate-lisp-indent (&optional parse-start)
+ "Return appropriate indentation for current line as Lisp code.
+In usual case returns an integer: the column to indent to.
+If the value is nil, that means don't change the indentation
+because the line starts inside a string.
+
+The value can also be a list of the form (COLUMN CONTAINING-SEXP-START).
+This means that following lines at the same level of indentation
+should not necessarily be indented the same as this line.
+Then COLUMN is the column to indent to, and CONTAINING-SEXP-START
+is the buffer position of the start of the containing expression."
+ (save-excursion
+ (beginning-of-line)
+ (let ((indent-point (point))
+ state paren-depth
+ ;; setting this to a number inhibits calling hook
+ (desired-indent nil)
+ (retry t)
+ calculate-lisp-indent-last-sexp containing-sexp)
+ (if parse-start
+ (goto-char parse-start)
+ (beginning-of-defun))
+ ;; Find outermost containing sexp
+ (while (< (point) indent-point)
+ (setq state (parse-partial-sexp (point) indent-point 0)))
+ ;; Find innermost containing sexp
+ (while (and retry
+ state
+ (> (setq paren-depth (elt state 0)) 0))
+ (setq retry nil)
+ (setq calculate-lisp-indent-last-sexp (elt state 2))
+ (setq containing-sexp (elt state 1))
+ ;; Position following last unclosed open.
+ (goto-char (1+ containing-sexp))
+ ;; Is there a complete sexp since then?
+ (if (and calculate-lisp-indent-last-sexp
+ (> calculate-lisp-indent-last-sexp (point)))
+ ;; Yes, but is there a containing sexp after that?
+ (let ((peek (parse-partial-sexp calculate-lisp-indent-last-sexp
+ indent-point 0)))
+ (if (setq retry (car (cdr peek))) (setq state peek)))))
+ (if retry
+ nil
+ ;; Innermost containing sexp found
+ (goto-char (1+ containing-sexp))
+ (if (not calculate-lisp-indent-last-sexp)
+ ;; indent-point immediately follows open paren.
+ ;; Don't call hook.
+ (setq desired-indent (current-column))
+ ;; Find the start of first element of containing sexp.
+ (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
+ (cond ((looking-at "\\s(")
+ ;; First element of containing sexp is a list.
+ ;; Indent under that list.
+ )
+ ((> (save-excursion (forward-line 1) (point))
+ calculate-lisp-indent-last-sexp)
+ ;; This is the first line to start within the containing sexp.
+ ;; It's almost certainly a function call.
+ (if (= (point) calculate-lisp-indent-last-sexp)
+ ;; Containing sexp has nothing before this line
+ ;; except the first element. Indent under that element.
+ nil
+ ;; Skip the first element, find start of second (the first
+ ;; argument of the function call) and indent under.
+ (progn (forward-sexp 1)
+ (parse-partial-sexp (point)
+ calculate-lisp-indent-last-sexp
+ 0 t)))
+ (backward-prefix-chars))
+ (t
+ ;; Indent beneath first sexp on same line as
+ ;; `calculate-lisp-indent-last-sexp'. Again, it's
+ ;; almost certainly a function call.
+ (goto-char calculate-lisp-indent-last-sexp)
+ (beginning-of-line)
+ (parse-partial-sexp (point) calculate-lisp-indent-last-sexp
+ 0 t)
+ (backward-prefix-chars)))))
+ ;; Point is at the point to indent under unless we are inside a string.
+ ;; Call indentation hook except when overridden by lisp-indent-offset
+ ;; or if the desired indentation has already been computed.
+ (let ((normal-indent (current-column)))
+ (cond ((elt state 3)
+ ;; Inside a string, don't change indentation.
+ nil)
+ ((and (integerp lisp-indent-offset) containing-sexp)
+ ;; Indent by constant offset
+ (goto-char containing-sexp)
+ (+ (current-column) lisp-indent-offset))
+ ;; in this case calculate-lisp-indent-last-sexp is not nil
+ (calculate-lisp-indent-last-sexp
+ (or
+ ;; try to align the parameters of a known function
+ (and lisp-indent-function
+ (not retry)
+ (funcall lisp-indent-function indent-point state))
+ ;; If the function has no special alignment
+ ;; or it does not apply to this argument,
+ ;; try to align a constant-symbol under the last
+ ;; preceding constant symbol, if there is such one of
+ ;; the last 2 preceding symbols, in the previous
+ ;; uncommented line.
+ (and (save-excursion
+ (goto-char indent-point)
+ (skip-chars-forward " \t")
+ (looking-at ":"))
+ ;; The last sexp may not be at the indentation
+ ;; where it begins, so find that one, instead.
+ (save-excursion
+ (goto-char calculate-lisp-indent-last-sexp)
+ ;; Handle prefix characters and whitespace
+ ;; following an open paren. (Bug#1012)
+ (backward-prefix-chars)
+ (while (and (not (looking-back "^[ \t]*\\|([ \t]+"))
+ (or (not containing-sexp)
+ (< (1+ containing-sexp) (point))))
+ (forward-sexp -1)
+ (backward-prefix-chars))
+ (setq calculate-lisp-indent-last-sexp (point)))
+ (> calculate-lisp-indent-last-sexp
+ (save-excursion
+ (goto-char (1+ containing-sexp))
+ (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
+ (point)))
+ (let ((parse-sexp-ignore-comments t)
+ indent)
+ (goto-char calculate-lisp-indent-last-sexp)
+ (or (and (looking-at ":")
+ (setq indent (current-column)))
+ (and (< (save-excursion (beginning-of-line) (point))
+ (prog2 (backward-sexp) (point)))
+ (looking-at ":")
+ (setq indent (current-column))))
+ indent))
+ ;; another symbols or constants not preceded by a constant
+ ;; as defined above.
+ normal-indent))
+ ;; in this case calculate-lisp-indent-last-sexp is nil
+ (desired-indent)
+ (t
+ normal-indent))))))
+
+(defun lisp-indent-function (indent-point state)
+ "This function is the normal value of the variable `lisp-indent-function'.
+It is used when indenting a line within a function call, to see if the
+called function says anything special about how to indent the line.
+
+INDENT-POINT is the position where the user typed TAB, or equivalent.
+Point is located at the point to indent under (for default indentation);
+STATE is the `parse-partial-sexp' state for that position.
+
+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
+ 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)
+ (if (and (elt state 2)
+ (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)
+ (beginning-of-line)
+ (parse-partial-sexp (point)
+ calculate-lisp-indent-last-sexp 0 t)))
+ ;; Indent under the list or under the first sexp on the same
+ ;; line as calculate-lisp-indent-last-sexp. Note that first
+ ;; 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))))
+ method)
+ (setq method (or (get (intern-soft function) 'lisp-indent-function)
+ (get (intern-soft function) 'lisp-indent-hook)))
+ (cond ((or (eq method 'defun)
+ (and (null method)
+ (> (length function) 3)
+ (string-match "\\`def" function)))
+ (lisp-indent-defform state indent-point))
+ ((integerp method)
+ (lisp-indent-specform method state
+ indent-point normal-indent))
+ (method
+ (funcall method indent-point state)))))))
+
+(defcustom lisp-body-indent 2
+ "Number of columns to indent the second line of a `(def...)' form."
+ :group 'lisp
+ :type 'integer)
+(put 'lisp-body-indent 'safe-local-variable 'integerp)
+
+(defun lisp-indent-specform (count state indent-point normal-indent)
+ (let ((containing-form-start (elt state 1))
+ (i count)
+ body-indent containing-form-column)
+ ;; Move to the start of containing form, calculate indentation
+ ;; to use for non-distinguished forms (> count), and move past the
+ ;; function symbol. lisp-indent-function guarantees that there is at
+ ;; least one word or symbol character following open paren of containing
+ ;; form.
+ (goto-char containing-form-start)
+ (setq containing-form-column (current-column))
+ (setq body-indent (+ lisp-body-indent containing-form-column))
+ (forward-char 1)
+ (forward-sexp 1)
+ ;; Now find the start of the last form.
+ (parse-partial-sexp (point) indent-point 1 t)
+ (while (and (< (point) indent-point)
+ (condition-case ()
+ (progn
+ (setq count (1- count))
+ (forward-sexp 1)
+ (parse-partial-sexp (point) indent-point 1 t))
+ (error nil))))
+ ;; Point is sitting on first character of last (or count) sexp.
+ (if (> count 0)
+ ;; A distinguished form. If it is the first or second form use double
+ ;; lisp-body-indent, else normal indent. With lisp-body-indent bound
+ ;; to 2 (the default), this just happens to work the same with if as
+ ;; the older code, but it makes unwind-protect, condition-case,
+ ;; with-output-to-temp-buffer, et. al. much more tasteful. The older,
+ ;; less hacked, behavior can be obtained by replacing below with
+ ;; (list normal-indent containing-form-start).
+ (if (<= (- i count) 1)
+ (list (+ containing-form-column (* 2 lisp-body-indent))
+ containing-form-start)
+ (list normal-indent containing-form-start))
+ ;; A non-distinguished form. Use body-indent if there are no
+ ;; distinguished forms and this is the first undistinguished form,
+ ;; or if this is the first undistinguished form and the preceding
+ ;; distinguished form has indentation at least as great as body-indent.
+ (if (or (and (= i 0) (= count 0))
+ (and (= count 0) (<= body-indent normal-indent)))
+ body-indent
+ normal-indent))))
+
+(defun lisp-indent-defform (state indent-point)
+ (goto-char (car (cdr state)))
+ (forward-line 1)
+ (if (> (point) (car (cdr (cdr state))))
+ (progn
+ (goto-char (car (cdr state)))
+ (+ lisp-body-indent (current-column)))))
+
+
+;; (put 'progn 'lisp-indent-function 0), say, causes progn to be indented
+;; like defun if the first form is placed on the next line, otherwise
+;; it is indented like any other form (i.e. forms line up under first).
+
+(put 'lambda 'lisp-indent-function 'defun)
+(put 'autoload 'lisp-indent-function 'defun)
+(put 'progn 'lisp-indent-function 0)
+(put 'prog1 'lisp-indent-function 1)
+(put 'prog2 'lisp-indent-function 2)
+(put 'save-excursion 'lisp-indent-function 0)
+(put 'save-window-excursion 'lisp-indent-function 0)
+(put 'save-selected-window 'lisp-indent-function 0)
+(put 'save-restriction 'lisp-indent-function 0)
+(put 'save-match-data 'lisp-indent-function 0)
+(put 'save-current-buffer 'lisp-indent-function 0)
+(put 'with-current-buffer 'lisp-indent-function 1)
+(put 'combine-after-change-calls 'lisp-indent-function 0)
+(put 'with-output-to-string 'lisp-indent-function 0)
+(put 'with-temp-file 'lisp-indent-function 1)
+(put 'with-temp-buffer 'lisp-indent-function 0)
+(put 'with-temp-message 'lisp-indent-function 1)
+(put 'with-syntax-table 'lisp-indent-function 1)
+(put 'let 'lisp-indent-function 1)
+(put 'let* 'lisp-indent-function 1)
+(put 'while 'lisp-indent-function 1)
+(put 'if 'lisp-indent-function 2)
+(put 'read-if 'lisp-indent-function 2)
+(put 'catch 'lisp-indent-function 1)
+(put 'condition-case 'lisp-indent-function 2)
+(put 'unwind-protect 'lisp-indent-function 1)
+(put 'with-output-to-temp-buffer 'lisp-indent-function 1)
+(put 'eval-after-load 'lisp-indent-function 1)
+(put 'dolist 'lisp-indent-function 1)
+(put 'dotimes 'lisp-indent-function 1)
+(put 'when 'lisp-indent-function 1)
+(put 'unless 'lisp-indent-function 1)
+
+(defun indent-sexp (&optional endpos)
+ "Indent each line of the list starting just after point.
+If optional arg ENDPOS is given, indent each line, stopping when
+ENDPOS is encountered."
+ (interactive)
+ (let ((indent-stack (list nil))
+ (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 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)))
+ (save-excursion
+ (setq outer-loop-done nil)
+ (while (if endpos (< (point) endpos)
+ (not outer-loop-done))
+ (setq last-depth next-depth
+ inner-loop-done nil)
+ ;; Parse this line so we can learn the state
+ ;; to indent the next line.
+ ;; This inner loop goes through only once
+ ;; unless a line ends inside a string.
+ (while (and (not inner-loop-done)
+ (not (setq outer-loop-done (eobp))))
+ (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
+ nil nil state))
+ (setq next-depth (car state))
+ ;; If the line contains a comment other than the sort
+ ;; that is indented like code,
+ ;; indent it now with indent-for-comment.
+ ;; Comments indented like code are right already.
+ ;; In any case clear the in-comment flag in the state
+ ;; because parse-partial-sexp never sees the newlines.
+ (if (car (nthcdr 4 state))
+ (progn (indent-for-comment)
+ (end-of-line)
+ (setcar (nthcdr 4 state) nil)))
+ ;; If this line ends inside a string,
+ ;; go straight to next line, remaining within the inner loop,
+ ;; and turn off the \-flag.
+ (if (car (nthcdr 3 state))
+ (progn
+ (forward-line 1)
+ (setcar (nthcdr 5 state) nil))
+ (setq inner-loop-done t)))
+ (and endpos
+ (<= next-depth 0)
+ (progn
+ (setq indent-stack (nconc indent-stack
+ (make-list (- next-depth) nil))
+ last-depth (- last-depth next-depth)
+ next-depth 0)))
+ (forward-line 1)
+ ;; Decide whether to exit.
+ (if endpos
+ ;; If we have already reached the specified end,
+ ;; give up and do not reindent this line.
+ (if (<= endpos (point))
+ (setq outer-loop-done t))
+ ;; If no specified end, we are done if we have finished one sexp.
+ (if (<= next-depth 0)
+ (setq outer-loop-done t)))
+ (unless outer-loop-done
+ (while (> last-depth next-depth)
+ (setq indent-stack (cdr indent-stack)
+ last-depth (1- last-depth)))
+ (while (< last-depth next-depth)
+ (setq indent-stack (cons nil indent-stack)
+ last-depth (1+ last-depth)))
+ ;; Now indent the next line according
+ ;; to what we learned from parsing the previous one.
+ (setq bol (point))
+ (skip-chars-forward " \t")
+ ;; But not if the line is blank, or just a comment
+ ;; (except for double-semi comments; indent them as usual).
+ (if (or (eobp) (looking-at "\\s<\\|\n"))
+ nil
+ (if (and (car indent-stack)
+ (>= (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 (null val)
+ (setq this-indent val)
+ (if (integerp val)
+ (setcar indent-stack
+ (setq this-indent val))
+ (setcar indent-stack (- (car (cdr val))))
+ (setq this-indent (car val))))))
+ (if (and this-indent (/= (current-column) this-indent))
+ (progn (delete-region bol (point))
+ (indent-to this-indent)))))
+ (or outer-loop-done
+ (setq outer-loop-done (= (point) last-point))
+ (setq last-point (point)))))))
+
+(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 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)
+ ;; 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
+ ;; are buffer-local, but we avoid changing them so that they can be set
+ ;; to make `forward-paragraph' and friends do something the user wants.
+ ;;
+ ;; `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-*\\([(;:\"]\\|`(\\|#'(\\)"))
+ (paragraph-separate
+ (concat paragraph-separate "\\|\\s-*\".*[,\\.]$"))
+ (fill-column (if (and (integerp emacs-lisp-docstring-fill-column)
+ (derived-mode-p 'emacs-lisp-mode))
+ emacs-lisp-docstring-fill-column
+ fill-column)))
+ (fill-paragraph justify))
+ ;; Never return nil.
+ 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.
+
+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."
+ (interactive "r\np")
+ (let (state)
+ (save-excursion
+ (goto-char end)
+ (setq end (point-marker))
+ (goto-char start)
+ (or (bolp)
+ (setq state (parse-partial-sexp (point)
+ (progn
+ (forward-line 1) (point))
+ nil nil state)))
+ (while (< (point) end)
+ (or (car (nthcdr 3 state))
+ (and nochange-regexp
+ (looking-at nochange-regexp))
+ ;; If line does not start in string, indent it
+ (let ((indent (current-indentation)))
+ (delete-region (point) (progn (skip-chars-forward " \t") (point)))
+ (or (eolp)
+ (indent-to (max 0 (+ indent arg)) 0))))
+ (setq state (parse-partial-sexp (point)
+ (progn
+ (forward-line 1) (point))
+ nil nil state))))))
+
+(provide 'lisp-mode)
+
+;; arch-tag: 414c7f93-c245-4b77-8ed5-ed05ef7ff1bf
+;;; lisp-mode.el ends here