------------------------------------------------------------ revno: 116964 committer: Daniel Colascione branch nick: trunk timestamp: Wed 2014-04-09 17:05:34 -0700 message: Increase BASE_PURESIZE diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2014-04-09 13:21:30 +0000 +++ src/ChangeLog 2014-04-10 00:05:34 +0000 @@ -1,3 +1,7 @@ +2014-04-10 Daniel Colascione + + * puresize.h (BASE_PURESIZE): Increase. + 2014-04-09 Stefan Monnier * keyboard.c (syms_of_keyboard): Make deactivate-mark buffer-local. === modified file 'src/puresize.h' --- src/puresize.h 2014-01-01 07:43:34 +0000 +++ src/puresize.h 2014-04-10 00:05:34 +0000 @@ -40,7 +40,7 @@ #endif #ifndef BASE_PURESIZE -#define BASE_PURESIZE (1700000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) +#define BASE_PURESIZE (1800000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) #endif /* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */ ------------------------------------------------------------ revno: 116963 committer: Daniel Colascione branch nick: trunk timestamp: Wed 2014-04-09 09:58:08 -0700 message: Make up-list and backward-up-list get out of more spots diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2014-04-08 10:33:48 +0000 +++ doc/lispref/ChangeLog 2014-04-09 16:58:08 +0000 @@ -1,3 +1,11 @@ +2014-04-09 Daniel Colascione + + * errors.texi (Standard Errors): Document required error + parameters for `scan-error'. + + * positions.texi (List Motion): Explain new `up-list' arguments. + Mention `backward-up-list'. + 2014-04-08 Daniel Colascione * minibuf.texi (Programmed Completion): Improve phrasing, remove === modified file 'doc/lispref/errors.texi' --- doc/lispref/errors.texi 2014-01-01 07:43:34 +0000 +++ doc/lispref/errors.texi 2014-04-09 16:58:08 +0000 @@ -157,7 +157,10 @@ @item scan-error The message is @samp{Scan error}. This happens when certain syntax-parsing functions find invalid syntax or mismatched -parentheses. @xref{List Motion}, and @xref{Parsing Expressions}. +parentheses. Conventionally raised with three argument: a +human-readable error message, the start of the obstacle that cannot be +moved over, and the end of the obstacle. @xref{List Motion}, and +@xref{Parsing Expressions}. @item search-failed The message is @samp{Search failed}. @xref{Searching and Matching}. === modified file 'doc/lispref/positions.texi' --- doc/lispref/positions.texi 2014-02-06 04:27:26 +0000 +++ doc/lispref/positions.texi 2014-04-09 16:58:08 +0000 @@ -647,9 +647,19 @@ quotes are ignored.) @end deffn -@deffn Command up-list &optional arg -This function moves forward out of @var{arg} (default 1) levels of parentheses. -A negative argument means move backward but still to a less deep spot. +@deffn Command up-list &optional arg escape-strings no-syntax-crossing +This function moves forward out of @var{arg} (default 1) levels of +parentheses. A negative argument means move backward but still to a +less deep spot. If @var{escape-strings} is non-nil (as it is +interactively), move out of enclosing strings as well. If +@var{no-syntax-crossing} is non-nil (as it is interactively), prefer +to break out of any enclosing string instead of moving to the start of +a list broken across multiple strings. On error, location of point is +unspecified. +@end deffn + +@deffn Command backward-up-list &optional arg escape-strings no-syntax-crossing +This function is just like @code{up-list}, but with a negated argument. @end deffn @deffn Command down-list &optional arg === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-04-09 13:37:49 +0000 +++ lisp/ChangeLog 2014-04-09 16:58:08 +0000 @@ -1,3 +1,11 @@ +2014-04-09 Daniel Colascione + + * emacs-lisp/lisp.el (backward-up-list): Add `escape-strings', + `no-syntax-crossing' arguments. Forward to `up-list'. + (up-list): Add `escape-strings', `no-syntax-crossing' arguments. + Implement logic for escaping from strings. Use narrowing to deal + with corner cases. + 2014-04-09 Leo Liu * net/rcirc.el (rcirc-connection-info): New variable. === modified file 'lisp/emacs-lisp/lisp.el' --- lisp/emacs-lisp/lisp.el 2014-02-26 02:31:27 +0000 +++ lisp/emacs-lisp/lisp.el 2014-04-09 16:58:08 +0000 @@ -57,10 +57,14 @@ (defun forward-sexp (&optional arg) "Move forward across one balanced expression (sexp). -With ARG, do it that many times. Negative arg -N means -move backward across N balanced expressions. -This command assumes point is not in a string or comment. -Calls `forward-sexp-function' to do the work, if that is non-nil." +With ARG, do it that many times. Negative arg -N means move +backward across N balanced expressions. This command assumes +point is not in a string or comment. Calls +`forward-sexp-function' to do the work, if that is non-nil. If +unable to move over a sexp, signal `scan-error' with three +arguments: a message, the start of the obstacle (usually a +parenthesis or list marker of some kind), and end of the +obstacle." (interactive "^p") (or arg (setq arg 1)) (if forward-sexp-function @@ -140,38 +144,92 @@ (goto-char (or (scan-lists (point) inc -1) (buffer-end arg))) (setq arg (- arg inc))))) -(defun backward-up-list (&optional arg) +(defun backward-up-list (&optional arg escape-strings no-syntax-crossing) "Move backward out of one level of parentheses. This command will also work on other parentheses-like expressions -defined by the current language mode. -With ARG, do this that many times. -A negative argument means move forward but still to a less deep spot. -This command assumes point is not in a string or comment." - (interactive "^p") - (up-list (- (or arg 1)))) +defined by the current language mode. With ARG, do this that +many times. A negative argument means move forward but still to +a less deep spot. If ESCAPE-STRINGS is non-nil (as it is +interactively), move out of enclosing strings as well. If +NO-SYNTAX-CROSSING is non-nil (as it is interactively), prefer to +break out of any enclosing string instead of moving to the start +of a list broken across multiple strings. On error, location of +point is unspecified." + (interactive "^p\nd\nd") + (up-list (- (or arg 1)) escape-strings no-syntax-crossing)) -(defun up-list (&optional arg) +(defun up-list (&optional arg escape-strings no-syntax-crossing) "Move forward out of one level of parentheses. This command will also work on other parentheses-like expressions -defined by the current language mode. -With ARG, do this that many times. -A negative argument means move backward but still to a less deep spot. -This command assumes point is not in a string or comment." - (interactive "^p") +defined by the current language mode. With ARG, do this that +many times. A negative argument means move backward but still to +a less deep spot. If ESCAPE-STRINGS is non-nil (as it is +interactively), move out of enclosing strings as well. If +NO-SYNTAX-CROSSING is non-nil (as it is interactively), prefer to +break out of any enclosing string instead of moving to the start +of a list broken across multiple strings. On error, location of +point is unspecified." + (interactive "^p\nd\nd") (or arg (setq arg 1)) (let ((inc (if (> arg 0) 1 -1)) - pos) + (pos nil)) (while (/= arg 0) - (if (null forward-sexp-function) - (goto-char (or (scan-lists (point) inc 1) (buffer-end arg))) - (condition-case err - (while (progn (setq pos (point)) - (forward-sexp inc) - (/= (point) pos))) - (scan-error (goto-char (nth (if (> arg 0) 3 2) err)))) - (if (= (point) pos) - (signal 'scan-error - (list "Unbalanced parentheses" (point) (point))))) + (condition-case err + (save-restriction + ;; If we've been asked not to cross string boundaries + ;; and we're inside a string, narrow to that string so + ;; that scan-lists doesn't find a match in a different + ;; string. + (when no-syntax-crossing + (let* ((syntax (syntax-ppss)) + (string-comment-start (nth 8 syntax))) + (when string-comment-start + (save-excursion + (goto-char string-comment-start) + (narrow-to-region + (point) + (if (nth 3 syntax) ; in string + (condition-case nil + (progn (forward-sexp) (point)) + (scan-error (point-max))) + (forward-comment 1) + (point))))))) + (if (null forward-sexp-function) + (goto-char (or (scan-lists (point) inc 1) + (buffer-end arg))) + (condition-case err + (while (progn (setq pos (point)) + (forward-sexp inc) + (/= (point) pos))) + (scan-error (goto-char (nth (if (> arg 0) 3 2) err)))) + (if (= (point) pos) + (signal 'scan-error + (list "Unbalanced parentheses" (point) (point)))))) + (scan-error + (let ((syntax nil)) + (or + ;; If we bumped up against the end of a list, see whether + ;; we're inside a string: if so, just go to the beginning + ;; or end of that string. + (and escape-strings + (or syntax (setf syntax (syntax-ppss))) + (nth 3 syntax) + (goto-char (nth 8 syntax)) + (progn (when (> inc 0) + (forward-sexp)) + t)) + ;; If we narrowed to a comment above and failed to escape + ;; it, the error might be our fault, not an indication + ;; that we're out of syntax. Try again from beginning or + ;; end of the comment. + (and no-syntax-crossing + (or syntax (setf syntax (syntax-ppss))) + (nth 4 syntax) + (goto-char (nth 8 syntax)) + (or (< inc 0) + (forward-comment 1)) + (setf arg (+ arg inc))) + (signal (car err) (cdr err)))))) (setq arg (- arg inc))))) (defun kill-sexp (&optional arg) === modified file 'test/ChangeLog' --- test/ChangeLog 2014-04-09 03:37:56 +0000 +++ test/ChangeLog 2014-04-09 16:58:08 +0000 @@ -1,3 +1,7 @@ +2014-04-09 Daniel Colascione + + * automated/syntax-tests.el: New file. + 2014-04-09 Glenn Morris * automated/python-tests.el (python-triple-quote-pairing): === added file 'test/automated/syntax-tests.el' --- test/automated/syntax-tests.el 1970-01-01 00:00:00 +0000 +++ test/automated/syntax-tests.el 2014-04-09 16:58:08 +0000 @@ -0,0 +1,97 @@ +;;; syntax-tests.el --- Testing syntax rules and basic movement -*- lexical-binding: t -*- + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: Daniel Colascione +;; Keywords: + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; + +;;; Code: +(require 'ert) +(require 'cl-lib) + +(defun run-up-list-test (fn data start instructions) + (cl-labels ((posof (thing) + (and (symbolp thing) + (= (length (symbol-name thing)) 1) + (- (aref (symbol-name thing) 0) ?a -1)))) + (with-temp-buffer + (set-syntax-table (make-syntax-table)) + ;; Use a syntax table in which single quote is a string + ;; character so that we can embed the test data in a lisp string + ;; literal. + (modify-syntax-entry ?\' "\"") + (insert data) + (goto-char (posof start)) + (dolist (instruction instructions) + (cond ((posof instruction) + (funcall fn) + (should (eql (point) (posof instruction)))) + ((symbolp instruction) + (should-error (funcall fn) + :type instruction)) + (t (cl-assert nil nil "unknown ins"))))))) + +(defmacro define-up-list-test (name fn data start &rest expected) + `(ert-deftest ,name () + (run-up-list-test ,fn ,data ',start ',expected))) + +(define-up-list-test up-list-basic + (lambda () (up-list)) + (or "(1 1 (1 1) 1 (1 1) 1)") + ;; abcdefghijklmnopqrstuv + i k v scan-error) + +(define-up-list-test up-list-with-forward-sexp-function + (lambda () + (let ((forward-sexp-function + (lambda (&optional arg) + (let ((forward-sexp-function nil)) + (forward-sexp arg))))) + (up-list))) + (or "(1 1 (1 1) 1 (1 1) 1)") + ;; abcdefghijklmnopqrstuv + i k v scan-error) + +(define-up-list-test up-list-out-of-string + (lambda () (up-list 1 t)) + (or "1 (1 '2 2 (2 2 2' 1) 1") + ;; abcdefghijklmnopqrstuvwxy + o r u scan-error) + +(define-up-list-test up-list-cross-string + (lambda () (up-list 1 t)) + (or "(1 '2 ( 2' 1 '2 ) 2' 1)") + ;; abcdefghijklmnopqrstuvwxy + i r u x scan-error) + +(define-up-list-test up-list-no-cross-string + (lambda () (up-list 1 t t)) + (or "(1 '2 ( 2' 1 '2 ) 2' 1)") + ;; abcdefghijklmnopqrstuvwxy + i k x scan-error) + +(define-up-list-test backward-up-list-basic + (lambda () (backward-up-list)) + (or "(1 1 (1 1) 1 (1 1) 1)") + ;; abcdefghijklmnopqrstuv + i f a scan-error) + +(provide 'syntax-tests) +;;; syntax-tests.el ends here ------------------------------------------------------------ revno: 116962 committer: Daniel Colascione branch nick: trunk timestamp: Wed 2014-04-09 08:33:43 -0700 message: Tweak regex from last change diff: === modified file 'lisp/emacs-lisp/cl-indent.el' --- lisp/emacs-lisp/cl-indent.el 2014-04-09 08:16:41 +0000 +++ lisp/emacs-lisp/cl-indent.el 2014-04-09 15:33:43 +0000 @@ -320,7 +320,7 @@ (when (and (derived-mode-p 'emacs-lisp-mode) (not (lisp-indent-find-method (intern-soft function) t)) - (string-match "^cl-" function) + (string-match "\\`cl-" function) (setf tem (intern-soft (substring function (match-end 0)))) (lisp-indent-find-method tem t)) ------------------------------------------------------------ revno: 116961 fixes bug: http://debbugs.gnu.org/17045 committer: Leo Liu branch nick: trunk timestamp: Wed 2014-04-09 21:37:49 +0800 message: New command rcirc-cmd-reconnect * net/rcirc.el (rcirc-connection-info): New variable. (rcirc-connect): Use it to store connection info. (rcirc-buffer-process): Avoid get-buffer-process which returns nil for killed process. (rcirc-cmd-reconnect): New command. (rcirc-mode, set-rcirc-encode-coding-system) (set-rcirc-decode-coding-system, rcirc-connect): Use setq-local. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-04-09 08:16:41 +0000 +++ lisp/ChangeLog 2014-04-09 13:37:49 +0000 @@ -1,3 +1,13 @@ +2014-04-09 Leo Liu + + * net/rcirc.el (rcirc-connection-info): New variable. + (rcirc-connect): Use it to store connection info. + (rcirc-buffer-process): Avoid get-buffer-process which returns nil + for killed process. + (rcirc-cmd-reconnect): New command. (Bug#17045) + (rcirc-mode, set-rcirc-encode-coding-system) + (set-rcirc-decode-coding-system, rcirc-connect): Use setq-local. + 2014-04-09 Daniel Colascione * emacs-lisp/cl-indent.el: Add comment claiming === modified file 'lisp/net/rcirc.el' --- lisp/net/rcirc.el 2014-04-08 03:32:37 +0000 +++ lisp/net/rcirc.el 2014-04-09 13:37:49 +0000 @@ -521,6 +521,7 @@ (defvar rcirc-user-authenticated nil) (defvar rcirc-user-disconnect nil) (defvar rcirc-connecting nil) +(defvar rcirc-connection-info nil) (defvar rcirc-process nil) ;;;###autoload @@ -549,22 +550,23 @@ (set-process-sentinel process 'rcirc-sentinel) (set-process-filter process 'rcirc-filter) - (set (make-local-variable 'rcirc-process) process) - (set (make-local-variable 'rcirc-server) server) - (set (make-local-variable 'rcirc-server-name) server) ; Update when we get 001 response. - (set (make-local-variable 'rcirc-buffer-alist) nil) - (set (make-local-variable 'rcirc-nick-table) - (make-hash-table :test 'equal)) - (set (make-local-variable 'rcirc-nick) nick) - (set (make-local-variable 'rcirc-process-output) nil) - (set (make-local-variable 'rcirc-startup-channels) startup-channels) - (set (make-local-variable 'rcirc-last-server-message-time) - (current-time)) + (setq-local rcirc-connection-info + (list server port nick user-name full-name startup-channels + password encryption)) + (setq-local rcirc-process process) + (setq-local rcirc-server server) + (setq-local rcirc-server-name server) ; Update when we get 001 response. + (setq-local rcirc-buffer-alist nil) + (setq-local rcirc-nick-table (make-hash-table :test 'equal)) + (setq-local rcirc-nick nick) + (setq-local rcirc-process-output nil) + (setq-local rcirc-startup-channels startup-channels) + (setq-local rcirc-last-server-message-time (current-time)) - (set (make-local-variable 'rcirc-timeout-timer) nil) - (set (make-local-variable 'rcirc-user-disconnect) nil) - (set (make-local-variable 'rcirc-user-authenticated) nil) - (set (make-local-variable 'rcirc-connecting) t) + (setq-local rcirc-timeout-timer nil) + (setq-local rcirc-user-disconnect nil) + (setq-local rcirc-user-authenticated nil) + (setq-local rcirc-connecting t) (add-hook 'auto-save-hook 'rcirc-log-write) @@ -782,11 +784,11 @@ (defun rcirc-buffer-process (&optional buffer) "Return the process associated with channel BUFFER. With no argument or nil as argument, use the current buffer." - (or (get-buffer-process (if buffer - (with-current-buffer buffer - rcirc-server-buffer) - rcirc-server-buffer)) - rcirc-process)) + (let ((buffer (or buffer (if (buffer-live-p rcirc-server-buffer) + rcirc-server-buffer + (error "Server buffer deleted"))))) + (or (with-current-buffer buffer rcirc-process) + rcirc-process))) (defun rcirc-server-name (process) "Return PROCESS server name, given by the 001 response." @@ -928,12 +930,12 @@ (defun set-rcirc-decode-coding-system (coding-system) "Set the decode coding system used in this channel." (interactive "zCoding system for incoming messages: ") - (set (make-local-variable 'rcirc-decode-coding-system) coding-system)) + (setq-local rcirc-decode-coding-system coding-system)) (defun set-rcirc-encode-coding-system (coding-system) "Set the encode coding system used in this channel." (interactive "zCoding system for outgoing messages: ") - (set (make-local-variable 'rcirc-encode-coding-system) coding-system)) + (setq-local rcirc-encode-coding-system coding-system)) (defvar rcirc-mode-map (let ((map (make-sparse-keymap))) @@ -990,25 +992,25 @@ (setq major-mode 'rcirc-mode) (setq mode-line-process nil) - (set (make-local-variable 'rcirc-input-ring) - ;; If rcirc-input-ring is already a ring with desired size do - ;; not re-initialize. - (if (and (ring-p rcirc-input-ring) - (= (ring-size rcirc-input-ring) - rcirc-input-ring-size)) - rcirc-input-ring - (make-ring rcirc-input-ring-size))) - (set (make-local-variable 'rcirc-server-buffer) (process-buffer process)) - (set (make-local-variable 'rcirc-target) target) - (set (make-local-variable 'rcirc-topic) nil) - (set (make-local-variable 'rcirc-last-post-time) (current-time)) - (set (make-local-variable 'fill-paragraph-function) 'rcirc-fill-paragraph) - (set (make-local-variable 'rcirc-recent-quit-alist) nil) - (set (make-local-variable 'rcirc-current-line) 0) + (setq-local rcirc-input-ring + ;; If rcirc-input-ring is already a ring with desired + ;; size do not re-initialize. + (if (and (ring-p rcirc-input-ring) + (= (ring-size rcirc-input-ring) + rcirc-input-ring-size)) + rcirc-input-ring + (make-ring rcirc-input-ring-size))) + (setq-local rcirc-server-buffer (process-buffer process)) + (setq-local rcirc-target target) + (setq-local rcirc-topic nil) + (setq-local rcirc-last-post-time (current-time)) + (setq-local fill-paragraph-function 'rcirc-fill-paragraph) + (setq-local rcirc-recent-quit-alist nil) + (setq-local rcirc-current-line 0) (use-hard-newlines t) - (set (make-local-variable 'rcirc-short-buffer-name) nil) - (set (make-local-variable 'rcirc-urls) nil) + (setq-local rcirc-short-buffer-name nil) + (setq-local rcirc-urls nil) ;; setup for omitting responses (setq buffer-invisibility-spec '()) @@ -1023,18 +1025,18 @@ (serv (if (consp (car i)) (cdar i) ""))) (when (and (string-match chan (or target "")) (string-match serv (rcirc-server-name process))) - (set (make-local-variable 'rcirc-decode-coding-system) - (if (consp (cdr i)) (cadr i) (cdr i))) - (set (make-local-variable 'rcirc-encode-coding-system) - (if (consp (cdr i)) (cddr i) (cdr i)))))) + (setq-local rcirc-decode-coding-system + (if (consp (cdr i)) (cadr i) (cdr i))) + (setq-local rcirc-encode-coding-system + (if (consp (cdr i)) (cddr i) (cdr i)))))) ;; setup the prompt and markers - (set (make-local-variable 'rcirc-prompt-start-marker) (point-max-marker)) - (set (make-local-variable 'rcirc-prompt-end-marker) (point-max-marker)) + (setq-local rcirc-prompt-start-marker (point-max-marker)) + (setq-local rcirc-prompt-end-marker (point-max-marker)) (rcirc-update-prompt) (goto-char rcirc-prompt-end-marker) - (set (make-local-variable 'overlay-arrow-position) (make-marker)) + (setq-local overlay-arrow-position (make-marker)) ;; if the user changes the major mode or kills the buffer, there is ;; cleanup work to do @@ -2210,6 +2212,19 @@ reason rcirc-id-string)))) +(defun-rcirc-command reconnect (_) + "Reconnect to current server." + (interactive "i") + (with-rcirc-server-buffer + (cond + (rcirc-connecting (message "Already connecting")) + ((process-live-p process) (message "Server process is alive")) + (t (let ((conn-info rcirc-connection-info)) + (setf (nth 5 conn-info) + (cl-remove-if-not #'rcirc-channel-p + (mapcar #'car rcirc-buffer-alist))) + (apply #'rcirc-connect conn-info)))))) + (defun-rcirc-command nick (nick) "Change nick to NICK." (interactive "i") ------------------------------------------------------------ revno: 116960 committer: Stefan Monnier branch nick: trunk timestamp: Wed 2014-04-09 09:21:30 -0400 message: * src/keyboard.c (syms_of_keyboard): Make deactivate-mark buffer-local. diff: === modified file 'etc/NEWS' --- etc/NEWS 2014-04-09 01:48:07 +0000 +++ etc/NEWS 2014-04-09 13:21:30 +0000 @@ -74,6 +74,8 @@ ** inhibit-modification-hooks now also inhibits lock-file checks as well as active region handling. +** deactivate-mark is now buffer-local. + * Lisp Changes in Emacs 24.5 === modified file 'src/ChangeLog' --- src/ChangeLog 2014-04-09 01:48:07 +0000 +++ src/ChangeLog 2014-04-09 13:21:30 +0000 @@ -1,5 +1,7 @@ 2014-04-09 Stefan Monnier + * keyboard.c (syms_of_keyboard): Make deactivate-mark buffer-local. + * insdel.c (prepare_to_modify_buffer_1): Cancel lock-file checks and region handling (and don't call signal_before_change) if inhibit_modification_hooks is set. === modified file 'src/keyboard.c' --- src/keyboard.c 2014-04-07 20:54:16 +0000 +++ src/keyboard.c 2014-04-09 13:21:30 +0000 @@ -11381,6 +11381,7 @@ Buffer modification stores t in this variable. */); Vdeactivate_mark = Qnil; DEFSYM (Qdeactivate_mark, "deactivate-mark"); + Fmake_variable_buffer_local (Qdeactivate_mark); DEFVAR_LISP ("pre-command-hook", Vpre_command_hook, doc: /* Normal hook run before each command is executed. ------------------------------------------------------------ revno: 116959 committer: Daniel Colascione branch nick: trunk timestamp: Wed 2014-04-09 01:16:41 -0700 message: Make cl-indent work better for elisp diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-04-09 03:37:56 +0000 +++ lisp/ChangeLog 2014-04-09 08:16:41 +0000 @@ -1,3 +1,13 @@ +2014-04-09 Daniel Colascione + + * emacs-lisp/cl-indent.el: Add comment claiming + facility is also good for elisp. + (lisp-indent-find-method): New function. + (common-lisp-indent-function): Recognize cl-loop. + (common-lisp-indent-function-1): Recognize cl constructs; use + `lisp-indent-find-method' instead of `get' directly. + (if): Use else-body style for elisp. + 2014-04-09 Dmitry Gutov * progmodes/ruby-mode.el (ruby-font-lock-keywords): Highlight more === modified file 'lisp/emacs-lisp/cl-indent.el' --- lisp/emacs-lisp/cl-indent.el 2014-02-10 01:34:22 +0000 +++ lisp/emacs-lisp/cl-indent.el 2014-04-09 08:16:41 +0000 @@ -27,6 +27,8 @@ ;; This package supplies a single entry point, common-lisp-indent-function, ;; which performs indentation in the preferred style for Common Lisp code. +;; It is also a suitable function for indenting Emacs lisp code. +;; ;; To enable it: ;; ;; (setq lisp-indent-function 'common-lisp-indent-function) @@ -154,6 +156,15 @@ (looking-at "\\sw")) (error t))) +(defun lisp-indent-find-method (symbol &optional no-compat) + "Find the lisp indentation function for SYMBOL. +If NO-COMPAT is non-nil, do not retrieve indenters intended for +the standard lisp indent package." + (or (and (derived-mode-p 'emacs-lisp-mode) + (get symbol 'common-lisp-indent-function-for-elisp)) + (get symbol 'common-lisp-indent-function) + (and (not no-compat) + (get symbol 'lisp-indent-function)))) (defun common-lisp-loop-part-indentation (indent-point state) "Compute the indentation of loop form constituents." @@ -245,9 +256,17 @@ * indent the first argument by 4. * arguments after the first should be lists, and there may be any number of them. The first list element has an offset of 2, all the rest - have an offset of 2+1=3." + have an offset of 2+1=3. + +If the current mode is actually `emacs-lisp-mode', look for a +`common-lisp-indent-function-for-elisp' property before looking +at `common-lisp-indent-function' and, if set, use its value +instead." + ;; FIXME: why do we need to special-case loop? (if (save-excursion (goto-char (elt state 1)) - (looking-at "([Ll][Oo][Oo][Pp]")) + (looking-at (if (derived-mode-p 'emacs-lisp-mode) + "(\\(cl-\\)?[Ll][Oo][Oo][Pp]" + "([Ll][Oo][Oo][Pp]"))) (common-lisp-loop-part-indentation indent-point state) (common-lisp-indent-function-1 indent-point state))) @@ -291,18 +310,29 @@ (setq function (downcase (buffer-substring-no-properties tem (point)))) (goto-char tem) + ;; Elisp generally provides CL functionality with a CL + ;; prefix, so if we have a special indenter for the + ;; unprefixed version, prefer it over whatever's defined + ;; for the cl- version. Users can override this + ;; heuristic by defining a + ;; common-lisp-indent-function-for-elisp property on the + ;; cl- version. + (when (and (derived-mode-p 'emacs-lisp-mode) + (not (lisp-indent-find-method + (intern-soft function) t)) + (string-match "^cl-" function) + (setf tem (intern-soft + (substring function (match-end 0)))) + (lisp-indent-find-method tem t)) + (setf function (symbol-name tem))) (setq tem (intern-soft function) - method (get tem 'common-lisp-indent-function)) - (cond ((and (null method) - (string-match ":[^:]+" function)) - ;; The pleblisp package feature - (setq function (substring function - (1+ (match-beginning 0))) - method (get (intern-soft function) - 'common-lisp-indent-function))) - ((and (null method)) - ;; backwards compatibility - (setq method (get tem 'lisp-indent-function))))) + method (lisp-indent-find-method tem)) + ;; The pleblisp package feature + (when (and (null tem) + (string-match ":[^:]+" function)) + (setq function (substring function (1+ (match-beginning 0))) + tem (intern-soft function) + method (lisp-indent-find-method tem)))) (let ((n 0)) ;; How far into the containing form is the current form? (if (< (point) indent-point) @@ -764,7 +794,11 @@ (put (car el) 'common-lisp-indent-function (if (symbolp (cdr el)) (get (cdr el) 'common-lisp-indent-function) - (car (cdr el)))))) + (car (cdr el)))))) + +;; In elisp, the else part of `if' is in an implicit progn, so indent +;; it more. +(put 'if 'common-lisp-indent-function-for-elisp 2) ;(defun foo (x)