(defvar lisp-mode-abbrev-table nil)
(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 ? " " table)
(modify-syntax-entry ?\t " " table)
(modify-syntax-entry ?\f " " table)
(modify-syntax-entry ?\n "> " table)
(modify-syntax-entry ?\^m "> " table)
(modify-syntax-entry ?\ (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)
(modify-syntax-entry ?\) ")( " table)
(modify-syntax-entry ?\[ "(] " table)
(modify-syntax-entry ?\] ")[ " table))
table))
(defvar lisp-mode-syntax-table
(let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
(modify-syntax-entry ?\[ "_ " table)
(modify-syntax-entry ?\] "_ " table)
(modify-syntax-entry ?# "' 14bn" table)
(modify-syntax-entry ?| "\" 23b" table)
table))
(define-abbrev-table 'lisp-mode-abbrev-table ())
(defvar lisp-imenu-generic-expression
(list
(list nil
(purecopy "^\\s-*(def\\(un\\*?\\|subst\\|macro\\|advice\\|\
ine-skeleton\\|ine-minor-mode\\)\\s-+\\(\\sw\\(\\sw\\|\\s_\\)+\\)") 2)
(list (purecopy "Variables")
(purecopy "^\\s-*(def\\(var\\|const\\|custom\\)\\s-+\
\\(\\sw\\(\\sw\\|\\s_\\)+\\)") 2)
(list (purecopy "Types")
(purecopy "^\\s-*(def\\(group\\|type\\|struct\\|class\\|\
ine-condition\\|ine-widget\\|face\\)\\s-+'?\\(\\sw\\(\\sw\\|\\s_\\)+\\)")
2))
"Imenu generic expression for Lisp mode. See `imenu-generic-expression'.")
(defun lisp-mode-variables (lisp-syntax)
(cond (lisp-syntax
(set-syntax-table lisp-mode-syntax-table)))
(setq local-abbrev-table lisp-mode-abbrev-table)
(make-local-variable 'paragraph-start)
(setq paragraph-start (concat page-delimiter "\\|$" ))
(make-local-variable 'paragraph-separate)
(setq paragraph-separate paragraph-start)
(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)
(make-local-variable 'adaptive-fill-mode)
(setq adaptive-fill-mode nil)
(make-local-variable 'normal-auto-fill-function)
(setq normal-auto-fill-function 'lisp-mode-auto-fill)
(make-local-variable 'indent-line-function)
(setq indent-line-function 'lisp-indent-line)
(make-local-variable 'indent-region-function)
(setq indent-region-function 'lisp-indent-region)
(make-local-variable 'parse-sexp-ignore-comments)
(setq parse-sexp-ignore-comments t)
(make-local-variable 'outline-regexp)
(setq outline-regexp ";;;;* \\|(")
(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)
(setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
(make-local-variable 'comment-add)
(setq comment-add 1) (make-local-variable 'comment-column)
(setq comment-column 40)
(make-local-variable 'comment-indent-function)
(setq comment-indent-function 'lisp-comment-indent)
(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)
(setq font-lock-defaults
'((lisp-font-lock-keywords
lisp-font-lock-keywords-1 lisp-font-lock-keywords-2)
nil nil (("+-*/.<>=!?$%_&~^:" . "w")) beginning-of-defun
(font-lock-mark-block-function . mark-defun))))
(defun lisp-outline-level ()
"Lisp mode `outline-level' function."
(if (looking-at "(")
1000
(looking-at outline-regexp)
(- (match-end 0) (match-beginning 0))))
(defvar lisp-mode-shared-map
(let ((map (make-sparse-keymap)))
(define-key map "\t" 'lisp-indent-line)
(define-key map "\e\C-q" 'indent-sexp)
(define-key map "\177" 'backward-delete-char-untabify)
map)
"Keymap for commands shared by all sorts of Lisp modes.")
(defvar emacs-lisp-mode-map ()
"Keymap for Emacs Lisp mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
(if emacs-lisp-mode-map
()
(let ((map (make-sparse-keymap "Emacs-Lisp")))
(setq emacs-lisp-mode-map (make-sparse-keymap))
(set-keymap-parent emacs-lisp-mode-map lisp-mode-shared-map)
(define-key emacs-lisp-mode-map "\e\t" 'lisp-complete-symbol)
(define-key emacs-lisp-mode-map "\e\C-x" 'eval-defun)
(define-key emacs-lisp-mode-map [menu-bar] (make-sparse-keymap))
(define-key emacs-lisp-mode-map [menu-bar emacs-lisp]
(cons "Emacs-Lisp" map))
(define-key map [edebug-defun]
'("Instrument Function for Debugging" . edebug-defun))
(define-key map [byte-recompile]
'("Byte-recompile Directory..." . byte-recompile-directory))
(define-key map [emacs-byte-compile-and-load]
'("Byte-compile And Load" . emacs-lisp-byte-compile-and-load))
(define-key map [byte-compile]
'("Byte-compile This File" . emacs-lisp-byte-compile))
(define-key map [separator-eval] '("--"))
(define-key map [eval-buffer] '("Evaluate Buffer" . eval-current-buffer))
(define-key map [eval-region] '("Evaluate Region" . eval-region))
(define-key map [eval-sexp] '("Evaluate Last S-expression" . eval-last-sexp))
(define-key map [separator-format] '("--"))
(define-key map [comment-region] '("Comment Out Region" . comment-region))
(define-key map [indent-region] '("Indent Region" . indent-region))
(define-key map [indent-line] '("Indent Line" . lisp-indent-line))
(put 'eval-region 'menu-enable 'mark-active)
(put 'comment-region 'menu-enable 'mark-active)
(put 'indent-region 'menu-enable 'mark-active)))
(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)
(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."
(lisp-mode-variables nil)
(setq imenu-case-fold-search nil))
(defvar lisp-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map lisp-mode-shared-map)
(define-key map "\e\C-x" 'lisp-eval-defun)
(define-key map "\C-c\C-z" 'run-lisp)
map)
"Keymap for ordinary Lisp mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
(define-derived-mode lisp-mode nil "Lisp"
"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."
(lisp-mode-variables t)
(make-local-variable 'font-lock-keywords-case-fold-search)
(setq font-lock-keywords-case-fold-search t)
(setq imenu-case-fold-search t))
(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)))
(set-keymap-parent map lisp-mode-shared-map)
(define-key map "\e\C-x" 'eval-defun)
(define-key map "\e\t" 'lisp-complete-symbol)
(define-key map "\n" 'eval-print-last-sexp)
map)
"Keymap for Lisp Interaction mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
(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 controled 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.
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 ()
"Toggle between abbreviated and unabbreviated printed representations."
(interactive)
(let ((value (get-text-property (point) 'printed-value)))
(when value
(let ((beg (previous-single-property-change (point) 'printed-value))
(end (next-single-char-property-change (point) 'printed-value))
(standard-output (current-buffer))
(point (point)))
(delete-region beg end)
(insert (nth 1 value))
(last-sexp-setup-props beg (point)
(nth 0 value)
(nth 2 value)
(nth 1 value))
(goto-char (min (point-max) point))))))
(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)))
(let ((value
(eval (let ((stab (syntax-table))
(opoint (point))
ignore-quotes
expr)
(unwind-protect
(save-excursion
(set-syntax-table emacs-lisp-mode-syntax-table)
(setq ignore-quotes
(or (eq (following-char) ?\')
(eq (preceding-char) ?\')))
(forward-sexp -1)
(when (eq (preceding-char) ?\\)
(forward-char -1)
(when (eq (preceding-char) ??)
(forward-char -1)))
(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
(if (and ignore-quotes
(eq (following-char) ?`))
(forward-char))
(narrow-to-region (point-min) opoint)
(setq expr (read (current-buffer)))
(and (consp expr)
(eq (car expr) 'interactive)
(setq expr
(list 'call-interactively
(list 'quote
(list 'lambda
'(&rest args)
expr
'args)))))
expr))
(set-syntax-table stab))))))
(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)
(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))
))))))
(defun eval-last-sexp (eval-last-sexp-arg-internal)
"Evaluate sexp before point; print value in minibuffer.
Interactively, with prefix argument, print output into current buffer."
(interactive "P")
(if (null eval-expression-debug-on-error)
(eval-last-sexp-1 eval-last-sexp-arg-internal)
(let ((old-value (make-symbol "t")) new-value value)
(let ((debug-on-error old-value))
(setq value (eval-last-sexp-1 eval-last-sexp-arg-internal))
(setq new-value debug-on-error))
(unless (eq old-value new-value)
(setq debug-on-error new-value))
value)))
(defun eval-defun-1 (form)
"Change defvar into defconst within FORM.
Likewise for other constructs as necessary."
(cond ((not (listp form))
form)
((and (eq (car form) 'defvar)
(cdr-safe (cdr-safe form)))
(cons 'defconst (cdr form)))
((and (eq (car form) 'custom-declare-variable)
(default-boundp (eval (nth 1 form))))
(set-default (eval (nth 1 form)) (eval (nth 1 (nth 2 form))))
form)
((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")
(let ((debug-on-error eval-expression-debug-on-error)
(print-length eval-expression-print-length)
(print-level eval-expression-print-level))
(save-excursion
(apply
#'eval-region
(let ((standard-output t)
beg end form)
(save-excursion
(end-of-defun)
(beginning-of-defun)
(setq beg (point))
(setq form (read (current-buffer)))
(setq end (point)))
(setq form (eval-defun-1 (macroexpand form)))
(list beg end standard-output
`(lambda (ignore)
(goto-char ,end)
',form))))))
(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.)
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)))))
(defun lisp-comment-indent ()
(if (looking-at "\\s<\\s<\\s<")
(current-column)
(if (looking-at "\\s<\\s<")
(let ((tem (or (calculate-lisp-indent) (current-column))))
(if (listp tem) (car tem) tem))
(skip-chars-backward " \t")
(max (if (bolp) 0 (1+ (current-column)))
comment-column))))
(defun lisp-mode-auto-fill ()
(if (> (current-column) (current-fill-column))
(if (save-excursion
(nth 4 (parse-partial-sexp (save-excursion
(beginning-of-defun)
(point))
(point))))
(do-auto-fill)
(let ((comment-start nil) (comment-start-skip nil))
(do-auto-fill)))))
(defvar lisp-indent-offset nil
"If non-nil, indent second line of expressions that many more columns.")
(defvar lisp-indent-function 'lisp-indent-function)
(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 beg end
(pos (- (point-max) (point))))
(beginning-of-line)
(setq beg (point))
(skip-chars-forward " \t")
(if (or (null indent) (looking-at "\\s<\\s<\\s<"))
(goto-char (- (point-max) pos))
(if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<")))
(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 (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos)))
(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
(desired-indent nil)
(retry t)
calculate-lisp-indent-last-sexp containing-sexp)
(if parse-start
(goto-char parse-start)
(beginning-of-defun))
(while (< (point) indent-point)
(setq state (parse-partial-sexp (point) indent-point 0)))
(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))
(goto-char (1+ containing-sexp))
(if (and calculate-lisp-indent-last-sexp
(> calculate-lisp-indent-last-sexp (point)))
(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
(goto-char (1+ containing-sexp))
(if (not calculate-lisp-indent-last-sexp)
(setq desired-indent (current-column))
(parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
(cond ((looking-at "\\s(")
)
((> (save-excursion (forward-line 1) (point))
calculate-lisp-indent-last-sexp)
(if (= (point) calculate-lisp-indent-last-sexp)
nil
(progn (forward-sexp 1)
(parse-partial-sexp (point)
calculate-lisp-indent-last-sexp
0 t)))
(backward-prefix-chars))
(t
(goto-char calculate-lisp-indent-last-sexp)
(beginning-of-line)
(parse-partial-sexp (point) calculate-lisp-indent-last-sexp
0 t)
(backward-prefix-chars)))))
(let ((normal-indent (current-column)))
(cond ((elt state 3)
nil)
((and (integerp lisp-indent-offset) containing-sexp)
(goto-char containing-sexp)
(+ (current-column) lisp-indent-offset))
(desired-indent)
((and (boundp 'lisp-indent-function)
lisp-indent-function
(not retry))
(or (funcall lisp-indent-function indent-point state)
normal-indent))
(t
normal-indent))))))
(defun lisp-indent-function (indent-point state)
(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_")))
(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)))
(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 state indent-point)))))))
(defvar lisp-body-indent 2
"Number of columns to indent the second line of a `(def...)' form.")
(defun lisp-indent-specform (count state indent-point normal-indent)
(let ((containing-form-start (elt state 1))
(i count)
body-indent containing-form-column)
(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)
(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))))
(if (> count 0)
(if (<= (- i count) 1)
(list (+ containing-form-column (* 2 lisp-body-indent))
containing-form-start)
(list normal-indent containing-form-start))
(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 '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 '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)
(starting-point (if endpos nil (point)))
(last-point (point))
last-depth bol outer-loop-done inner-loop-done state this-indent)
(or endpos
(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)
(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 (car (nthcdr 4 state))
(progn (indent-for-comment)
(end-of-line)
(setcar (nthcdr 4 state) nil)))
(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)))
(or outer-loop-done endpos
(setq outer-loop-done (<= next-depth 0)))
(if outer-loop-done
(forward-line 1)
(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)))
(forward-line 1)
(setq bol (point))
(skip-chars-forward " \t")
(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 lisp-indent-region (start end)
"Indent every line whose first char is between START and END inclusive."
(save-excursion
(let ((endmark (copy-marker end)))
(goto-char start)
(and (bolp) (not (eolp))
(lisp-indent-line))
(indent-sexp endmark)
(set-marker endmark nil))))
(defun lisp-fill-paragraph (&optional justify)
"Like \\[fill-paragraph], but handle Emacs Lisp comments.
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")
(let (
has-comment
has-code-and-comment
comment-fill-prefix
)
(save-excursion
(beginning-of-line)
(cond
((looking-at "[ \t]*;[; \t]*")
(setq has-comment t
comment-fill-prefix (buffer-substring (match-beginning 0)
(match-end 0))))
((condition-case nil
(save-restriction
(narrow-to-region (point-min)
(save-excursion (end-of-line) (point)))
(while (not (looking-at ";\\|$"))
(skip-chars-forward "^;\n\"\\\\?")
(cond
((eq (char-after (point)) ?\\) (forward-char 2))
((memq (char-after (point)) '(?\" ??)) (forward-sexp 1))))
(looking-at " (error nil))
(setq has-comment t has-code-and-comment t)
(setq comment-fill-prefix
(concat (make-string (/ (current-column) 8) ?\t)
(make-string (% (current-column) 8) ?\ )
(buffer-substring (match-beginning 0) (match-end 0)))))))
(if (not has-comment)
(let ((paragraph-start (concat paragraph-start
"\\|\\s-*[\(;:\"]")))
(fill-paragraph justify))
(save-excursion
(save-restriction
(beginning-of-line)
(narrow-to-region
(save-excursion
(while (and (zerop (forward-line -1))
(looking-at "^[ \t]*;")))
(or (looking-at ".*;")
(forward-line 1))
(point))
(save-excursion
(while (progn (forward-line 1)
(looking-at "^[ \t]*;")))
(point)))
(let* ((paragraph-start (concat paragraph-start "\\|[ \t;]*$"))
(paragraph-separate (concat paragraph-start "\\|[ \t;]*$"))
(paragraph-ignore-fill-prefix nil)
(fill-prefix comment-fill-prefix)
(after-line (if has-code-and-comment
(save-excursion
(forward-line 1) (point))))
(end (progn
(forward-paragraph)
(or (bolp) (newline 1))
(point)))
(beg (progn (backward-paragraph)
(if (eq (point) after-line)
(forward-line -1))
(point))))
(fill-region-as-paragraph beg end
justify nil
(save-excursion
(goto-char beg)
(if (looking-at fill-prefix)
nil
(re-search-forward comment-start-skip)
(point))))))))
t))
(defun indent-code-rigidly (start end arg &optional nochange-regexp)
"Indent all lines of code, starting in the region, sideways by ARG columns.
Does not affect lines starting inside comments or strings, assuming that
the start of the region is not inside them.
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))
(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)