Now on revision 108553. ------------------------------------------------------------ revno: 108553 author: Johan Bockgård committer: Stefan Monnier branch nick: trunk timestamp: Sun 2012-06-10 20:46:21 -0400 message: * lisp/emacs-lisp/pcase.el (pcase-UPAT, pcase-QPAT): New edebug specs. (pcase, pcase-let*, pcase-dolist): Use them. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-06-11 00:33:33 +0000 +++ lisp/ChangeLog 2012-06-11 00:46:21 +0000 @@ -1,3 +1,8 @@ +2012-06-11 Johan Bockgård + + * emacs-lisp/pcase.el (pcase-UPAT, pcase-QPAT): New edebug specs. + (pcase, pcase-let*, pcase-dolist): Use them. + 2012-06-11 Stefan Monnier * emacs-lisp/pcase.el (pcase--let*): New function. === modified file 'lisp/emacs-lisp/pcase.el' --- lisp/emacs-lisp/pcase.el 2012-06-11 00:33:33 +0000 +++ lisp/emacs-lisp/pcase.el 2012-06-11 00:46:21 +0000 @@ -66,6 +66,27 @@ (defconst pcase--dontcare-upats '(t _ dontcare)) +(def-edebug-spec + pcase-UPAT + (&or symbolp + ("or" &rest pcase-UPAT) + ("and" &rest pcase-UPAT) + ("`" pcase-QPAT) + ("guard" form) + ("let" pcase-UPAT form) + ("pred" + &or lambda-expr + ;; Punt on macros/special forms. + (functionp &rest form) + sexp) + sexp)) + +(def-edebug-spec + pcase-QPAT + (&or ("," pcase-UPAT) + (pcase-QPAT . pcase-QPAT) + sexp)) + ;;;###autoload (defmacro pcase (exp &rest cases) "Perform ML-style pattern matching on EXP. @@ -98,7 +119,7 @@ E.g. you can match pairs where the cdr is larger than the car with a pattern like `(,a . ,(pred (< a))) or, with more checks: `(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))" - (declare (indent 1) (debug cl-case)) ;FIXME: edebug `guard' and vars. + (declare (indent 1) (debug (form &rest (pcase-UPAT body)))) ;; We want to use a weak hash table as a cache, but the key will unavoidably ;; be based on `exp' and `cases', yet `cases' is a fresh new list each time ;; we're called so it'll be immediately GC'd. So we use (car cases) as key @@ -144,7 +165,7 @@ BODY should be an expression, and BINDINGS should be a list of bindings of the form (UPAT EXP)." (declare (indent 1) - (debug ((&rest (sexp &optional form)) body))) + (debug ((&rest (pcase-UPAT &optional form)) body))) (let ((cached (gethash bindings pcase--memoize))) ;; cached = (BODY . EXPANSION) (if (equal (car cached) body) @@ -174,7 +195,7 @@ `(let ,(nreverse bindings) (pcase-let* ,matches ,@body))))) (defmacro pcase-dolist (spec &rest body) - (declare (indent 1)) + (declare (indent 1) (debug ((pcase-UPAT form) body))) (if (pcase--trivial-upat-p (car spec)) `(dolist ,spec ,@body) (let ((tmpvar (make-symbol "x"))) ------------------------------------------------------------ revno: 108552 committer: Stefan Monnier branch nick: trunk timestamp: Sun 2012-06-10 20:33:33 -0400 message: * lisp/emacs-lisp/pcase.el (pcase--let*): New function. (pcase-let*): Use it. Use pcase--memoize to avoid repeated expansions. (pcase--expand): Use macroexp-let². diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-06-10 13:28:26 +0000 +++ lisp/ChangeLog 2012-06-11 00:33:33 +0000 @@ -1,3 +1,9 @@ +2012-06-11 Stefan Monnier + + * emacs-lisp/pcase.el (pcase--let*): New function. + (pcase-let*): Use it. Use pcase--memoize to avoid repeated expansions. + (pcase--expand): Use macroexp-let². + 2012-06-10 Stefan Monnier * emacs-lisp/timer.el, emacs-lisp/syntax.el, emacs-lisp/smie.el: === modified file 'lisp/emacs-lisp/pcase.el' --- lisp/emacs-lisp/pcase.el 2012-06-08 13:18:26 +0000 +++ lisp/emacs-lisp/pcase.el 2012-06-11 00:33:33 +0000 @@ -61,6 +61,8 @@ ;; memoize previous macro expansions to try and avoid recomputing them ;; over and over again. (defconst pcase--memoize (make-hash-table :weakness 'key :test 'eq)) +;; (defconst pcase--memoize-1 (make-hash-table :test 'eq)) +;; (defconst pcase--memoize-2 (make-hash-table :weakness 'key :test 'equal)) (defconst pcase--dontcare-upats '(t _ dontcare)) @@ -107,31 +109,49 @@ (if (and (equal exp (car data)) (equal cases (cadr data))) ;; We have the right expansion. (cddr data) + ;; (when (gethash (car cases) pcase--memoize-1) + ;; (message "pcase-memoize failed because of weak key!!")) + ;; (when (gethash (car cases) pcase--memoize-2) + ;; (message "pcase-memoize failed because of eq test on %S" + ;; (car cases))) (when data (message "pcase-memoize: equal first branch, yet different")) (let ((expansion (pcase--expand exp cases))) - (puthash (car cases) (cons exp (cons cases expansion)) pcase--memoize) + (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize) + ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-1) + ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2) expansion)))) +(defun pcase--let* (bindings body) + (cond + ((null bindings) (macroexp-progn body)) + ((pcase--trivial-upat-p (caar bindings)) + (macroexp-let* `(,(car bindings)) (pcase--let* (cdr bindings) body))) + (t + (let ((binding (pop bindings))) + (pcase--expand + (cadr binding) + `((,(car binding) ,(pcase--let* bindings body)) + ;; We can either signal an error here, or just use `dontcare' which + ;; generates more efficient code. In practice, if we use `dontcare' + ;; we will still often get an error and the few cases where we don't + ;; do not matter that much, so it's a better choice. + (dontcare nil))))))) + ;;;###autoload (defmacro pcase-let* (bindings &rest body) "Like `let*' but where you can use `pcase' patterns for bindings. BODY should be an expression, and BINDINGS should be a list of bindings of the form (UPAT EXP)." (declare (indent 1) - (debug ((&rest &or (sexp &optional form) symbolp) body))) - (cond - ((null bindings) (if (> (length body) 1) `(progn ,@body) (car body))) - ((pcase--trivial-upat-p (caar bindings)) - `(let (,(car bindings)) (pcase-let* ,(cdr bindings) ,@body))) - (t - `(pcase ,(cadr (car bindings)) - (,(caar bindings) (pcase-let* ,(cdr bindings) ,@body)) - ;; We can either signal an error here, or just use `dontcare' which - ;; generates more efficient code. In practice, if we use `dontcare' we - ;; will still often get an error and the few cases where we don't do not - ;; matter that much, so it's a better choice. - (dontcare nil))))) + (debug ((&rest (sexp &optional form)) body))) + (let ((cached (gethash bindings pcase--memoize))) + ;; cached = (BODY . EXPANSION) + (if (equal (car cached) body) + (cdr cached) + (let ((expansion (pcase--let* bindings body))) + (puthash bindings (cons body expansion) pcase--memoize) + expansion)))) ;;;###autoload (defmacro pcase-let (bindings &rest body) @@ -169,64 +189,62 @@ (defun pcase--expand (exp cases) ;; (message "pid=%S (pcase--expand %S ...hash=%S)" ;; (emacs-pid) exp (sxhash cases)) - (let* ((defs (if (symbolp exp) '() - (let ((sym (make-symbol "x"))) - (prog1 `((,sym ,exp)) (setq exp sym))))) - (seen '()) - (codegen - (lambda (code vars) - (let ((prev (assq code seen))) - (if (not prev) - (let ((res (pcase-codegen code vars))) - (push (list code vars res) seen) - res) - ;; Since we use a tree-based pattern matching - ;; technique, the leaves (the places that contain the - ;; code to run once a pattern is matched) can get - ;; copied a very large number of times, so to avoid - ;; code explosion, we need to keep track of how many - ;; times we've used each leaf and move it - ;; to a separate function if that number is too high. - ;; - ;; We've already used this branch. So it is shared. - (let* ((code (car prev)) (cdrprev (cdr prev)) - (prevvars (car cdrprev)) (cddrprev (cdr cdrprev)) - (res (car cddrprev))) - (unless (symbolp res) - ;; This is the first repeat, so we have to move - ;; the branch to a separate function. - (let ((bsym - (make-symbol (format "pcase-%d" (length defs))))) - (push `(,bsym (lambda ,(mapcar #'car prevvars) ,@code)) defs) - (setcar res 'funcall) - (setcdr res (cons bsym (mapcar #'cdr prevvars))) - (setcar (cddr prev) bsym) - (setq res bsym))) - (setq vars (copy-sequence vars)) - (let ((args (mapcar (lambda (pa) - (let ((v (assq (car pa) vars))) - (setq vars (delq v vars)) - (cdr v))) - prevvars))) - ;; If some of `vars' were not found in `prevvars', that's - ;; OK it just means those vars aren't present in all - ;; branches, so they can be used within the pattern - ;; (e.g. by a `guard/let/pred') but not in the branch. - ;; FIXME: But if some of `prevvars' are not in `vars' we - ;; should remove them from `prevvars'! - `(funcall ,res ,@args))))))) - (main - (pcase--u - (mapcar (lambda (case) - `((match ,exp . ,(car case)) - ,(apply-partially - (if (pcase--small-branch-p (cdr case)) - ;; Don't bother sharing multiple - ;; occurrences of this leaf since it's small. - #'pcase-codegen codegen) - (cdr case)))) - cases)))) - (if (null defs) main + (macroexp-let² macroexp-copyable-p val exp + (let* ((defs ()) + (seen '()) + (codegen + (lambda (code vars) + (let ((prev (assq code seen))) + (if (not prev) + (let ((res (pcase-codegen code vars))) + (push (list code vars res) seen) + res) + ;; Since we use a tree-based pattern matching + ;; technique, the leaves (the places that contain the + ;; code to run once a pattern is matched) can get + ;; copied a very large number of times, so to avoid + ;; code explosion, we need to keep track of how many + ;; times we've used each leaf and move it + ;; to a separate function if that number is too high. + ;; + ;; We've already used this branch. So it is shared. + (let* ((code (car prev)) (cdrprev (cdr prev)) + (prevvars (car cdrprev)) (cddrprev (cdr cdrprev)) + (res (car cddrprev))) + (unless (symbolp res) + ;; This is the first repeat, so we have to move + ;; the branch to a separate function. + (let ((bsym + (make-symbol (format "pcase-%d" (length defs))))) + (push `(,bsym (lambda ,(mapcar #'car prevvars) ,@code)) defs) + (setcar res 'funcall) + (setcdr res (cons bsym (mapcar #'cdr prevvars))) + (setcar (cddr prev) bsym) + (setq res bsym))) + (setq vars (copy-sequence vars)) + (let ((args (mapcar (lambda (pa) + (let ((v (assq (car pa) vars))) + (setq vars (delq v vars)) + (cdr v))) + prevvars))) + ;; If some of `vars' were not found in `prevvars', that's + ;; OK it just means those vars aren't present in all + ;; branches, so they can be used within the pattern + ;; (e.g. by a `guard/let/pred') but not in the branch. + ;; FIXME: But if some of `prevvars' are not in `vars' we + ;; should remove them from `prevvars'! + `(funcall ,res ,@args))))))) + (main + (pcase--u + (mapcar (lambda (case) + `((match ,val . ,(car case)) + ,(apply-partially + (if (pcase--small-branch-p (cdr case)) + ;; Don't bother sharing multiple + ;; occurrences of this leaf since it's small. + #'pcase-codegen codegen) + (cdr case)))) + cases)))) (macroexp-let* defs main)))) (defun pcase-codegen (code vars) ------------------------------------------------------------ revno: 108551 author: Gnus developers committer: Katsumi Yamaoka branch nick: trunk timestamp: Sun 2012-06-10 23:27:32 +0000 message: Merge bugfixes done in Gnus trunk Those changes fix only the bugs having appeared in the bug list. Many other Gnus changes not yet merged to Emacs are in: ftp://ftp.jpl.org/pub/tmp/MaGnus-to-Emacs.patch (or http://www.jpl.org/ftp/pub/tmp/MaGnus-to-Emacs.patch) 2012-06-10 Lars Magne Ingebrigtsen * gnus-group.el (gnus-group-get-new-news): Respect `gnus-group-use-permanent-levels', as documented (bug#11638). 2012-06-10 Dave Abrahams * gnus-int.el (gnus-warp-to-article): Limit registry warping to real groups (bug#11641). diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2012-06-08 04:38:56 +0000 +++ lisp/gnus/ChangeLog 2012-06-10 23:27:32 +0000 @@ -1,3 +1,13 @@ +2012-06-10 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-get-new-news): Respect + `gnus-group-use-permanent-levels', as documented (bug#11638). + +2012-06-10 Dave Abrahams + + * gnus-int.el (gnus-warp-to-article): Limit registry warping to real + groups (bug#11641). + 2012-06-07 Lars Magne Ingebrigtsen * gnus-msg.el (gnus-msg-mail): Warn the user about Gnus not running === modified file 'lisp/gnus/gnus-group.el' --- lisp/gnus/gnus-group.el 2012-02-02 11:07:55 +0000 +++ lisp/gnus/gnus-group.el 2012-06-10 23:27:32 +0000 @@ -4032,7 +4032,7 @@ (unless gnus-slave (gnus-master-read-slave-newsrc)) - (gnus-get-unread-articles arg) + (gnus-get-unread-articles (gnus-group-default-level arg t)) ;; If the user wants it, we scan for new groups. (when (eq gnus-check-new-newsgroups 'always) === modified file 'lisp/gnus/gnus-int.el' --- lisp/gnus/gnus-int.el 2012-03-12 11:48:55 +0000 +++ lisp/gnus/gnus-int.el 2012-06-10 23:27:32 +0000 @@ -537,11 +537,12 @@ "Warps from an article in a virtual group to the article in its real group. Does nothing on a real group." (interactive) - (let ((gnus-command-method - (gnus-find-method-for-group gnus-newsgroup-name))) - (when (gnus-check-backend-function - 'warp-to-article (car gnus-command-method)) - (funcall (gnus-get-function gnus-command-method 'warp-to-article))))) + (when (gnus-virtual-group-p gnus-newsgroup-name) + (let ((gnus-command-method + (gnus-find-method-for-group gnus-newsgroup-name))) + (when (gnus-check-backend-function + 'warp-to-article (car gnus-command-method)) + (funcall (gnus-get-function gnus-command-method 'warp-to-article)))))) (defun gnus-request-head (article group) "Request the head of ARTICLE in GROUP." ------------------------------------------------------------ revno: 108550 committer: Stefan Monnier branch nick: trunk timestamp: Sun 2012-06-10 09:28:26 -0400 message: Reduce use of cl in lisp/emacs-lisp/. * lisp/emacs-lisp/timer.el, lisp/emacs-lisp/syntax.el, lisp/emacs-lisp/smie.el: * lisp/emacs-lisp/ewoc.el, lisp/emacs-lisp/cconv.el,lisp/emacs-lisp/derived.el: * lisp/emacs-lisp/byte-opt.el, lisp/emacs-lisp/autoload.el: Convert to cl-lib. * lisp/emacs-lisp/easymenu.el, lisp/emacs-lisp/easy-mmode.el: * lisp/emacs-lisp/bytecomp.el: Use pcase instead of `cl'. * lisp/emacs-lisp/cl-lib.el: Get rid of special cl-macs auto load. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-06-10 13:20:58 +0000 +++ lisp/ChangeLog 2012-06-10 13:28:26 +0000 @@ -1,3 +1,12 @@ +2012-06-10 Stefan Monnier + + * emacs-lisp/timer.el, emacs-lisp/syntax.el, emacs-lisp/smie.el: + * emacs-lisp/ewoc.el, emacs-lisp/cconv.el, emacs-lisp/bytecomp.el: + * emacs-lisp/byte-opt.el, emacs-lisp/autoload.el: Convert to cl-lib. + * emacs-lisp/easymenu.el, emacs-lisp/easy-mmode.el: + * emacs-lisp/derived.el: Use pcase instead of `cl'. + * emacs-lisp/cl-lib.el: Get rid of special cl-macs auto load. + 2012-06-10 Glenn Morris * mail/rmail.el (rmail-yank-current-message): Leave point at @@ -9,8 +18,8 @@ 2012-06-10 Chong Yidong - * cus-edit.el (customize-changed-options-previous-release): Bump - to 24.1. + * cus-edit.el (customize-changed-options-previous-release): + Bump to 24.1. 2012-06-09 Andreas Schwab @@ -142,8 +151,8 @@ * textmodes/flyspell.el (flyspell-incorrect, flyspell-duplicate): Likewise. - (flyspell-incorrect-face, flyspell-duplicate-face): Remove - obsolete aliases. + (flyspell-incorrect-face, flyspell-duplicate-face): + Remove obsolete aliases. 2012-06-08 Michael Albinus === modified file 'lisp/emacs-lisp/autoload.el' --- lisp/emacs-lisp/autoload.el 2012-05-31 01:41:17 +0000 +++ lisp/emacs-lisp/autoload.el 2012-06-10 13:28:26 +0000 @@ -32,7 +32,7 @@ (require 'lisp-mode) ;for `doc-string-elt' properties. (require 'help-fns) ;for help-add-fundoc-usage. -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defvar generated-autoload-file nil "File into which to write autoload definitions. @@ -154,7 +154,7 @@ defun* defmacro* define-overloadable-function)) (let* ((macrop (memq car '(defmacro defmacro*))) (name (nth 1 form)) - (args (case car + (args (cl-case car ((defun defmacro defun* defmacro* define-overloadable-function) (nth 2 form)) ((define-skeleton) '(&optional str arg)) @@ -546,7 +546,7 @@ (save-excursion ;; Insert the section-header line which lists the file name ;; and which functions are in it, etc. - (assert (= ostart output-start)) + (cl-assert (= ostart output-start)) (goto-char output-start) (let ((relfile (file-relative-name absfile))) (autoload-insert-section-header === modified file 'lisp/emacs-lisp/byte-opt.el' --- lisp/emacs-lisp/byte-opt.el 2012-06-07 19:25:48 +0000 +++ lisp/emacs-lisp/byte-opt.el 2012-06-10 13:28:26 +0000 @@ -183,7 +183,7 @@ ;;; Code: (require 'bytecomp) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'macroexp) (defun byte-compile-log-lap-1 (format &rest args) @@ -642,7 +642,7 @@ (while (eq (car-safe form) 'progn) (setq form (car (last (cdr form))))) (cond ((consp form) - (case (car form) + (cl-case (car form) (quote (cadr form)) ;; Can't use recursion in a defsubst. ;; (progn (byte-compile-trueconstp (car (last (cdr form))))) @@ -656,7 +656,7 @@ (while (eq (car-safe form) 'progn) (setq form (car (last (cdr form))))) (cond ((consp form) - (case (car form) + (cl-case (car form) (quote (null (cadr form))) ;; Can't use recursion in a defsubst. ;; (progn (byte-compile-nilconstp (car (last (cdr form))))) @@ -1376,7 +1376,7 @@ ;; This uses dynamic-scope magic. offset (disassemble-offset bytes)) (let ((opcode (aref byte-code-vector bytedecomp-op))) - (assert opcode) + (cl-assert opcode) (setq bytedecomp-op opcode)) (cond ((memq bytedecomp-op byte-goto-ops) ;; It's a pc. @@ -1619,7 +1619,7 @@ (byte-compile-log-lap " dup %s discard\t-->\t%s" lap1 lap1) (setq keep-going t rest (cdr rest)) - (if (eq 'byte-stack-set (car lap1)) (decf (cdr lap1))) + (if (eq 'byte-stack-set (car lap1)) (cl-decf (cdr lap1))) (setq lap (delq lap0 (delq lap2 lap)))) ;; ;; not goto-X-if-nil --> goto-X-if-non-nil === modified file 'lisp/emacs-lisp/bytecomp.el' --- lisp/emacs-lisp/bytecomp.el 2012-06-07 19:25:48 +0000 +++ lisp/emacs-lisp/bytecomp.el 2012-06-10 13:28:26 +0000 @@ -120,7 +120,7 @@ (require 'backquote) (require 'macroexp) (require 'cconv) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (or (fboundp 'defsubst) ;; This really ought to be loaded already! @@ -738,7 +738,7 @@ (bytes-var (car (last args 2))) (pc-var (car (last args)))) `(setq ,bytes-var ,(if (null (cdr byte-exprs)) - `(progn (assert (<= 0 ,(car byte-exprs))) + `(progn (cl-assert (<= 0 ,(car byte-exprs))) (cons ,@byte-exprs ,bytes-var)) `(nconc (list ,@(reverse byte-exprs)) ,bytes-var)) ,pc-var (+ ,(length byte-exprs) ,pc-var)))) @@ -1591,7 +1591,7 @@ (not (auto-save-file-name-p source)) (not (string-equal dir-locals-file (file-name-nondirectory source)))) - (progn (case (byte-recompile-file source force arg) + (progn (cl-case (byte-recompile-file source force arg) (no-byte-compile (setq skip-count (1+ skip-count))) ((t) (setq file-count (1+ file-count))) ((nil) (setq fail-count (1+ fail-count)))) @@ -1725,12 +1725,12 @@ (set-buffer-multibyte nil)) ;; Run hooks including the uncompression hook. ;; If they change the file name, then change it for the output also. - (letf ((buffer-file-name filename) - ((default-value 'major-mode) 'emacs-lisp-mode) - ;; Ignore unsafe local variables. - ;; We only care about a few of them for our purposes. - (enable-local-variables :safe) - (enable-local-eval nil)) + (cl-letf ((buffer-file-name filename) + ((default-value 'major-mode) 'emacs-lisp-mode) + ;; Ignore unsafe local variables. + ;; We only care about a few of them for our purposes. + (enable-local-variables :safe) + (enable-local-eval nil)) ;; Arg of t means don't alter enable-local-variables. (normal-mode t) ;; There may be a file local variable setting (bug#10419). @@ -2611,7 +2611,7 @@ (byte-compile-make-lambda-lexenv fun)) reserved-csts))) ;; Build the actual byte-coded function. - (assert (eq 'byte-code (car-safe compiled))) + (cl-assert (eq 'byte-code (car-safe compiled))) (apply #'make-byte-code (if lexical-binding (byte-compile-make-args-desc arglist) @@ -2654,7 +2654,7 @@ (while (and rest (< i limit)) (cond ((numberp (car rest)) - (assert (< (car rest) byte-compile-reserved-constants))) + (cl-assert (< (car rest) byte-compile-reserved-constants))) ((setq tmp (assq (car (car rest)) ret)) (setcdr (car rest) (cdr tmp))) (t @@ -2933,9 +2933,9 @@ (mapc 'byte-compile-form (cdr form)) (unless fmax2 ;; Old-style byte-code. - (assert (listp fargs)) + (cl-assert (listp fargs)) (while fargs - (case (car fargs) + (cl-case (car fargs) (&optional (setq fargs (cdr fargs))) (&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1)) (push (cadr fargs) dynbinds) @@ -2954,7 +2954,7 @@ (t ;; Turn &rest args into a list. (let ((n (- alen (/ (1- fmax2) 2)))) - (assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n) + (cl-assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n) (if (< n 5) (byte-compile-out (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- n)) @@ -2967,7 +2967,7 @@ ;; Unbind dynamic variables. (when dynbinds (byte-compile-out 'byte-unbind (length dynbinds))) - (assert (eq byte-compile-depth (1+ start-depth)) + (cl-assert (eq byte-compile-depth (1+ start-depth)) nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth))) (defun byte-compile-check-variable (var access-type) @@ -2985,7 +2985,7 @@ (and od (not (memq var byte-compile-not-obsolete-vars)) (not (memq var byte-compile-global-not-obsolete-vars)) - (or (case (nth 1 od) + (or (cl-case (nth 1 od) (set (not (eq access-type 'reference))) (get (eq access-type 'reference)) (t t))))) @@ -3312,8 +3312,8 @@ (body (nthcdr 3 form)) (fun (byte-compile-lambda `(lambda ,vars . ,body) nil (length env)))) - (assert (> (length env) 0)) ;Otherwise, we don't need a closure. - (assert (byte-code-function-p fun)) + (cl-assert (> (length env) 0)) ;Otherwise, we don't need a closure. + (cl-assert (byte-code-function-p fun)) (byte-compile-form `(make-byte-code ',(aref fun 0) ',(aref fun 1) (vconcat (vector . ,env) ',(aref fun 2)) @@ -3891,8 +3891,8 @@ (if lexical-binding ;; Unbind both lexical and dynamic variables. (progn - (assert (or (eq byte-compile-depth init-stack-depth) - (eq byte-compile-depth (1+ init-stack-depth)))) + (cl-assert (or (eq byte-compile-depth init-stack-depth) + (eq byte-compile-depth (1+ init-stack-depth)))) (byte-compile-unbind clauses init-lexenv (> byte-compile-depth init-stack-depth))) ;; Unbind dynamic variables. @@ -4312,7 +4312,7 @@ (if byte-compile-call-tree-sort (setq byte-compile-call-tree (sort byte-compile-call-tree - (case byte-compile-call-tree-sort + (cl-case byte-compile-call-tree-sort (callers (lambda (x y) (< (length (nth 1 x)) (length (nth 1 y))))) === modified file 'lisp/emacs-lisp/cconv.el' --- lisp/emacs-lisp/cconv.el 2012-05-30 03:59:42 +0000 +++ lisp/emacs-lisp/cconv.el 2012-06-10 13:28:26 +0000 @@ -110,7 +110,7 @@ ;; ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder))) ;; binders))) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defconst cconv-liftwhen 6 "Try to do lambda lifting if the number of arguments + free variables @@ -173,7 +173,7 @@ ;; Here we assume that X appears at most once in M. (let* ((b (assq x m)) (res (if b (remq b m) m))) - (assert (null (assq x res))) ;; Check the assumption was warranted. + (cl-assert (null (assq x res))) ;; Check the assumption was warranted. res)) (defun cconv--map-diff-set (m s) @@ -185,7 +185,7 @@ (nreverse res))) (defun cconv--convert-function (args body env parentform) - (assert (equal body (caar cconv-freevars-alist))) + (cl-assert (equal body (caar cconv-freevars-alist))) (let* ((fvs (cdr (pop cconv-freevars-alist))) (body-new '()) (letbind '()) @@ -251,11 +251,11 @@ EXTEND is a list of variables which might need to be accessed even from places where they are shadowed, because some part of ENV causes them to be used at places where they originally did not directly appear." - (assert (not (delq nil (mapcar (lambda (mapping) - (if (eq (cadr mapping) 'apply-partially) - (cconv--set-diff (cdr (cddr mapping)) - extend))) - env)))) + (cl-assert (not (delq nil (mapcar (lambda (mapping) + (if (eq (cadr mapping) 'apply-partially) + (cconv--set-diff (cdr (cddr mapping)) + extend))) + env)))) ;; What's the difference between fvrs and envs? ;; Suppose that we have the code @@ -287,10 +287,10 @@ ;; Check if var is a candidate for lambda lifting. ((and (member (cons binder form) cconv-lambda-candidates) (progn - (assert (and (eq (car value) 'function) - (eq (car (cadr value)) 'lambda))) - (assert (equal (cddr (cadr value)) - (caar cconv-freevars-alist))) + (cl-assert (and (eq (car value) 'function) + (eq (car (cadr value)) 'lambda))) + (cl-assert (equal (cddr (cadr value)) + (caar cconv-freevars-alist))) ;; Peek at the freevars to decide whether to λ-lift. (let* ((fvs (cdr (car cconv-freevars-alist))) (fun (cadr value)) @@ -307,7 +307,7 @@ (funcbody-env ())) (push `(,var . (apply-partially ,var . ,fvs)) new-env) (dolist (fv fvs) - (pushnew fv new-extend) + (cl-pushnew fv new-extend) (if (and (eq 'car (car-safe (cdr (assq fv env)))) (not (memq fv funargs))) (push `(,fv . (car ,fv)) funcbody-env))) @@ -345,14 +345,14 @@ (mapcar (lambda (mapping) (if (not (eq (cadr mapping) 'apply-partially)) mapping - (assert (eq (car mapping) (nth 2 mapping))) - (list* (car mapping) - 'apply-partially - (car mapping) - (mapcar (lambda (arg) - (if (eq var arg) - closedsym arg)) - (nthcdr 3 mapping))))) + (cl-assert (eq (car mapping) (nth 2 mapping))) + (cl-list* (car mapping) + 'apply-partially + (car mapping) + (mapcar (lambda (arg) + (if (eq var arg) + closedsym arg)) + (nthcdr 3 mapping))))) new-env)) (setq new-extend (remq var new-extend)) (push closedsym new-extend) @@ -455,7 +455,7 @@ (let ((mapping (cdr (assq fun env)))) (pcase mapping (`(apply-partially ,_ . ,(and fvs `(,_ . ,_))) - (assert (eq (cadr mapping) fun)) + (cl-assert (eq (cadr mapping) fun)) `(,callsym ,fun ,@(mapcar (lambda (fv) (let ((exp (or (cdr (assq fv env)) fv))) @@ -551,7 +551,7 @@ ;; Transfer uses collected in `envcopy' (via `newenv') back to `env'; ;; and compute free variables. (while env - (assert (and envcopy (eq (caar env) (caar envcopy)))) + (cl-assert (and envcopy (eq (caar env) (caar envcopy)))) (let ((free nil) (x (cdr (car env))) (y (cdr (car envcopy)))) @@ -559,8 +559,8 @@ (when (car y) (setcar x t) (setq free t)) (setq x (cdr x) y (cdr y))) (when free - (push (caar env) (cdr freevars)) - (setf (nth 3 (car env)) t)) + (cl-push (caar env) (cdr freevars)) + (cl-setf (nth 3 (car env)) t)) (setq env (cdr env) envcopy (cdr envcopy)))))) (defun cconv-analyse-form (form env) @@ -610,7 +610,7 @@ ;; it is a mutated variable. (while forms (let ((v (assq (car forms) env))) ; v = non nil if visible - (when v (setf (nth 2 v) t))) + (when v (cl-setf (nth 2 v) t))) (cconv-analyse-form (cadr forms) env) (setq forms (cddr forms)))) @@ -656,7 +656,7 @@ ;; lambda candidate list. (let ((fdata (and (symbolp fun) (assq fun env)))) (if fdata - (setf (nth 4 fdata) t) + (cl-setf (nth 4 fdata) t) (cconv-analyse-form fun env))) (dolist (form args) (cconv-analyse-form form env))) @@ -676,7 +676,7 @@ ((pred symbolp) (let ((dv (assq form env))) ; dv = declared and visible (when dv - (setf (nth 1 dv) t)))))) + (cl-setf (nth 1 dv) t)))))) (provide 'cconv) ;;; cconv.el ends here === modified file 'lisp/emacs-lisp/cl-lib.el' --- lisp/emacs-lisp/cl-lib.el 2012-06-09 02:26:47 +0000 +++ lisp/emacs-lisp/cl-lib.el 2012-06-10 13:28:26 +0000 @@ -644,29 +644,6 @@ (load "cl-loaddefs" nil 'quiet) -;; This goes here so that cl-macs can find it if it loads right now. -(provide 'cl-lib) - -;; Things to do after byte-compiler is loaded. - -(defvar cl-hacked-flag nil) -(defun cl-hack-byte-compiler () - (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form) - (progn - (setq cl-hacked-flag t) ; Do it first, to prevent recursion. - (load "cl-macs" nil t) - (run-hooks 'cl-hack-bytecomp-hook)))) - -;; Try it now in case the compiler has already been loaded. -(cl-hack-byte-compiler) - -;; Also make a hook in case compiler is loaded after this file. -(add-hook 'bytecomp-load-hook 'cl-hack-byte-compiler) - - -;; The following ensures that packages which expect the old-style cl.el -;; will be happy with this one. - (provide 'cl-lib) (run-hooks 'cl-load-hook) === modified file 'lisp/emacs-lisp/derived.el' --- lisp/emacs-lisp/derived.el 2012-01-19 07:21:25 +0000 +++ lisp/emacs-lisp/derived.el 2012-06-10 13:28:26 +0000 @@ -90,8 +90,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - ;;; PRIVATE: defsubst must be defined before they are first used (defsubst derived-mode-hook-name (mode) @@ -183,11 +181,11 @@ ;; Process the keyword args. (while (keywordp (car body)) - (case (pop body) - (:group (setq group (pop body))) - (:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil)) - (:syntax-table (setq syntax (pop body)) (setq declare-syntax nil)) - (t (pop body)))) + (pcase (pop body) + (`:group (setq group (pop body))) + (`:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil)) + (`:syntax-table (setq syntax (pop body)) (setq declare-syntax nil)) + (_ (pop body)))) (setq docstring (derived-mode-make-docstring parent child docstring syntax abbrev)) === modified file 'lisp/emacs-lisp/easy-mmode.el' --- lisp/emacs-lisp/easy-mmode.el 2012-06-02 10:56:09 +0000 +++ lisp/emacs-lisp/easy-mmode.el 2012-06-10 13:28:26 +0000 @@ -51,8 +51,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - (defun easy-mmode-pretty-mode-name (mode &optional lighter) "Turn the symbol MODE into a string intended for the user. If provided, LIGHTER will be used to help choose capitalization by, @@ -153,10 +151,10 @@ ;; Allow skipping the first three args. (cond ((keywordp init-value) - (setq body (list* init-value lighter keymap body) + (setq body `(,init-value ,lighter ,keymap ,@body) init-value nil lighter nil keymap nil)) ((keywordp lighter) - (setq body (list* lighter keymap body) lighter nil keymap nil)) + (setq body `(,lighter ,keymap ,@body) lighter nil keymap nil)) ((keywordp keymap) (push keymap body) (setq keymap nil))) (let* ((last-message (make-symbol "last-message")) @@ -182,18 +180,18 @@ ;; Check keys. (while (keywordp (setq keyw (car body))) (setq body (cdr body)) - (case keyw - (:init-value (setq init-value (pop body))) - (:lighter (setq lighter (purecopy (pop body)))) - (:global (setq globalp (pop body))) - (:extra-args (setq extra-args (pop body))) - (:set (setq set (list :set (pop body)))) - (:initialize (setq initialize (list :initialize (pop body)))) - (:group (setq group (nconc group (list :group (pop body))))) - (:type (setq type (list :type (pop body)))) - (:require (setq require (pop body))) - (:keymap (setq keymap (pop body))) - (:variable (setq variable (pop body)) + (pcase keyw + (`:init-value (setq init-value (pop body))) + (`:lighter (setq lighter (purecopy (pop body)))) + (`:global (setq globalp (pop body))) + (`:extra-args (setq extra-args (pop body))) + (`:set (setq set (list :set (pop body)))) + (`:initialize (setq initialize (list :initialize (pop body)))) + (`:group (setq group (nconc group (list :group (pop body))))) + (`:type (setq type (list :type (pop body)))) + (`:require (setq require (pop body))) + (`:keymap (setq keymap (pop body))) + (`:variable (setq variable (pop body)) (if (not (and (setq tmp (cdr-safe variable)) (or (symbolp tmp) (functionp tmp)))) @@ -201,8 +199,8 @@ (setq mode variable) (setq mode (car variable)) (setq setter (cdr variable)))) - (:after-hook (setq after-hook (pop body))) - (t (push keyw extra-keywords) (push (pop body) extra-keywords)))) + (`:after-hook (setq after-hook (pop body))) + (_ (push keyw extra-keywords) (push (pop body) extra-keywords)))) (setq keymap-sym (if (and keymap (symbolp keymap)) keymap (intern (concat mode-name "-map")))) @@ -355,10 +353,10 @@ ;; Check keys. (while (keywordp (setq keyw (car keys))) (setq keys (cdr keys)) - (case keyw - (:group (setq group (nconc group (list :group (pop keys))))) - (:global (setq keys (cdr keys))) - (t (push keyw extra-keywords) (push (pop keys) extra-keywords)))) + (pcase keyw + (`:group (setq group (nconc group (list :group (pop keys))))) + (`:global (setq keys (cdr keys))) + (_ (push keyw extra-keywords) (push (pop keys) extra-keywords)))) (unless group ;; We might as well provide a best-guess default group. @@ -479,13 +477,13 @@ (while args (let ((key (pop args)) (val (pop args))) - (case key - (:name (setq name val)) - (:dense (setq dense val)) - (:inherit (setq inherit val)) - (:suppress (setq suppress val)) - (:group) - (t (message "Unknown argument %s in defmap" key))))) + (pcase key + (`:name (setq name val)) + (`:dense (setq dense val)) + (`:inherit (setq inherit val)) + (`:suppress (setq suppress val)) + (`:group) + (_ (message "Unknown argument %s in defmap" key))))) (unless (keymapp m) (setq bs (append m bs)) (setq m (if dense (make-keymap name) (make-sparse-keymap name)))) === modified file 'lisp/emacs-lisp/easymenu.el' --- lisp/emacs-lisp/easymenu.el 2012-02-28 08:17:21 +0000 +++ lisp/emacs-lisp/easymenu.el 2012-06-10 13:28:26 +0000 @@ -29,8 +29,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - (defvar easy-menu-precalculate-equivalent-keybindings nil "Determine when equivalent key bindings are computed for easy-menu menus. It can take some time to calculate the equivalent key bindings that are shown @@ -236,14 +234,14 @@ (keywordp (setq keyword (car menu-items)))) (setq arg (cadr menu-items)) (setq menu-items (cddr menu-items)) - (case keyword - (:filter + (pcase keyword + (`:filter (setq filter `(lambda (menu) (easy-menu-filter-return (,arg menu) ,menu-name)))) - ((:enable :active) (setq enable (or arg ''nil))) - (:label (setq label arg)) - (:help (setq help arg)) - ((:included :visible) (setq visible (or arg ''nil))))) + ((or `:enable `:active) (setq enable (or arg ''nil))) + (`:label (setq label arg)) + (`:help (setq help arg)) + ((or `:included `:visible) (setq visible (or arg ''nil))))) (if (equal visible ''nil) nil ; Invisible menu entry, return nil. (if (and visible (not (easy-menu-always-true-p visible))) @@ -334,16 +332,16 @@ (setq keyword (aref item count)) (setq arg (aref item (1+ count))) (setq count (+ 2 count)) - (case keyword - ((:included :visible) (setq visible (or arg ''nil))) - (:key-sequence (setq cache arg cache-specified t)) - (:keys (setq keys arg no-name nil)) - (:label (setq label arg)) - ((:active :enable) (setq active (or arg ''nil))) - (:help (setq prop (cons :help (cons arg prop)))) - (:suffix (setq suffix arg)) - (:style (setq style arg)) - (:selected (setq selected (or arg ''nil))))) + (pcase keyword + ((or `:included `:visible) (setq visible (or arg ''nil))) + (`:key-sequence (setq cache arg cache-specified t)) + (`:keys (setq keys arg no-name nil)) + (`:label (setq label arg)) + ((or `:active `:enable) (setq active (or arg ''nil))) + (`:help (setq prop (cons :help (cons arg prop)))) + (`:suffix (setq suffix arg)) + (`:style (setq style arg)) + (`:selected (setq selected (or arg ''nil))))) (if suffix (setq label (if (stringp suffix) === modified file 'lisp/emacs-lisp/ewoc.el' --- lisp/emacs-lisp/ewoc.el 2012-04-26 12:43:28 +0000 +++ lisp/emacs-lisp/ewoc.el 2012-06-10 13:28:26 +0000 @@ -96,11 +96,11 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;; The doubly linked list is implemented as a circular list with a dummy ;; node first and last. The dummy node is used as "the dll". -(defstruct (ewoc--node +(cl-defstruct (ewoc--node (:type vector) ;ewoc--node-nth needs this (:constructor nil) (:constructor ewoc--node-create (start-marker data))) @@ -140,7 +140,7 @@ ;;; The ewoc data type -(defstruct (ewoc +(cl-defstruct (ewoc (:constructor nil) (:constructor ewoc--create (buffer pretty-printer dll)) (:conc-name ewoc--)) @@ -196,10 +196,10 @@ (save-excursion (let ((elemnode (ewoc--node-create (copy-marker (ewoc--node-start-marker node)) data))) - (setf (ewoc--node-left elemnode) (ewoc--node-left node) - (ewoc--node-right elemnode) node - (ewoc--node-right (ewoc--node-left node)) elemnode - (ewoc--node-left node) elemnode) + (cl-setf (ewoc--node-left elemnode) (ewoc--node-left node) + (ewoc--node-right elemnode) node + (ewoc--node-right (ewoc--node-left node)) elemnode + (ewoc--node-left node) elemnode) (ewoc--refresh-node pretty-printer elemnode dll) elemnode))) @@ -244,8 +244,8 @@ the footer and every node's printed representation. Optional fourth arg NOSEP non-nil inhibits this." (let* ((dummy-node (ewoc--node-create 'DL-LIST 'DL-LIST)) - (dll (progn (setf (ewoc--node-right dummy-node) dummy-node) - (setf (ewoc--node-left dummy-node) dummy-node) + (dll (progn (cl-setf (ewoc--node-right dummy-node) dummy-node) + (cl-setf (ewoc--node-left dummy-node) dummy-node) dummy-node)) (wrap (if nosep 'identity 'ewoc--wrap)) (new-ewoc (ewoc--create (current-buffer) @@ -258,12 +258,12 @@ ;; Set default values (unless header (setq header "")) (unless footer (setq footer "")) - (setf (ewoc--node-start-marker dll) (copy-marker pos) - foot (ewoc--insert-new-node dll footer hf-pp dll) - head (ewoc--insert-new-node foot header hf-pp dll) - (ewoc--hf-pp new-ewoc) hf-pp - (ewoc--footer new-ewoc) foot - (ewoc--header new-ewoc) head)) + (cl-setf (ewoc--node-start-marker dll) (copy-marker pos) + foot (ewoc--insert-new-node dll footer hf-pp dll) + head (ewoc--insert-new-node foot header hf-pp dll) + (ewoc--hf-pp new-ewoc) hf-pp + (ewoc--footer new-ewoc) foot + (ewoc--header new-ewoc) head)) ;; Return the ewoc new-ewoc)) @@ -274,7 +274,7 @@ (defun ewoc-set-data (node data) "Set NODE to encapsulate DATA." - (setf (ewoc--node-data node) data)) + (cl-setf (ewoc--node-data node) data)) (defun ewoc-enter-first (ewoc data) "Enter DATA first in EWOC. @@ -356,18 +356,18 @@ ;; If we are about to delete the node pointed at by last-node, ;; set last-node to nil. (when (eq last node) - (setf last nil (ewoc--last-node ewoc) nil)) + (cl-setf last nil (ewoc--last-node ewoc) nil)) (delete-region (ewoc--node-start-marker node) (ewoc--node-start-marker (ewoc--node-next dll node))) (set-marker (ewoc--node-start-marker node) nil) - (setf L (ewoc--node-left node) - R (ewoc--node-right node) - ;; Link neighbors to each other. - (ewoc--node-right L) R - (ewoc--node-left R) L - ;; Forget neighbors. - (ewoc--node-left node) nil - (ewoc--node-right node) nil)))) + (cl-setf L (ewoc--node-left node) + R (ewoc--node-right node) + ;; Link neighbors to each other. + (ewoc--node-right L) R + (ewoc--node-left R) L + ;; Forget neighbors. + (ewoc--node-left node) nil + (ewoc--node-right node) nil)))) (defun ewoc-filter (ewoc predicate &rest args) "Remove all elements in EWOC for which PREDICATE returns nil. @@ -503,7 +503,7 @@ (ewoc--set-buffer-bind-dll ewoc (goto-char (ewoc--node-start-marker node)) (if goal-column (move-to-column goal-column)) - (setf (ewoc--last-node ewoc) node))) + (cl-setf (ewoc--last-node ewoc) node))) (defun ewoc-refresh (ewoc) "Refresh all data in EWOC. @@ -564,8 +564,8 @@ ((head (ewoc--header ewoc)) (foot (ewoc--footer ewoc)) (hf-pp (ewoc--hf-pp ewoc))) - (setf (ewoc--node-data head) header - (ewoc--node-data foot) footer) + (cl-setf (ewoc--node-data head) header + (ewoc--node-data foot) footer) (save-excursion (ewoc--refresh-node hf-pp head dll) (ewoc--refresh-node hf-pp foot dll)))) === modified file 'lisp/emacs-lisp/smie.el' --- lisp/emacs-lisp/smie.el 2012-05-15 13:25:03 +0000 +++ lisp/emacs-lisp/smie.el 2012-06-10 13:28:26 +0000 @@ -121,7 +121,7 @@ ;; - smie-indent-comment doesn't interact well with mis-indented lines (where ;; the indent rules don't do what the user wants). Not sure what to do. -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup smie nil "Simple Minded Indentation Engine." @@ -155,7 +155,7 @@ (defvar smie-warning-count 0) (defun smie-set-prec2tab (table x y val &optional override) - (assert (and x y)) + (cl-assert (and x y)) (let* ((key (cons x y)) (old (gethash key table))) (if (and old (not (eq old val))) @@ -166,7 +166,7 @@ ;; don't hide real conflicts. (puthash key (gethash key override) table) (display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y)) - (incf smie-warning-count)) + (cl-incf smie-warning-count)) (puthash key val table)))) (put 'smie-precs->prec2 'pure t) @@ -268,8 +268,8 @@ (unless (consp rhs) (signal 'wrong-type-argument `(consp ,rhs))) (if (not (member (car rhs) nts)) - (pushnew (car rhs) first-ops) - (pushnew (car rhs) first-nts) + (cl-pushnew (car rhs) first-ops) + (cl-pushnew (car rhs) first-nts) (when (consp (cdr rhs)) ;; If the first is not an OP we add the second (which ;; should be an OP if BNF is an "operator grammar"). @@ -282,16 +282,16 @@ (when (member (cadr rhs) nts) (error "Adjacent non-terminals: %s %s" (car rhs) (cadr rhs))) - (pushnew (cadr rhs) first-ops))) + (cl-pushnew (cadr rhs) first-ops))) (let ((shr (reverse rhs))) (if (not (member (car shr) nts)) - (pushnew (car shr) last-ops) - (pushnew (car shr) last-nts) + (cl-pushnew (car shr) last-ops) + (cl-pushnew (car shr) last-nts) (when (consp (cdr shr)) (when (member (cadr shr) nts) (error "Adjacent non-terminals: %s %s" (cadr shr) (car shr))) - (pushnew (cadr shr) last-ops))))) + (cl-pushnew (cadr shr) last-ops))))) (push (cons nt first-ops) first-ops-table) (push (cons nt last-ops) last-ops-table) (push (cons nt first-nts) first-nts-table) @@ -307,7 +307,7 @@ (dolist (op (cdr (assoc first-nt first-ops-table))) (unless (member op first-ops) (setq again t) - (push op (cdr first-ops)))))))) + (cl-push op (cdr first-ops)))))))) ;; Same thing for last-ops. (setq again t) (while (prog1 again (setq again nil)) @@ -318,7 +318,7 @@ (dolist (op (cdr (assoc last-nt last-ops-table))) (unless (member op last-ops) (setq again t) - (push op (cdr last-ops)))))))) + (cl-push op (cdr last-ops)))))))) ;; Now generate the 2D precedence table. (dolist (rules bnf) (dolist (rhs (cdr rules)) @@ -416,12 +416,12 @@ (if no-inners (let ((last (car (last rhs)))) (unless (member last nts) - (pushnew (cons (car rhs) last) alist :test #'equal))) + (cl-pushnew (cons (car rhs) last) alist :test #'equal))) ;; Reverse so that the "real" closer gets there first, ;; which is important for smie-close-block. (dolist (term (reverse (cdr rhs))) (unless (member term nts) - (pushnew (cons (car rhs) term) alist :test #'equal))))))) + (cl-pushnew (cons (car rhs) term) alist :test #'equal))))))) (nreverse alist))) (defun smie-bnf--set-class (table token class) @@ -483,7 +483,7 @@ (push (concat "." (car elem)) res)) (if (eq (cddr elem) val) (push (concat (car elem) ".") res))) - (assert res) + (cl-assert res) res)) cycle))) (mapconcat @@ -498,9 +498,9 @@ ;; (right (nth 1 (assoc (cdr k) grammar)))) ;; (when (and left right) ;; (cond -;; ((< left right) (assert (eq v '<))) -;; ((> left right) (assert (eq v '>))) -;; (t (assert (eq v '=)))))))) +;; ((< left right) (cl-assert (eq v '<))) +;; ((> left right) (cl-assert (eq v '>))) +;; (t (cl-assert (eq v '=)))))))) ;; prec2)) (put 'smie-prec2->grammar 'pure t) @@ -514,25 +514,28 @@ ;; final `table'. The value of each "variable" is kept in the `car'. (let ((table ()) (csts ()) - (eqs ()) - tmp x y) + (eqs ())) ;; From `prec2' we construct a list of constraints between ;; variables (aka "precedence levels"). These can be either ;; equality constraints (in `eqs') or `<' constraints (in `csts'). (maphash (lambda (k v) (when (consp k) - (if (setq tmp (assoc (car k) table)) - (setq x (cddr tmp)) - (setq x (cons nil nil)) - (push (cons (car k) (cons nil x)) table)) - (if (setq tmp (assoc (cdr k) table)) - (setq y (cdr tmp)) - (setq y (cons nil (cons nil nil))) - (push (cons (cdr k) y) table)) - (ecase v - (= (push (cons x y) eqs)) - (< (push (cons x y) csts)) - (> (push (cons y x) csts))))) + (let ((tmp (assoc (car k) table)) + x y) + (if tmp + (setq x (cddr tmp)) + (setq x (cons nil nil)) + (push (cons (car k) (cons nil x)) table)) + (if (setq tmp (assoc (cdr k) table)) + (setq y (cdr tmp)) + (setq y (cons nil (cons nil nil))) + (push (cons (cdr k) y) table)) + (pcase v + (`= (push (cons x y) eqs)) + (`< (push (cons x y) csts)) + (`> (push (cons y x) csts)) + (_ (error "SMIE error: prec2 has %S↦%S which ∉ {<,+,>}" + k v)))))) prec2) ;; First process the equality constraints. (let ((eqs eqs)) @@ -572,13 +575,13 @@ (unless (caar cst) (setcar (car cst) i) ;; (smie-check-grammar table prec2 'step1) - (incf i)) + (cl-incf i)) (setq csts (delq cst csts)))) (unless progress (error "Can't resolve the precedence cycle: %s" (smie-debug--describe-cycle table (smie-debug--prec2-cycle csts))))) - (incf i 10)) + (cl-incf i 10)) ;; Propagate equality constraints back to their sources. (dolist (eq (nreverse eqs)) (when (null (cadr eq)) @@ -589,8 +592,8 @@ ;; So set it here rather than below since doing it below ;; makes it more difficult to obey the equality constraints. (setcar (cdr eq) i) - (incf i)) - (assert (or (null (caar eq)) (eq (caar eq) (cadr eq)))) + (cl-incf i)) + (cl-assert (or (null (caar eq)) (eq (caar eq) (cadr eq)))) (setcar (car eq) (cadr eq)) ;; (smie-check-grammar table prec2 'step2) ) @@ -598,19 +601,19 @@ ;; left side of any < constraint). (dolist (x table) (unless (nth 1 x) - (setf (nth 1 x) i) - (incf i)) ;See other (incf i) above. + (cl-setf (nth 1 x) i) + (cl-incf i)) ;See other (cl-incf i) above. (unless (nth 2 x) - (setf (nth 2 x) i) - (incf i)))) ;See other (incf i) above. + (cl-setf (nth 2 x) i) + (cl-incf i)))) ;See other (cl-incf i) above. ;; Mark closers and openers. (dolist (x (gethash :smie-open/close-alist prec2)) (let* ((token (car x)) - (cons (case (cdr x) - (closer (cddr (assoc token table))) - (opener (cdr (assoc token table)))))) - (assert (numberp (car cons))) - (setf (car cons) (list (car cons))))) + (cons (pcase (cdr x) + (`closer (cddr (assoc token table))) + (`opener (cdr (assoc token table)))))) + (cl-assert (numberp (car cons))) + (cl-setf (car cons) (list (car cons))))) (let ((ca (gethash :smie-closer-alist prec2))) (when ca (push (cons :smie-closer-alist ca) table))) ;; (smie-check-grammar table prec2 'step3) @@ -706,19 +709,19 @@ (condition-case err (progn (goto-char pos) (funcall next-sexp 1) nil) (scan-error (throw 'return - (list t (caddr err) + (list t (cl-caddr err) (buffer-substring-no-properties - (caddr err) - (+ (caddr err) - (if (< (point) (caddr err)) + (cl-caddr err) + (+ (cl-caddr err) + (if (< (point) (cl-caddr err)) -1 1))))))) (if (eq pos (point)) ;; We did not move, so let's abort the loop. (throw 'return (list t (point)))))) ((not (numberp (funcall op-back toklevels))) ;; A token like a paren-close. - (assert (numberp ; Otherwise, why mention it in smie-grammar. - (funcall op-forw toklevels))) + (cl-assert (numberp ; Otherwise, why mention it in smie-grammar. + (funcall op-forw toklevels))) (push toklevels levels)) (t (while (and levels (< (funcall op-back toklevels) @@ -1672,12 +1675,12 @@ (while keywords (let ((k (pop keywords)) (v (pop keywords))) - (case k - (:forward-token + (pcase k + (`:forward-token (set (make-local-variable 'smie-forward-token-function) v)) - (:backward-token + (`:backward-token (set (make-local-variable 'smie-backward-token-function) v)) - (t (message "smie-setup: ignoring unknown keyword %s" k))))) + (_ (message "smie-setup: ignoring unknown keyword %s" k))))) (let ((ca (cdr (assq :smie-closer-alist grammar)))) (when ca (set (make-local-variable 'smie-closer-alist) ca) === modified file 'lisp/emacs-lisp/syntax.el' --- lisp/emacs-lisp/syntax.el 2012-04-26 12:43:28 +0000 +++ lisp/emacs-lisp/syntax.el 2012-06-10 13:28:26 +0000 @@ -41,7 +41,7 @@ ;; Note: PPSS stands for `parse-partial-sexp state' -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defvar font-lock-beginning-of-syntax-function) @@ -181,7 +181,7 @@ ;; If there's more than 1 rule, and the rule want to apply ;; highlight to match 0, create an extra group to be able to ;; tell when *this* match 0 has succeeded. - (incf offset) + (cl-incf offset) (setq re (concat "\\(" re "\\)"))) (setq re (syntax-propertize--shift-groups re offset)) (let ((code '()) @@ -215,7 +215,7 @@ (setq offset 0))) ;; Now construct the code for each subgroup rules. (dolist (case (cdr rule)) - (assert (null (cddr case))) + (cl-assert (null (cddr case))) (let* ((gn (+ offset (car case))) (action (nth 1 case)) (thiscode @@ -260,7 +260,7 @@ code)))) (push (cons condition (nreverse code)) branches)) - (incf offset (regexp-opt-depth orig-re)) + (cl-incf offset (regexp-opt-depth orig-re)) re)) rules "\\|"))) @@ -418,8 +418,8 @@ (* 2 (/ (cdr (aref syntax-ppss-stats 5)) (1+ (car (aref syntax-ppss-stats 5))))))) (progn - (incf (car (aref syntax-ppss-stats 0))) - (incf (cdr (aref syntax-ppss-stats 0)) (- pos old-pos)) + (cl-incf (car (aref syntax-ppss-stats 0))) + (cl-incf (cdr (aref syntax-ppss-stats 0)) (- pos old-pos)) (parse-partial-sexp old-pos pos nil nil old-ppss)) (cond @@ -435,8 +435,8 @@ (setq pt-min (or (syntax-ppss-toplevel-pos old-ppss) (nth 2 old-ppss))) (<= pt-min pos) (< (- pos pt-min) syntax-ppss-max-span)) - (incf (car (aref syntax-ppss-stats 1))) - (incf (cdr (aref syntax-ppss-stats 1)) (- pos pt-min)) + (cl-incf (car (aref syntax-ppss-stats 1))) + (cl-incf (cdr (aref syntax-ppss-stats 1)) (- pos pt-min)) (setq ppss (parse-partial-sexp pt-min pos))) ;; The OLD-* data can't be used. Consult the cache. (t @@ -464,8 +464,8 @@ ;; Use the best of OLD-POS and CACHE. (if (or (not old-pos) (< old-pos pt-min)) (setq pt-best pt-min ppss-best ppss) - (incf (car (aref syntax-ppss-stats 4))) - (incf (cdr (aref syntax-ppss-stats 4)) (- pos old-pos)) + (cl-incf (car (aref syntax-ppss-stats 4))) + (cl-incf (cdr (aref syntax-ppss-stats 4)) (- pos old-pos)) (setq pt-best old-pos ppss-best old-ppss)) ;; Use the `syntax-begin-function' if available. @@ -490,21 +490,21 @@ (not (memq (get-text-property (point) 'face) '(font-lock-string-face font-lock-doc-face font-lock-comment-face)))) - (incf (car (aref syntax-ppss-stats 5))) - (incf (cdr (aref syntax-ppss-stats 5)) (- pos (point))) + (cl-incf (car (aref syntax-ppss-stats 5))) + (cl-incf (cdr (aref syntax-ppss-stats 5)) (- pos (point))) (setq pt-best (point) ppss-best nil)) (cond ;; Quick case when we found a nearby pos. ((< (- pos pt-best) syntax-ppss-max-span) - (incf (car (aref syntax-ppss-stats 2))) - (incf (cdr (aref syntax-ppss-stats 2)) (- pos pt-best)) + (cl-incf (car (aref syntax-ppss-stats 2))) + (cl-incf (cdr (aref syntax-ppss-stats 2)) (- pos pt-best)) (setq ppss (parse-partial-sexp pt-best pos nil nil ppss-best))) ;; Slow case: compute the state from some known position and ;; populate the cache so we won't need to do it again soon. (t - (incf (car (aref syntax-ppss-stats 3))) - (incf (cdr (aref syntax-ppss-stats 3)) (- pos pt-min)) + (cl-incf (car (aref syntax-ppss-stats 3))) + (cl-incf (cdr (aref syntax-ppss-stats 3)) (- pos pt-min)) ;; If `pt-min' is too far, add a few intermediate entries. (while (> (- pos pt-min) (* 2 syntax-ppss-max-span)) @@ -513,7 +513,7 @@ nil nil ppss)) (let ((pair (cons pt-min ppss))) (if cache-pred - (push pair (cdr cache-pred)) + (cl-push pair (cdr cache-pred)) (push pair syntax-ppss-cache)))) ;; Compute the actual return value. @@ -533,7 +533,7 @@ (let ((pair (cons pos ppss))) (if cache-pred (if (> (- (caar cache-pred) pos) syntax-ppss-max-span) - (push pair (cdr cache-pred)) + (cl-push pair (cdr cache-pred)) (setcar cache-pred pair)) (if (or (null syntax-ppss-cache) (> (- (caar syntax-ppss-cache) pos) === modified file 'lisp/emacs-lisp/timer.el' --- lisp/emacs-lisp/timer.el 2012-05-04 05:14:14 +0000 +++ lisp/emacs-lisp/timer.el 2012-06-10 13:28:26 +0000 @@ -33,9 +33,9 @@ ;; triggered-p is nil if the timer is active (waiting to be triggered), ;; t if it is inactive ("already triggered", in theory) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) -(defstruct (timer +(cl-defstruct (timer (:constructor nil) (:copier nil) (:constructor timer-create ()) @@ -54,15 +54,15 @@ (timer--low-seconds timer) (timer--usecs timer))) -(defsetf timer--time +(cl-defsetf timer--time (lambda (timer time) (or (timerp timer) (error "Invalid timer")) - (setf (timer--high-seconds timer) (pop time)) - (setf (timer--low-seconds timer) - (if (consp time) (car time) time)) - (setf (timer--usecs timer) (or (and (consp time) (consp (cdr time)) - (cadr time)) - 0)))) + (cl-setf (timer--high-seconds timer) (pop time)) + (cl-setf (timer--low-seconds timer) + (if (consp time) (car time) time)) + (cl-setf (timer--usecs timer) (or (and (consp time) (consp (cdr time)) + (cadr time)) + 0)))) (defun timer-set-time (timer time &optional delta) @@ -70,8 +70,8 @@ TIME must be in the internal format returned by, e.g., `current-time'. If optional third argument DELTA is a positive number, make the timer fire repeatedly that many seconds apart." - (setf (timer--time timer) time) - (setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta)) + (cl-setf (timer--time timer) time) + (cl-setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta)) timer) (defun timer-set-idle-time (timer secs &optional repeat) @@ -81,10 +81,10 @@ If optional third argument REPEAT is non-nil, make the timer fire each time Emacs is idle for that many seconds." (if (consp secs) - (setf (timer--time timer) secs) - (setf (timer--time timer) '(0 0 0)) + (cl-setf (timer--time timer) secs) + (cl-setf (timer--time timer) '(0 0 0)) (timer-inc-time timer secs)) - (setf (timer--repeat-delay timer) repeat) + (cl-setf (timer--repeat-delay timer) repeat) timer) (defun timer-next-integral-multiple-of-time (time secs) @@ -124,8 +124,8 @@ (defun timer-inc-time (timer secs &optional usecs) "Increment the time set in TIMER by SECS seconds and USECS microseconds. SECS may be a fraction. If USECS is omitted, that means it is zero." - (setf (timer--time timer) - (timer-relative-time (timer--time timer) secs usecs))) + (cl-setf (timer--time timer) + (timer-relative-time (timer--time timer) secs usecs))) (defun timer-set-time-with-usecs (timer time usecs &optional delta) "Set the trigger time of TIMER to TIME plus USECS. @@ -133,9 +133,9 @@ The microsecond count from TIME is ignored, and USECS is used instead. If optional fourth argument DELTA is a positive number, make the timer fire repeatedly that many seconds apart." - (setf (timer--time timer) time) - (setf (timer--usecs timer) usecs) - (setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta)) + (cl-setf (timer--time timer) time) + (cl-setf (timer--usecs timer) usecs) + (cl-setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta)) timer) (make-obsolete 'timer-set-time-with-usecs "use `timer-set-time' and `timer-inc-time' instead." @@ -145,8 +145,8 @@ "Make TIMER call FUNCTION with optional ARGS when triggering." (or (timerp timer) (error "Invalid timer")) - (setf (timer--function timer) function) - (setf (timer--args timer) args) + (cl-setf (timer--function timer) function) + (cl-setf (timer--args timer) args) timer) (defun timer--activate (timer &optional triggered-p reuse-cell idle) @@ -170,8 +170,8 @@ (cond (last (setcdr last reuse-cell)) (idle (setq timer-idle-list reuse-cell)) (t (setq timer-list reuse-cell))) - (setf (timer--triggered timer) triggered-p) - (setf (timer--idle-delay timer) idle) + (cl-setf (timer--triggered timer) triggered-p) + (cl-setf (timer--idle-delay timer) idle) nil) (error "Invalid or uninitialized timer"))) @@ -294,7 +294,7 @@ (apply (timer--function timer) (timer--args timer))) (error nil)) (if retrigger - (setf (timer--triggered timer) nil))) + (cl-setf (timer--triggered timer) nil))) (error "Bogus timer event")))) ;; This function is incompatible with the one in levents.el. ------------------------------------------------------------ revno: 108549 [merge] committer: Chong Yidong branch nick: trunk timestamp: Sun 2012-06-10 21:21:29 +0800 message: Merge from emacs-24; up to r108032 diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2012-06-08 00:03:10 +0000 +++ doc/misc/ChangeLog 2012-06-10 13:20:58 +0000 @@ -1,3 +1,8 @@ +2012-06-10 Chong Yidong + + * sc.texi: Remove bogus @ifinfo commands which prevent makeinfo + compilation for html-mono. + 2012-06-08 Paul Eggert * texinfo.tex: Merge from gnulib. === modified file 'doc/misc/sc.texi' --- doc/misc/sc.texi 2012-05-28 23:28:27 +0000 +++ doc/misc/sc.texi 2012-06-10 13:20:58 +0000 @@ -95,13 +95,11 @@ The preferred way to spell Supercite is with a capital @samp{S}, lowercase @samp{upercite}. -@ifinfo @menu * Usage Overview:: * What Supercite Does Not Do:: * What Supercite Does:: @end menu -@end ifinfo @cindex MUA @cindex NUA @@ -242,12 +240,10 @@ And that's what I think too. @end example -@ifinfo @menu * Citation Elements:: * Recognizing Citations:: @end menu -@end ifinfo Note that multiple inclusions of the original messages result in a nesting of the @samp{@code{>}} characters. This can sometimes be quite @@ -506,12 +502,10 @@ information contained in the info alist can be inserted into a reference header. -@ifinfo @menu * The Built-in Header Rewrite Functions:: * Electric References:: @end menu -@end ifinfo @cindex header rewrite functions @vindex sc-rewrite-header-list @@ -791,7 +785,6 @@ @node Replying and Yanking @chapter Replying and Yanking -@ifinfo This chapter explains what happens when you reply and yank an original message from an MUA. @@ -800,7 +793,7 @@ * Reply Buffer Initialization:: * Filling Cited Text:: @end menu -@end ifinfo + @node Reply Buffer Initialization @section Reply Buffer Initialization @findex sc-cite-original @@ -1053,13 +1046,11 @@ information as the author's first name, middle names, and last name, the author's initials, and the author's email terminus. -@ifinfo @menu * Attribution Preferences:: * Anonymous Attributions:: * Author Names:: @end menu -@end ifinfo @node Attribution Preferences @section Attribution Preferences @@ -1331,12 +1322,10 @@ throughout Supercite, from mail header information extraction, to header nuking, to citing text. -@ifinfo @menu * Using Regi:: * Frames You Can Customize:: @end menu -@end ifinfo While the details of Regi are discussed below (@pxref{Using Regi}), only those who wish to customize certain aspects of Supercite need concern @@ -1534,7 +1523,6 @@ chapter, we'll assume you've installed Supercite's keymap on the default prefix.@refill -@ifinfo @menu * Citing Commands:: * Insertion Commands:: @@ -1542,7 +1530,6 @@ * Mail Field Commands:: * Miscellaneous Commands:: @end menu -@end ifinfo @node Citing Commands @section Commands to Manually Cite, Recite, and Uncite @@ -1909,9 +1896,7 @@ @node Command Index @unnumbered Command Index -@ifinfo -@end ifinfo Since all supercite commands are prepended with the string ``@code{sc-}'', each appears under its @code{sc-}@var{command} name and its @var{command} name. @@ -1926,9 +1911,7 @@ @node Variable Index @unnumbered Variable Index -@ifinfo -@end ifinfo Since all supercite variables are prepended with the string ``@code{sc-}'', each appears under its @code{sc-}@var{variable} name and its @var{variable} name. === modified file 'etc/AUTHORS' --- etc/AUTHORS 2012-05-27 01:06:44 +0000 +++ etc/AUTHORS 2012-06-10 13:20:58 +0000 @@ -1134,8 +1134,8 @@ and co-wrote ob-R.el ob-clojure.el ob-exp.el ob-fortran.el ob-lisp.el ob-lob.el ob-maxima.el ob-perl.el ob-picolisp.el ob-python.el ob-ref.el ob.el org-bibtex.el -and changed org.texi org.el org-exp.el org-latex.el org-src.el - ob-plantuml.el org-table.el org-agenda.el org-macs.el orgcard.tex +and changed org.texi org.el org-exp.el org-latex.el ob-plantuml.el + org-src.el org-table.el org-agenda.el org-macs.el orgcard.tex ob-lilypond.el ob-mscgen.el ob-octave.el ob-screen.el org-ascii.el org-footnote.el org-html.el org-mouse.el gnus-art.el ob-ledger.el ob-matlab.el and 5 other files @@ -2035,8 +2035,8 @@ Keith Packard: changed font.c Ken Brown: changed configure.in cygwin.h sheap.c browse-url.el gmalloc.c - vm-limit.c dired.c emacs.c fileio.c gdb-mi.el loadup.el mem-limits.h - unexcw.c + vm-limit.c callproc.c dired.c emacs.c fileio.c gdb-mi.el loadup.el + mem-limits.h unexcw.c Ken Brush: changed emacsclient.c @@ -2373,6 +2373,8 @@ Mark Plaksin: changed nnrss.el term.el +Mark Shoulson: changed org.el + Mark Thomas: changed flow-fill.el gnus-sum.el gnus-util.el nnmail.el Mark Triggs: changed nnir.el === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-06-09 17:03:43 +0000 +++ lisp/ChangeLog 2012-06-10 13:20:58 +0000 @@ -1,3 +1,17 @@ +2012-06-10 Glenn Morris + + * mail/rmail.el (rmail-yank-current-message): Leave point at + correct position. (Bug#11660) + +2012-06-10 Chong Yidong + + * allout-widgets.el: Fix code header. + +2012-06-10 Chong Yidong + + * cus-edit.el (customize-changed-options-previous-release): Bump + to 24.1. + 2012-06-09 Andreas Schwab * Makefile.in (BIG_STACK_DEPTH): Enlarge to 2200. === modified file 'lisp/allout-widgets.el' --- lisp/allout-widgets.el 2012-05-02 10:57:03 +0000 +++ lisp/allout-widgets.el 2012-06-10 13:20:58 +0000 @@ -64,7 +64,7 @@ ;; systematically couple overlays, graphics, and other features with ;; allout-governed text. -;;;_: Code (structured with comments that delineate an allout outline) +;;; Code: ;;;_ : General Environment (require 'allout) === modified file 'lisp/cus-edit.el' --- lisp/cus-edit.el 2012-06-08 16:39:49 +0000 +++ lisp/cus-edit.el 2012-06-10 13:20:58 +0000 @@ -1159,7 +1159,7 @@ (unless (eq symbol basevar) (message "`%s' is an alias for `%s'" symbol basevar)))) -(defvar customize-changed-options-previous-release "23.1" +(defvar customize-changed-options-previous-release "24.1" "Version for `customize-changed-options' to refer back to by default.") ;; Packages will update this variable, so make it available. === modified file 'lisp/mail/rmail.el' --- lisp/mail/rmail.el 2012-05-24 07:20:34 +0000 +++ lisp/mail/rmail.el 2012-06-10 13:20:58 +0000 @@ -3589,7 +3589,7 @@ (with-current-buffer buffer (unless (rmail-buffers-swapped-p) (setq buffer rmail-view-buffer))) - (insert-buffer buffer) + (insert-buffer-substring buffer) ;; If they yank the text of BUFFER, the encoding of BUFFER is a ;; better default for the reply message than the default value of ;; buffer-file-coding-system. === modified file 'src/dispextern.h' --- src/dispextern.h 2012-06-09 16:44:44 +0000 +++ src/dispextern.h 2012-06-10 13:20:58 +0000 @@ -2205,7 +2205,11 @@ struct display_pos current; /* Total number of overlay strings to process. This can be > - OVERLAY_STRING_CHUNK_SIZE. */ + OVERLAY_STRING_CHUNK_SIZE. Value is dependable only when + current.overlay_string_index >= 0. Use the latter to determine + whether an overlay string is being iterated over, because + n_overlay_strings can be positive even when we are not rendering + an overlay string. */ ptrdiff_t n_overlay_strings; /* The charpos where n_overlay_strings was calculated. This should @@ -2224,7 +2228,8 @@ /* If non-nil, a Lisp string being processed. If current.overlay_string_index >= 0, this is an overlay string from - pos. */ + pos. Use STRINGP (it.string) to test whether we are rendering a + string or something else; do NOT use BUFFERP (it.object). */ Lisp_Object string; /* If non-nil, we are processing a string that came @@ -2413,6 +2418,9 @@ and continuation glyphs, or blanks that extend each line to the edge of the window on a TTY. + Do NOT use !BUFFERP (it.object) as a test whether we are + iterating over a string; use STRINGP (it.string) instead. + Position is the current iterator position in object. */ Lisp_Object object; struct text_pos position; ------------------------------------------------------------ revno: 108548 committer: Glenn Morris branch nick: trunk timestamp: Sun 2012-06-10 06:18:41 -0400 message: Auto-commit of generated files. diff: === modified file 'autogen/config.in' --- autogen/config.in 2012-06-09 11:12:12 +0000 +++ autogen/config.in 2012-06-10 10:18:41 +0000 @@ -1410,3 +1410,4 @@ mode: c End: */ + === modified file 'autogen/configure' --- autogen/configure 2012-06-04 10:17:27 +0000 +++ autogen/configure 2012-06-10 10:18:41 +0000 @@ -10714,7 +10714,8 @@ $as_echo "#define HAVE_DBUS 1" >>confdefs.h - for ac_func in dbus_watch_get_unix_fd \ + for ac_func in dbus_watch_get_unix_fd \ + dbus_type_is_valid \ dbus_validate_bus_name \ dbus_validate_path \ dbus_validate_interface \ ------------------------------------------------------------ revno: 108547 committer: Chong Yidong branch nick: trunk timestamp: Sun 2012-06-10 17:06:34 +0800 message: admin.el (make-manuals): Generate misc html manuals too. diff: === modified file 'admin/admin.el' --- admin/admin.el 2012-02-11 22:16:10 +0000 +++ admin/admin.el 2012-06-10 09:06:34 +0000 @@ -240,7 +240,7 @@ (manual-txt texi (expand-file-name "emacs.txt" txt-dir)) (manual-pdf texi (expand-file-name "emacs.pdf" dest)) (manual-dvi texi (expand-file-name "emacs.dvi" dvi-dir) - (expand-file-name "emacs.ps" ps-dir))) + (expand-file-name "emacs.ps" ps-dir))) ;; Lisp manual (let ((texi (expand-file-name "doc/lispref/elisp.texi" root))) (manual-html-node texi (expand-file-name "elisp" html-node-dir)) @@ -248,7 +248,20 @@ (manual-txt texi (expand-file-name "elisp.txt" txt-dir)) (manual-pdf texi (expand-file-name "elisp.pdf" dest)) (manual-dvi texi (expand-file-name "elisp.dvi" dvi-dir) - (expand-file-name "elisp.ps" ps-dir))) + (expand-file-name "elisp.ps" ps-dir))) + ;; Misc manuals + (let ((manuals '("ada-mode" "auth" "autotype" "calc" "cc-mode" + "cl" "dbus" "dired-x" "ebrowse" "ede" "ediff" + "edt" "eieio" "emacs-mime" "epa" "erc" "ert" + "eshell" "eudc" "faq" "flymake" "forms" + "gnus" "emacs-gnutls" "idlwave" "info" + "mairix-el" "message" "mh-e" "newsticker" + "nxml-mode" "org" "pcl-cvs" "pgg" "rcirc" + "remember" "reftex" "sasl" "sc" "semantic" + "ses" "sieve" "smtpmail" "speedbar" "tramp" + "url" "vip" "viper" "widget" "woman"))) + (dolist (manual manuals) + (manual-misc-html manual root html-node-dir html-mono-dir))) (message "Manuals created in %s" dest))) (defconst manual-doctype-string @@ -265,6 +278,12 @@ (defconst manual-style-string "\n") +(defun manual-misc-html (name root html-node-dir html-mono-dir) + (let ((texi (expand-file-name (format "doc/misc/%s.texi" name) root))) + (manual-html-node texi (expand-file-name name html-node-dir)) + (manual-html-mono texi (expand-file-name (concat name ".html") + html-mono-dir)))) + (defun manual-html-mono (texi-file dest) "Run Makeinfo on TEXI-FILE, emitting mono HTML output to DEST. This function also edits the HTML files so that they validate as @@ -307,13 +326,15 @@ (let (copyright-text) (manual-html-fix-index-1) ;; Move copyright notice to the end. - (re-search-forward "[ \t]*

Copyright ©") - (setq opoint (match-beginning 0)) - (re-search-forward "") - (setq copyright-text (buffer-substring opoint (point))) - (delete-region opoint (point)) + (when (re-search-forward "[ \t]*

Copyright ©" nil t) + (setq opoint (match-beginning 0)) + (re-search-forward "") + (setq copyright-text (buffer-substring opoint (point))) + (delete-region opoint (point))) (manual-html-fix-index-2) - (insert copyright-text "\n\n")) + (if copyright-text + (insert copyright-text)) + (insert "\n\n")) ;; For normal nodes, give the header div a blue bg. (manual-html-fix-node-div)) (save-buffer)))))) @@ -369,9 +390,9 @@ (defun manual-html-fix-index-1 () (let (opoint) - (re-search-forward "\n\\(

\n") + (setq opoint (match-end 0)) + (search-forward "

\n\n"))) @@ -380,7 +401,8 @@ "Replace the index list in the current buffer with a HTML table." (let (done open-td tag desc) ;; Convert the list that Makeinfo made into a table. - (search-forward "
    ") + (or (search-forward "
      " nil t) + (search-forward "
        ")) (replace-match "") (forward-line 1) (while (not done) @@ -413,7 +435,7 @@ (replace-match "
        \n

        Detailed Node Listing

        \n\n" t t) (search-forward "

        ") - (search-forward "

        ") + (search-forward "

        " nil t) (goto-char (match-beginning 0)) (skip-chars-backward "\n ") (setq open-td nil) @@ -427,8 +449,8 @@ (setq open-td nil)) (insert " ") - (re-search-forward "

        [ \t\n]*
          ") - (replace-match " ")) + (if (re-search-forward "

          [ \t\n]*
            " nil t) + (replace-match " "))) ((looking-at "[ \t]*
          [ \t]*$") (replace-match (if open-td ------------------------------------------------------------ revno: 108546 committer: Andreas Schwab branch nick: emacs timestamp: Sun 2012-06-10 10:39:19 +0200 message: * regex.c (at_begline_loc_p): Also recognize `(?N:' and correctly account for preceding backslashes. (Bug#11663) diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-06-09 16:44:44 +0000 +++ src/ChangeLog 2012-06-10 08:39:19 +0000 @@ -1,3 +1,8 @@ +2012-06-10 Andreas Schwab + + * regex.c (at_begline_loc_p): Also recognize `(?N:' and correctly + account for preceding backslashes. (Bug#11663) + 2012-06-09 Chong Yidong * term.c: Support italics in capable terminals (Bug#9652). === modified file 'src/regex.c' --- src/regex.c 2012-05-21 15:36:54 +0000 +++ src/regex.c 2012-06-10 08:39:19 +0000 @@ -3824,18 +3824,37 @@ at_begline_loc_p (const re_char *pattern, const re_char *p, reg_syntax_t syntax) { re_char *prev = p - 2; - boolean prev_prev_backslash = prev > pattern && prev[-1] == '\\'; - - return - /* After a subexpression? */ - (*prev == '(' && (syntax & RE_NO_BK_PARENS || prev_prev_backslash)) - /* After an alternative? */ - || (*prev == '|' && (syntax & RE_NO_BK_VBAR || prev_prev_backslash)) - /* After a shy subexpression? */ - || ((syntax & RE_SHY_GROUPS) && prev - 2 >= pattern - && prev[-1] == '?' && prev[-2] == '(' - && (syntax & RE_NO_BK_PARENS - || (prev - 3 >= pattern && prev[-3] == '\\'))); + boolean odd_backslashes; + + /* After a subexpression? */ + if (*prev == '(') + odd_backslashes = (syntax & RE_NO_BK_PARENS) == 0; + + /* After an alternative? */ + else if (*prev == '|') + odd_backslashes = (syntax & RE_NO_BK_VBAR) == 0; + + /* After a shy subexpression? */ + else if (*prev == ':' && (syntax & RE_SHY_GROUPS)) + { + /* Skip over optional regnum. */ + while (prev - 1 >= pattern && prev[-1] >= '0' && prev[-1] <= '9') + --prev; + + if (!(prev - 2 >= pattern + && prev[-1] == '?' && prev[-2] == '(')) + return false; + prev -= 2; + odd_backslashes = (syntax & RE_NO_BK_PARENS) == 0; + } + else + return false; + + /* Count the number of preceding backslashes. */ + p = prev; + while (prev - 1 >= pattern && prev[-1] == '\\') + --prev; + return (p - prev) & odd_backslashes; } ------------------------------------------------------------ revno: 108545 committer: Andreas Schwab branch nick: emacs timestamp: Sat 2012-06-09 19:03:43 +0200 message: * Makefile.in (BIG_STACK_DEPTH): Enlarge to 2200. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-06-09 14:33:44 +0000 +++ lisp/ChangeLog 2012-06-09 17:03:43 +0000 @@ -1,3 +1,7 @@ +2012-06-09 Andreas Schwab + + * Makefile.in (BIG_STACK_DEPTH): Enlarge to 2200. + 2012-06-09 Chong Yidong * ebuff-menu.el (electric-buffer-list): Preserve header line. === modified file 'lisp/Makefile.in' --- lisp/Makefile.in 2012-05-21 20:40:55 +0000 +++ lisp/Makefile.in 2012-06-09 17:03:43 +0000 @@ -86,7 +86,7 @@ # During bootstrapping the byte-compiler is run interpreted when compiling # itself, and uses more stack than usual. # -BIG_STACK_DEPTH = 1200 +BIG_STACK_DEPTH = 2200 BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))" BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) ------------------------------------------------------------ Use --include-merges or -n0 to see merged revisions.