------------------------------------------------------------ revno: 117416 committer: Glenn Morris branch nick: trunk timestamp: Thu 2014-06-26 00:34:09 -0700 message: * test/automated/package-x-test.el: Do not mess with load-path. diff: === modified file 'test/ChangeLog' --- test/ChangeLog 2014-06-26 07:32:16 +0000 +++ test/ChangeLog 2014-06-26 07:34:09 +0000 @@ -1,5 +1,7 @@ 2014-06-26 Glenn Morris + * automated/package-x-test.el: Do not mess with load-path. + * automated/Makefile.in (%.log): If error, dump log to stdout. 2014-06-26 Stefan Monnier === modified file 'test/automated/package-x-test.el' --- test/automated/package-x-test.el 2014-01-01 07:43:34 +0000 +++ test/automated/package-x-test.el 2014-06-26 07:34:09 +0000 @@ -22,27 +22,12 @@ ;;; Commentary: -;; You may want to run this from a separate Emacs instance from your -;; main one, because a bug in the code below could mess with your -;; installed packages. - -;; Run this in a clean Emacs session using: -;; -;; $ emacs -Q --batch -L . -l package-x-test.el -f ert-run-tests-batch-and-exit - ;;; Code: (require 'package-x) (require 'ert) (require 'cl-lib) -(eval-when-compile (require 'package-test)) - -;; package-test is not normally in `load-path', so temporarily set -;; `load-path' to contain the current directory. -(let ((load-path (append (list (file-name-directory (or load-file-name - buffer-file-name))) - load-path))) - (require 'package-test)) +(require 'package-test) (defvar package-x-test--single-archive-entry-1-3 (cons 'simple-single ------------------------------------------------------------ revno: 117415 committer: Glenn Morris branch nick: trunk timestamp: Thu 2014-06-26 00:32:16 -0700 message: * test/automated/Makefile.in (%.log): If error, dump log to stdout. This is mainly so we can see what is going on on hydra... diff: === modified file 'test/ChangeLog' --- test/ChangeLog 2014-06-26 06:55:15 +0000 +++ test/ChangeLog 2014-06-26 07:32:16 +0000 @@ -1,3 +1,7 @@ +2014-06-26 Glenn Morris + + * automated/Makefile.in (%.log): If error, dump log to stdout. + 2014-06-26 Stefan Monnier * automated/package-test.el (package-test-update-listing) === modified file 'test/automated/Makefile.in' --- test/automated/Makefile.in 2014-06-26 05:47:10 +0000 +++ test/automated/Makefile.in 2014-06-26 07:32:16 +0000 @@ -77,7 +77,9 @@ echo Testing $$loadfile; \ stat=OK ; \ $(emacs) -l ert -l $$loadfile \ - -f ert-run-tests-batch-and-exit >& $@ || stat=ERROR; \ + -f ert-run-tests-batch-and-exit >& $@ || { \ + stat=ERROR; \ + cat $@; }; \ echo $$stat: $@ ELFILES = $(wildcard ${srcdir}/*.el) ------------------------------------------------------------ revno: 117414 committer: Dmitry Antipov branch nick: trunk timestamp: Thu 2014-06-26 11:13:13 +0400 message: * src/fns.c (Fcompare_strings): Use FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE. * lisp/calc/calc-alg.el (math-beforep): * lisp/progmodes/cc-guess.el (c-guess-view-reorder-offsets-alist-in-style): Simplify because string-lessp can accept symbols as args. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-06-26 07:10:22 +0000 +++ lisp/ChangeLog 2014-06-26 07:13:13 +0000 @@ -1,3 +1,9 @@ +2014-06-26 Dmitry Antipov + + * calc/calc-alg.el (math-beforep): + * progmodes/cc-guess.el (c-guess-view-reorder-offsets-alist-in-style): + Simplify because string-lessp can accept symbols as args. + 2014-06-26 Daiki Ueno * emacs-lisp/package.el (package--check-signature): If === modified file 'lisp/calc/calc-alg.el' --- lisp/calc/calc-alg.el 2014-01-01 07:43:34 +0000 +++ lisp/calc/calc-alg.el 2014-06-26 07:13:13 +0000 @@ -293,7 +293,7 @@ (Math-objectp a)) ((eq (car a) 'var) (if (eq (car b) 'var) - (string-lessp (symbol-name (nth 1 a)) (symbol-name (nth 1 b))) + (string-lessp (nth 1 a) (nth 1 b)) (not (Math-numberp b)))) ((eq (car b) 'var) (Math-numberp a)) ((eq (car a) (car b)) @@ -302,7 +302,7 @@ (and b (or (null a) (math-beforep (car a) (car b))))) - (t (string-lessp (symbol-name (car a)) (symbol-name (car b)))))) + (t (string-lessp (car a) (car b))))) (defsubst math-simplify-extended (a) === modified file 'lisp/progmodes/cc-guess.el' --- lisp/progmodes/cc-guess.el 2014-03-31 19:01:59 +0000 +++ lisp/progmodes/cc-guess.el 2014-06-26 07:13:13 +0000 @@ -504,8 +504,7 @@ (cond ((or (and a-guessed? b-guessed?) (not (or a-guessed? b-guessed?))) - (string-lessp (symbol-name (car a)) - (symbol-name (car b)))) + (string-lessp (car a) (car b))) (a-guessed? t) (b-guessed? nil))))))) style) === modified file 'src/ChangeLog' --- src/ChangeLog 2014-06-26 06:55:15 +0000 +++ src/ChangeLog 2014-06-26 07:13:13 +0000 @@ -1,3 +1,7 @@ +2014-06-26 Dmitry Antipov + + * fns.c (Fcompare_strings): Use FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE. + 2014-06-25 Dmitry Antipov Consistently use validate_subarray to verify substring. === modified file 'src/fns.c' --- src/fns.c 2014-06-25 12:11:08 +0000 +++ src/fns.c 2014-06-26 07:13:13 +0000 @@ -268,21 +268,8 @@ characters, not just the bytes. */ int c1, c2; - if (STRING_MULTIBYTE (str1)) - FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c1, str1, i1, i1_byte); - else - { - c1 = SREF (str1, i1++); - MAKE_CHAR_MULTIBYTE (c1); - } - - if (STRING_MULTIBYTE (str2)) - FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c2, str2, i2, i2_byte); - else - { - c2 = SREF (str2, i2++); - MAKE_CHAR_MULTIBYTE (c2); - } + FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c1, str1, i1, i1_byte); + FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c2, str2, i2, i2_byte); if (c1 == c2) continue; ------------------------------------------------------------ revno: 117413 committer: Daiki Ueno branch nick: trunk timestamp: Thu 2014-06-26 16:10:22 +0900 message: package.el: Don't signal "no public key" error if allow-unsigned * emacs-lisp/package.el (package--check-signature): If package-check-signature is allow-unsigned, don't signal error when we can't verify signature because of missing public key (bug#17625). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-06-26 06:55:15 +0000 +++ lisp/ChangeLog 2014-06-26 07:10:22 +0000 @@ -1,3 +1,10 @@ +2014-06-26 Daiki Ueno + + * emacs-lisp/package.el (package--check-signature): If + package-check-signature is allow-unsigned, don't signal error when + we can't verify signature because of missing public key + (bug#17625). + 2014-06-26 Glenn Morris * emacs-lisp/cl-macs.el (help-add-fundoc-usage): === modified file 'lisp/emacs-lisp/package.el' --- lisp/emacs-lisp/package.el 2014-06-26 06:55:15 +0000 +++ lisp/emacs-lisp/package.el 2014-06-26 07:10:22 +0000 @@ -828,16 +828,20 @@ (buffer-string)))) (epg-context-set-home-directory context homedir) (epg-verify-string context sig-content (buffer-string)) - ;; The .sig file may contain multiple signatures. Success if one - ;; of the signatures is good. - (let ((good-signatures - (delq nil (mapcar (lambda (sig) - (if (eq (epg-signature-status sig) 'good) - sig)) - (epg-context-result-for context 'verify))))) - (if (null good-signatures) - ;; FIXME: Only signal an error if the signature is invalid, not if we - ;; simply lack the key needed to check the sig! + (let (good-signatures had-fatal-error) + ;; The .sig file may contain multiple signatures. Success if one + ;; of the signatures is good. + (dolist (sig (epg-context-result-for context 'verify)) + (if (eq (epg-signature-status sig) 'good) + (push sig good-signatures) + ;; If package-check-signature is allow-unsigned, don't + ;; signal error when we can't verify signature because of + ;; missing public key. Other errors are still treated as + ;; fatal (bug#17625). + (unless (and (eq package-check-signature 'allow-unsigned) + (eq (epg-signature-status sig) 'no-pubkey)) + (setq had-fatal-error t)))) + (if (and (null good-signatures) had-fatal-error) (error "Failed to verify signature %s: %S" sig-file (mapcar #'epg-signature-to-string ------------------------------------------------------------ revno: 117412 [merge] committer: Glenn Morris branch nick: trunk timestamp: Wed 2014-06-25 23:55:15 -0700 message: Merge from emacs-24; up to r117309 diff: === modified file 'admin/ChangeLog' --- admin/ChangeLog 2014-06-26 06:24:56 +0000 +++ admin/ChangeLog 2014-06-26 06:55:15 +0000 @@ -1,3 +1,8 @@ +2014-06-26 Eli Zaretskii + + * notes/unicode: Some notes about what to do when a new Unicode + version is imported. + 2014-06-26 Glenn Morris * authors.el: Move here from ../lisp/emacs-lisp. === modified file 'admin/authors.el' --- admin/authors.el 2014-06-26 06:24:56 +0000 +++ admin/authors.el 2014-06-26 06:55:15 +0000 @@ -622,11 +622,12 @@ "temacs.opt" "descrip.mms" "compile.com" "link.com" "compact.el" "fadr.el" "calc/calc-maint.el" + "emacs-lisp/cl-specs.el" "emacs-lisp/eieio-comp.el" "erc-hecomplete.el" "eshell/esh-maint.el" "language/persian.el" - "meese.el" "iswitchb.el" + "ledit.el" "meese.el" "iswitchb.el" "longlines.el" "mh-exec.el" "mh-init.el" "mh-customize.el" "net/zone-mode.el" "xesam.el" "term/mac-win.el" "sup-mouse.el" @@ -647,6 +648,7 @@ "dns-mode.el" "run-at-time.el" "gnus-encrypt.el" "sha1-el.el" "gnus-gl.el" "gnus.sum.el" "proto-stream.el" "color.el" "color-lab.el" "eww.el" "shr-color.el" "shr.el" "earcon.el" "gnus-audio.el" "encrypt.el" + "format-spec.el" "gnus-move.el" ;; doc "getopt.c" "texindex.c" "news.texi" "vc.texi" "vc2-xtra.texi" "back.texi" "vol1.texi" "vol2.texi" "elisp-covers.texi" "two.el" @@ -752,7 +754,11 @@ ("progmodes/octave-inf.el" . "octave.el") ("progmodes/octave-mod.el" . "octave.el") ;; Obsolete. + ("emacs-lisp/assoc.el" . "assoc.el") + ("emacs-lisp/cust-print.el" . "cust-print.el") + ("mail/mailpost.el" . "mailpost.el") ("play/bruce.el" . "bruce.el") + ("play/yow.el" . "yow.el") ("patcomp.el" . "patcomp.el") ;; From lisp to etc/forms. ("forms-d2.el" . "forms-d2.el") @@ -771,6 +777,7 @@ ("build-install" . "build-ins.in") ("build-install.in" . "build-ins.in") ("unidata/Makefile" . "unidata/Makefile.in") + ("mac/uvs.el" . "unidata/uvs.el") ;; Moved from top to etc/ ("CONTRIBUTE" . "CONTRIBUTE") ("FTP" . "FTP") === modified file 'admin/notes/unicode' --- admin/notes/unicode 2014-03-22 22:52:47 +0000 +++ admin/notes/unicode 2014-06-26 06:55:15 +0000 @@ -3,6 +3,39 @@ Copyright (C) 2002-2014 Free Software Foundation, Inc. See the end of the file for license conditions. +Importing a new Unicode Standard version into Emacs +------------------------------------------------------------- + +Emacs uses the following files from the Unicode Character Database +(a.k.a. "UCD): + + . UnicodeData.txt + . BidiMirroring.txt + . IVD_Sequences.txt + +First, these files need to be copied into admin/unidata/, and then +Emacs should be rebuilt for them to take effect. Rebuilding Emacs +updates several derived files elsewhere in the Emacs source tree, +mainly in lisp/international/. + +When Emacs is rebuilt for the first time after importing the new +files, pay attention to any warning or error messages. In particular, +admin/unidata/unidata-gen.el will complain if UnicodeData.txt defines +new bidirectional attributes of characters, because unidata-gen.el, +bidi.c and dispextern.h need to be updated in that case; failure to do +so will cause aborts in redisplay. + +Next, review the changes in UnicodeData.txt vs the previous version +used by Emacs. Any changes, be it introduction of new scripts or +addition of codepoints to existing scripts, need corresponding changes +in the data used for filling char-script-table, see characters.el +around line 1300. Other databases and settings in characters.el, such +as the data for char-width-table, might also need changes. + +Any new scripts added by UnicodeData.txt will also need updates to +script-representative-chars defined in fontset.el. Other databases in +fontset.el might also need to be updated as needed. + Problems, fixmes and other unicode-related issues ------------------------------------------------------------- === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-06-26 06:45:10 +0000 +++ lisp/ChangeLog 2014-06-26 06:55:15 +0000 @@ -1,5 +1,61 @@ 2014-06-26 Glenn Morris + * emacs-lisp/cl-macs.el (help-add-fundoc-usage): + Remove outdated declaration. + + * emacs-lisp/authors.el (authors-valid-file-names) + (authors-renamed-files-alist): Additions. + +2014-06-26 Leo Liu + + * textmodes/picture.el (picture-set-tab-stops): + * ruler-mode.el (ruler-mode-mouse-add-tab-stop) + (ruler-mode-ruler): Fix to work with nil tab-stop-list. + + * progmodes/asm-mode.el (asm-calculate-indentation): Use + indent-next-tab-stop. + + * indent.el (indent-accumulate-tab-stops): New function. + +2014-06-26 Stefan Monnier + + * emacs-lisp/package.el (package-list-unsigned): New var (bug#17625). + (package-desc-status): Obey it. + +2014-06-26 Stephen Berman + + * calendar/todo-mode.el: Fix two bugs. + (todo-insert-item--basic): If user cancels item insertion to + another category before setting priority, show original category + whether it is in the same or a different file. + (todo-set-item-priority): After selecting category, instead of + moving point to top, which extends an active region, restore it. + +2014-06-26 Stefan Monnier + + * help-fns.el (describe-function-1): Check file-name is a string before + calling help-fns--autoloaded-p (bug#17564). + +2014-06-26 Juri Linkov + + * desktop.el (desktop-auto-save-enable) + (desktop-auto-save-disable): New functions. + (desktop-save-mode, desktop-auto-save-timeout): Use them. + (desktop-read): Disable the autosave before loading the desktop, + and enable afterwards. (Bug#17351) + +2014-06-26 Stefan Monnier + + Fix some indentation problem with \; and pipes (bug#17842). + * progmodes/sh-script.el (sh-mode-syntax-table): Set syntax of ;|&. + (sh-smie--default-forward-token, sh-smie--default-backward-token): + New functions. + (sh-smie-sh-forward-token, sh-smie-sh-backward-token) + (sh-smie-rc-forward-token, sh-smie-rc-backward-token): Use them. + (sh-smie-sh-rules): Fix indentation of a pipe at BOL. + +2014-06-26 Glenn Morris + * emacs-lisp/find-func.el (find-function-C-source-directory): Use file-accessible-directory-p. @@ -12194,7 +12250,7 @@ 2013-07-07 Michael Kifer - * ediff.el (ediff-version): Version update. + * vc/ediff.el (ediff-version): Version update. (ediff-files-command, ediff3-files-command, ediff-merge-command) (ediff-merge-with-ancestor-command, ediff-directories-command) (ediff-directories3-command, ediff-merge-directories-command) @@ -12202,19 +12258,21 @@ All are command-line interfaces to ediff: to facilitate calling Emacs with the appropriate ediff functions invoked. - * viper-cmd.el (viper-del-forward-char-in-insert): New function. + * emulation/viper-cmd.el (viper-del-forward-char-in-insert): + New function. (viper-save-kill-buffer): Check if buffer is modified. - * viper.el (viper-version): Version update. + * emulation/viper.el (viper-version): Version update. (viper-emacs-state-mode-list): Add egg-status-buffer-mode. 2013-07-07 Stefan Monnier * faces.el (tty-run-terminal-initialization): Run new tty-setup-hook. - * viper-cmd.el (viper-envelop-ESC-key): Remove function. + * emulation/viper-cmd.el (viper-envelop-ESC-key): Remove function. (viper-intercept-ESC-key): Simplify. - * viper-keym.el (viper-ESC-key): Make it a constant, don't use kbd. - * viper.el (viper--tty-ESC-filter, viper--lookup-key) + * emulation/viper-keym.el (viper-ESC-key): Make it a constant, + don't use kbd. + * emulation/viper.el (viper--tty-ESC-filter, viper--lookup-key) (viper-catch-tty-ESC, viper-uncatch-tty-ESC) (viper-setup-ESC-to-escape): New functions. (viper-go-away, viper-set-hooks): Call viper-setup-ESC-to-escape. === modified file 'lisp/ChangeLog.16' --- lisp/ChangeLog.16 2014-04-20 14:45:19 +0000 +++ lisp/ChangeLog.16 2014-06-26 00:34:54 +0000 @@ -8501,7 +8501,7 @@ 2012-07-25 Jay Belanger - * calc-alg.el (math-simplify-divide): Don't cross multiply + * calc/calc-alg.el (math-simplify-divide): Don't cross multiply in an equation when the lhs is a variable. 2012-07-24 Julien Danjou === modified file 'lisp/calendar/todo-mode.el' --- lisp/calendar/todo-mode.el 2014-05-23 16:54:35 +0000 +++ lisp/calendar/todo-mode.el 2014-06-25 12:06:00 +0000 @@ -1962,13 +1962,12 @@ ;; If user cancels before setting priority, restore ;; display. (unless item-added - (if ocat - (progn - (unless (equal cat ocat) - (todo-category-number ocat) - (todo-category-select)) - (and done-only (todo-toggle-view-done-only))) - (set-window-buffer (selected-window) (set-buffer obuf))) + (set-window-buffer (selected-window) (set-buffer obuf)) + (when ocat + (unless (equal cat ocat) + (todo-category-number ocat) + (todo-category-select)) + (and done-only (todo-toggle-view-done-only))) (goto-char opoint)) ;; If the todo items section is not visible when the ;; insertion command is called (either because only done @@ -2553,9 +2552,9 @@ (goto-char (point-min)) (setq done (re-search-forward todo-done-string-start nil t)))) (let ((todo-show-with-done done)) - (todo-category-select) - ;; Keep top of category in view while setting priority. - (goto-char (point-min))))) + ;; Keep current item or top of moved to category in view + ;; while setting priority. + (save-excursion (todo-category-select))))) ;; Prompt for priority only when the category has at least one ;; todo item. (when (> maxnum 1) === modified file 'lisp/desktop.el' --- lisp/desktop.el 2014-06-06 23:38:40 +0000 +++ lisp/desktop.el 2014-06-24 23:23:41 +0000 @@ -174,11 +174,8 @@ :global t :group 'desktop (if desktop-save-mode - (when (and (integerp desktop-auto-save-timeout) - (> desktop-auto-save-timeout 0)) - (add-hook 'window-configuration-change-hook 'desktop-auto-save-set-timer)) - (remove-hook 'window-configuration-change-hook 'desktop-auto-save-set-timer) - (desktop-auto-save-cancel-timer))) + (desktop-auto-save-enable) + (desktop-auto-save-disable))) (defun desktop-save-mode-off () "Disable `desktop-save-mode'. Provided for use in hooks." @@ -219,9 +216,8 @@ (set-default symbol value) (ignore-errors (if (and (integerp value) (> value 0)) - (add-hook 'window-configuration-change-hook 'desktop-auto-save-set-timer) - (remove-hook 'window-configuration-change-hook 'desktop-auto-save-set-timer) - (desktop-auto-save-cancel-timer)))) + (desktop-auto-save-enable value) + (desktop-auto-save-disable)))) :group 'desktop :version "24.4") @@ -1132,6 +1128,10 @@ (unless desktop-dirname (message "Desktop file in use; not loaded."))) (desktop-lazy-abort) + ;; Temporarily disable the autosave that will leave it + ;; disabled when loading the desktop fails with errors, + ;; thus not overwriting the desktop with broken contents. + (desktop-auto-save-disable) ;; Evaluate desktop buffer and remember when it was modified. (load (desktop-full-file-name) t t t) (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name)))) @@ -1184,6 +1184,7 @@ (set-window-prev-buffers window nil) (set-window-next-buffers window nil)))) (setq desktop-saved-frameset nil) + (desktop-auto-save-enable) t)) ;; No desktop file found. (desktop-clear) @@ -1230,6 +1231,15 @@ ;; Auto-Saving. (defvar desktop-auto-save-timer nil) +(defun desktop-auto-save-enable (&optional timeout) + (when (and (integerp (or timeout desktop-auto-save-timeout)) + (> (or timeout desktop-auto-save-timeout) 0)) + (add-hook 'window-configuration-change-hook 'desktop-auto-save-set-timer))) + +(defun desktop-auto-save-disable () + (remove-hook 'window-configuration-change-hook 'desktop-auto-save-set-timer) + (desktop-auto-save-cancel-timer)) + (defun desktop-auto-save () "Save the desktop periodically. Called by the timer created in `desktop-auto-save-set-timer'." === modified file 'lisp/emacs-lisp/cl-macs.el' --- lisp/emacs-lisp/cl-macs.el 2014-06-05 23:08:59 +0000 +++ lisp/emacs-lisp/cl-macs.el 2014-06-26 06:55:15 +0000 @@ -382,8 +382,6 @@ (if (car res) `(progn ,(car res) ,form) form)) `(function ,func))) -(declare-function help-add-fundoc-usage "help-fns" (docstring arglist)) - (defun cl--make-usage-var (x) "X can be a var or a (destructuring) lambda-list." (cond === modified file 'lisp/emacs-lisp/package.el' --- lisp/emacs-lisp/package.el 2014-06-08 00:35:27 +0000 +++ lisp/emacs-lisp/package.el 2014-06-26 06:55:15 +0000 @@ -836,6 +836,8 @@ sig)) (epg-context-result-for context 'verify))))) (if (null good-signatures) + ;; FIXME: Only signal an error if the signature is invalid, not if we + ;; simply lack the key needed to check the sig! (error "Failed to verify signature %s: %S" sig-file (mapcar #'epg-signature-to-string @@ -1664,6 +1666,9 @@ (defvar package-list-unversioned nil "If non-nil include packages that don't have a version in `list-package'.") +(defvar package-list-unsigned nil + "If non-nil, mention in the list which packages were installed w/o signature.") + (defun package-desc-status (pkg-desc) (let* ((name (package-desc-name pkg-desc)) (dir (package-desc-dir pkg-desc)) @@ -1684,9 +1689,8 @@ (dir ;One of the installed packages. (cond ((not (file-exists-p (package-desc-dir pkg-desc))) "deleted") - ((eq pkg-desc (cadr (assq name package-alist))) (if signed - "installed" - "unsigned")) + ((eq pkg-desc (cadr (assq name package-alist))) + (if (or (not package-list-unsigned) signed) "installed" "unsigned")) (t "obsolete"))) (t (let* ((ins (cadr (assq name package-alist))) @@ -1696,9 +1700,9 @@ (if (memq name package-menu--new-package-list) "new" "available")) ((version-list-< version ins-v) "obsolete") - ((version-list-= version ins-v) (if signed - "installed" - "unsigned")))))))) + ((version-list-= version ins-v) + (if (or (not package-list-unsigned) signed) + "installed" "unsigned")))))))) (defun package-menu--refresh (&optional packages keywords) "Re-populate the `tabulated-list-entries'. === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2014-06-24 07:15:26 +0000 +++ lisp/gnus/ChangeLog 2014-06-26 06:55:15 +0000 @@ -1,3 +1,7 @@ +2014-06-26 Glenn Morris + + * mm-util.el (help-function-arglist): Remove outdated declaration. + 2014-06-24 Andreas Schwab * html2text.el (html2text-get-attr): Rewrite to handle spaces in quoted === modified file 'lisp/gnus/mm-util.el' --- lisp/gnus/mm-util.el 2014-03-23 23:13:36 +0000 +++ lisp/gnus/mm-util.el 2014-06-26 06:55:15 +0000 @@ -1374,8 +1374,6 @@ (write-region start end filename append visit lockname))) (autoload 'gmm-write-region "gmm-utils") -(declare-function help-function-arglist "help-fns" - (def &optional preserve-names)) ;; It is not a MIME function, but some MIME functions use it. (if (and (fboundp 'make-temp-file) === modified file 'lisp/help-fns.el' --- lisp/help-fns.el 2014-05-08 03:41:21 +0000 +++ lisp/help-fns.el 2014-06-26 06:55:15 +0000 @@ -483,7 +483,7 @@ (beg (if (and (or (byte-code-function-p def) (keymapp def) (memq (car-safe def) '(macro lambda closure))) - file-name + (stringp file-name) (help-fns--autoloaded-p function file-name)) (if (commandp def) "an interactive autoloaded " === modified file 'lisp/indent.el' --- lisp/indent.el 2014-06-23 23:09:20 +0000 +++ lisp/indent.el 2014-06-25 23:53:37 +0000 @@ -677,6 +677,13 @@ (if (<= column last) -1 (/ (- column last 1) step)) (1+ (/ (- column last) step))))))))) +(defun indent-accumulate-tab-stops (limit) + "Get a list of tab stops before LIMIT (inclusive)." + (let ((tab 0) (tab-stops)) + (while (<= (setq tab (indent-next-tab-stop tab)) limit) + (push tab tab-stops)) + (nreverse tab-stops))) + (defun tab-to-tab-stop () "Insert spaces or tabs to next defined tab-stop column. The variable `tab-stop-list' is a list of columns at which there are tab stops. === modified file 'lisp/progmodes/asm-mode.el' --- lisp/progmodes/asm-mode.el 2014-02-10 01:34:22 +0000 +++ lisp/progmodes/asm-mode.el 2014-06-25 23:53:37 +0000 @@ -172,7 +172,7 @@ ;; Simple `;' comments go to the comment-column. (and (looking-at "\\s<\\(\\S<\\|\\'\\)") comment-column) ;; The rest goes at the first tab stop. - (or (car tab-stop-list) tab-width))) + (or (indent-next-tab-stop 0)))) (defun asm-colon () "Insert a colon; if it follows a label, delete the label's indentation." === modified file 'lisp/progmodes/sh-script.el' --- lisp/progmodes/sh-script.el 2014-06-21 19:45:59 +0000 +++ lisp/progmodes/sh-script.el 2014-06-26 06:55:15 +0000 @@ -481,6 +481,9 @@ ?~ "_" ?, "_" ?= "." + ?\; "." + ?| "." + ?& "." ?< "." ?> ".") "The syntax table to use for Shell-Script mode. @@ -1860,6 +1863,40 @@ ((equal tok "in") (sh-smie--sh-keyword-in-p)) (t (sh-smie--keyword-p)))) +(defun sh-smie--default-forward-token () + (forward-comment (point-max)) + (buffer-substring-no-properties + (point) + (progn (if (zerop (skip-syntax-forward ".")) + (while (progn (skip-syntax-forward "w_'") + (looking-at "\\\\")) + (forward-char 2))) + (point)))) + +(defun sh-smie--default-backward-token () + (forward-comment (- (point))) + (let ((pos (point)) + (n (skip-syntax-backward "."))) + (if (or (zerop n) + (and (eq n -1) + (let ((p (point))) + (if (eq -1 (% (skip-syntax-backward "\\") 2)) + t + (goto-char p) + nil)))) + (while + (progn (skip-syntax-backward "w_'") + (or (not (zerop (skip-syntax-backward "\\"))) + (when (eq ?\\ (char-before (1- (point)))) + (let ((p (point))) + (forward-char -1) + (if (eq -1 (% (skip-syntax-backward "\\") 2)) + t + (goto-char p) + nil)))))) + (goto-char (- (point) (% (skip-syntax-backward "\\") 2)))) + (buffer-substring-no-properties (point) pos))) + (defun sh-smie-sh-forward-token () (if (and (looking-at "[ \t]*\\(?:#\\|\\(\\s|\\)\\|$\\)") (save-excursion @@ -1888,7 +1925,7 @@ tok)) (t (let* ((pos (point)) - (tok (smie-default-forward-token))) + (tok (sh-smie--default-forward-token))) (cond ((equal tok ")") "case-)") ((equal tok "(") "case-(") @@ -1932,7 +1969,7 @@ (goto-char (match-beginning 1)) (match-string-no-properties 1)) (t - (let ((tok (smie-default-backward-token))) + (let ((tok (sh-smie--default-backward-token))) (cond ((equal tok ")") "case-)") ((equal tok "(") "case-(") @@ -1962,18 +1999,18 @@ (`(:after . "case-)") (- (sh-var-value 'sh-indent-for-case-alt) (sh-var-value 'sh-indent-for-case-label))) ((and `(:before . ,_) - (guard (when sh-indent-after-continuation - (save-excursion - (ignore-errors - (skip-chars-backward " \t") - (sh-smie--looking-back-at-continuation-p)))))) - ;; After a line-continuation, make sure the rest is indented. - (let* ((sh-indent-after-continuation nil) - (indent (smie-indent-calculate)) - (initial (sh-smie--continuation-start-indent))) - (when (and (numberp indent) (numberp initial) - (<= indent initial)) - `(column . ,(+ initial sh-indentation))))) + ;; After a line-continuation, make sure the rest is indented. + (guard sh-indent-after-continuation) + (guard (save-excursion + (ignore-errors + (skip-chars-backward " \t") + (sh-smie--looking-back-at-continuation-p)))) + (let initial (sh-smie--continuation-start-indent)) + (guard (let* ((sh-indent-after-continuation nil) + (indent (smie-indent-calculate))) + (and (numberp indent) (numberp initial) + (<= indent initial))))) + `(column . ,(+ initial sh-indentation))) (`(:before . ,(or `"(" `"{" `"[")) (when (smie-rule-hanging-p) (if (not (smie-rule-prev-p "&&" "||" "|")) @@ -1997,7 +2034,12 @@ (smie-rule-bolp)))) (current-column) (smie-indent-calculate))))) - (`(:after . ,(or `"|" `"&&" `"||")) (if (smie-rule-parent-p token) nil 4)) + (`(:before . ,(or `"|" `"&&" `"||")) + (unless (smie-rule-parent-p token) + (smie-backward-sexp token) + `(column . ,(+ (funcall smie-rules-function :elem 'basic) + (smie-indent-virtual))))) + ;; Attempt at backward compatibility with the old config variables. (`(:before . "fi") (sh-var-value 'sh-indent-for-fi)) (`(:before . "done") (sh-var-value 'sh-indent-for-done)) @@ -2118,7 +2160,7 @@ ;; tok)) (t (let* ((pos (point)) - (tok (smie-default-forward-token))) + (tok (sh-smie--default-forward-token))) (cond ;; ((equal tok ")") "case-)") ((and tok (string-match "\\`[a-z]" tok) @@ -2159,7 +2201,7 @@ ;; (goto-char (match-beginning 1)) ;; (match-string-no-properties 1)) (t - (let ((tok (smie-default-backward-token))) + (let ((tok (sh-smie--default-backward-token))) (cond ;; ((equal tok ")") "case-)") ((and tok (string-match "\\`[a-z]" tok) === modified file 'lisp/ruler-mode.el' --- lisp/ruler-mode.el 2014-06-16 06:37:37 +0000 +++ lisp/ruler-mode.el 2014-06-26 06:55:15 +0000 @@ -476,8 +476,9 @@ (not (member ts tab-stop-list)) (progn (message "Tab stop set to %d" ts) - (setq tab-stop-list (sort (cons ts tab-stop-list) - #'<))))))))) + (when (null tab-stop-list) + (setq tab-stop-list (indent-accumulate-tab-stops (1- ts)))) + (setq tab-stop-list (sort (cons ts tab-stop-list) #'<))))))))) (defun ruler-mode-mouse-del-tab-stop (start-event) "Delete tab stop at the graduation where the mouse pointer is on. @@ -753,7 +754,7 @@ i (1+ i) 'help-echo ruler-mode-fill-column-help-echo ruler)) ;; Show the `tab-stop-list' markers. - ((and ruler-mode-show-tab-stops (member j tab-stop-list)) + ((and ruler-mode-show-tab-stops (= j (indent-next-tab-stop (1- j)))) (aset ruler i ruler-mode-tab-stop-char) (put-text-property i (1+ i) 'face 'ruler-mode-tab-stop === modified file 'lisp/textmodes/picture.el' --- lisp/textmodes/picture.el 2014-02-10 01:34:22 +0000 +++ lisp/textmodes/picture.el 2014-06-25 23:53:37 +0000 @@ -418,7 +418,8 @@ (save-excursion (let (tabs) (if arg - (setq tabs (default-value 'tab-stop-list)) + (setq tabs (or (default-value 'tab-stop-list) + (indent-accumulate-tab-stops (window-width)))) (let ((regexp (concat "[ \t]+[" (regexp-quote picture-tab-chars) "]"))) (beginning-of-line) (let ((bol (point))) === modified file 'lisp/url/ChangeLog' --- lisp/url/ChangeLog 2014-05-14 17:15:15 +0000 +++ lisp/url/ChangeLog 2014-06-26 06:55:15 +0000 @@ -1,3 +1,11 @@ +2014-06-26 Leo Liu + + * url-http.el (url-http-end-of-headers): Remove duplicate defvar. + + * url-handlers.el (url-http-parse-response): Remove unused autoload. + (url-insert-file-contents): Condition on url-http-response-status + for the HTTP/S specific part. (Bug#17549) + 2014-05-14 Glenn Morris * url-util.el (url-make-private-file): Use with-file-modes. === modified file 'lisp/url/url-handlers.el' --- lisp/url/url-handlers.el 2014-05-12 06:59:30 +0000 +++ lisp/url/url-handlers.el 2014-06-26 06:55:15 +0000 @@ -33,7 +33,6 @@ (autoload 'url-expand-file-name "url-expand" "Convert url to a fully specified url, and canonicalize it.") (autoload 'mm-dissect-buffer "mm-decode" "Dissect the current buffer and return a list of MIME handles.") (autoload 'url-scheme-get-property "url-methods" "Get property of a URL SCHEME.") -(autoload 'url-http-parse-response "url-http" "Parse just the response code.") ;; Always used after mm-dissect-buffer and defined in the same file. (declare-function mm-save-part-to-file "mm-decode" (handle file)) @@ -308,17 +307,21 @@ (insert data)) (list (length data) charset))) +(defvar url-http-codes) + ;;;###autoload (defun url-insert-file-contents (url &optional visit beg end replace) (let ((buffer (url-retrieve-synchronously url))) (unless buffer (signal 'file-error (list url "No Data"))) (with-current-buffer buffer - (let ((response (url-http-parse-response))) - (if (and (>= response 200) (< response 300)) - (goto-char (point-min)) - (let ((desc (buffer-substring-no-properties (1+ (point)) - (line-end-position)))) + ;; XXX: This is HTTP/S specific and should be moved to url-http + ;; instead. See http://debbugs.gnu.org/17549. + (when (bound-and-true-p url-http-response-status) + (unless (and (>= url-http-response-status 200) + (< url-http-response-status 300)) + (let ((desc (nth 2 (assq url-http-response-status url-http-codes)))) (kill-buffer buffer) + ;; Signal file-error per http://debbugs.gnu.org/16733. (signal 'file-error (list url desc)))))) (if visit (setq buffer-file-name url)) (save-excursion @@ -333,6 +336,7 @@ ;; usual heuristic/rules that we apply to files. (decode-coding-inserted-region start (point) url visit beg end replace)) (list url (car size-and-charset)))))) + (put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents) (defun url-file-name-completion (url directory &optional predicate) === modified file 'lisp/url/url-http.el' --- lisp/url/url-http.el 2014-03-29 00:55:44 +0000 +++ lisp/url/url-http.el 2014-06-26 06:55:15 +0000 @@ -48,7 +48,6 @@ (defvar url-http-response-version) (defvar url-http-target-url) (defvar url-http-transfer-encoding) -(defvar url-http-end-of-headers) (defvar url-show-status) (require 'url-gw) === modified file 'test/ChangeLog' --- test/ChangeLog 2014-06-26 06:02:52 +0000 +++ test/ChangeLog 2014-06-26 06:55:15 +0000 @@ -1,3 +1,9 @@ +2014-06-26 Stefan Monnier + + * automated/package-test.el (package-test-update-listing) + (package-test-update-archives, package-test-describe-package): + Adjust tests according to new package-list-unsigned. + 2014-06-26 Glenn Morris * automated/ert-tests.el (no-byte-compile): Set it. (Bug#17851) === modified file 'test/automated/package-test.el' --- test/automated/package-test.el 2014-05-26 16:52:28 +0000 +++ test/automated/package-test.el 2014-06-26 06:55:15 +0000 @@ -265,7 +265,7 @@ (should (package-installed-p 'simple-single)) (switch-to-buffer "*Packages*") (goto-char (point-min)) - (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+unsigned" nil t)) + (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t)) (goto-char (point-min)) (should-not (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+\\(available\\|new\\)" nil t)) (kill-buffer buf)))) @@ -287,7 +287,7 @@ ;; New version should be available and old version should be installed (goto-char (point-min)) (should (re-search-forward "^\\s-+simple-single\\s-+1.4\\s-+new" nil t)) - (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+unsigned" nil t)) + (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t)) (goto-char (point-min)) (should (re-search-forward "^\\s-+new-pkg\\s-+1.0\\s-+\\(available\\|new\\)" nil t)) @@ -318,7 +318,7 @@ (with-fake-help-buffer (describe-package 'simple-single) (goto-char (point-min)) - (should (search-forward "simple-single is an unsigned package." nil t)) + (should (search-forward "simple-single is an installed package." nil t)) (should (search-forward (format "Status: Installed in `%s/' (unsigned)." (expand-file-name "simple-single-1.3" package-user-dir)) === modified file 'test/indent/shell.sh' --- test/indent/shell.sh 2014-06-20 14:23:30 +0000 +++ test/indent/shell.sh 2014-06-24 20:16:10 +0000 @@ -41,6 +41,13 @@ } done +filter_3 () # bug#17842 +{ + tr -d '"`' | tr ' ' ' ' | \ + awk -F\; -f filter.awk | \ + grep -v "^," | sort -t, -k2,2 +} + echo -n $(( 5 << 2 )) # This should not be treated as a heredoc (bug#12770). 2 ------------------------------------------------------------ revno: 117411 committer: Glenn Morris branch nick: trunk timestamp: Wed 2014-06-25 23:45:10 -0700 message: * find-func.el (find-function-C-source-directory): Use file-accessible-directory-p diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-06-26 06:35:38 +0000 +++ lisp/ChangeLog 2014-06-26 06:45:10 +0000 @@ -1,5 +1,8 @@ 2014-06-26 Glenn Morris + * emacs-lisp/find-func.el (find-function-C-source-directory): + Use file-accessible-directory-p. + * ps-samp.el: Make it slightly less awful. (ps-rmail-mode-hook, ps-gnus-article-prepare-hook, ps-vm-mode-hook): (ps-gnus-summary-setup, ps-info-mode-hook): Use [print] key. === modified file 'lisp/emacs-lisp/find-func.el' --- lisp/emacs-lisp/find-func.el 2014-02-02 02:25:05 +0000 +++ lisp/emacs-lisp/find-func.el 2014-06-26 06:45:10 +0000 @@ -178,8 +178,7 @@ (defvar find-function-C-source-directory (let ((dir (expand-file-name "src" source-directory))) - (when (and (file-directory-p dir) (file-readable-p dir)) - dir)) + (if (file-accessible-directory-p dir) dir)) "Directory where the C source files of Emacs can be found. If nil, do not try to find the source code of functions and variables defined in C.") ------------------------------------------------------------ revno: 117410 committer: Glenn Morris branch nick: trunk timestamp: Wed 2014-06-25 23:35:38 -0700 message: ps-samp.el: Make it slightly less awful * lisp/ps-samp.el (ps-rmail-mode-hook, ps-gnus-article-prepare-hook) (ps-vm-mode-hook, ps-gnus-summary-setup, ps-info-mode-hook): Use [print] key. Only set local values. (ps-article-subject, ps-article-author): Use standard functions like mail-fetch-field. (ps-info-file, ps-info-node): Use match-string. (ps-jts-ps-setup, ps-jack-setup): Remove, merging into... (ps-samp-ps-setup): ... new function. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-06-26 06:28:04 +0000 +++ lisp/ChangeLog 2014-06-26 06:35:38 +0000 @@ -1,5 +1,15 @@ 2014-06-26 Glenn Morris + * ps-samp.el: Make it slightly less awful. + (ps-rmail-mode-hook, ps-gnus-article-prepare-hook, ps-vm-mode-hook): + (ps-gnus-summary-setup, ps-info-mode-hook): Use [print] key. + Only set local values. + (ps-article-subject, ps-article-author): Use standard functions + like mail-fetch-field. + (ps-info-file, ps-info-node): Use match-string. + (ps-jts-ps-setup, ps-jack-setup): Remove, merging into... + (ps-samp-ps-setup): ... new function. + * progmodes/idlw-shell.el (idlwave-shell-make-temp-file): Optimize away code unneeded on any modern Emacs. === modified file 'lisp/ps-samp.el' --- lisp/ps-samp.el 2014-01-01 07:43:34 +0000 +++ lisp/ps-samp.el 2014-06-26 06:35:38 +0000 @@ -29,18 +29,7 @@ ;;; Commentary: -;; See ps-print.el for documentation. - -;;; Code: - - -(require 'ps-print) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Sample Setup Code: - - +;; Some example hacks for ps-print.el. ;; This stuff is for anybody that's brave enough to look this far, ;; and able to figure out how to use it. It isn't really part of ;; ps-print, but I'll leave it here in hopes it might be useful: @@ -48,20 +37,23 @@ ;; WARNING!!! The following code is *sample* code only. ;; Don't use it unless you understand what it does! -;; The key `f22' should probably be replaced by `print'. --Stef - -;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the -;; `ps-left-headers' specially for mail messages. +;;; Code: + +(require 'ps-print) + + + +;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set +;; `ps-left-header' specially for mail messages. (defun ps-rmail-mode-hook () - (local-set-key [(f22)] 'ps-rmail-print-message-from-summary) - (setq ps-header-lines 3 - ps-left-header - ;; The left headers will display the message's subject, its - ;; author, and the name of the folder it was in. - '(ps-article-subject ps-article-author buffer-name))) + (local-set-key [print] 'ps-rmail-print-message-from-summary) + (setq-local ps-header-lines 3) + ;; The left header will display the message's subject, its + ;; author, and the name of the folder it was in. + (setq-local ps-left-header + '(ps-article-subject ps-article-author buffer-name))) -;; See `ps-gnus-print-article-from-summary'. This function does the -;; same thing for rmail. +;; Like `ps-gnus-print-article-from-summary', but for rmail. (defun ps-rmail-print-message-from-summary () (interactive) (ps-print-message-from-summary 'rmail-summary-buffer "RMAIL")) @@ -76,61 +68,57 @@ (with-current-buffer ps-buf (ps-spool-buffer-with-faces))))) -;; Look in an article or mail message for the Subject: line. To be -;; placed in `ps-left-headers'. +;; Look in an article or mail message for the Subject: line. (defun ps-article-subject () (save-excursion - (goto-char (point-min)) - (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t) - (buffer-substring (match-beginning 1) (match-end 1)) - "Subject ???"))) + (save-restriction + (narrow-to-region (point-min) (progn (rfc822-goto-eoh) (point))) + (concat "Subject: " (or (mail-fetch-field "Subject") "???"))))) ;; Look in an article or mail message for the From: line. Sorta-kinda ;; understands RFC-822 addresses and can pull the real name out where -;; it's provided. To be placed in `ps-left-headers'. +;; it's provided. (defun ps-article-author () (save-excursion - (goto-char (point-min)) - (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t) - (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1)))) - (cond - - ;; Try first to match addresses that look like - ;; thompson@wg2.waii.com (Jim Thompson) - ((string-match ".*[ \t]+(\\(.*\\))" fromstring) - (substring fromstring (match-beginning 1) (match-end 1))) - - ;; Next try to match addresses that look like - ;; Jim Thompson or - ;; "Jim Thompson" - ((string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring) - (substring fromstring (match-beginning 2) (match-end 2))) - - ;; Couldn't find a real name -- show the address instead. - (t fromstring))) - "From ???"))) - -;; A hook to bind to `gnus-article-prepare-hook'. This will set the -;; `ps-left-headers' specially for gnus articles. Unfortunately, + (save-restriction + (narrow-to-region (point-min) (progn (rfc822-goto-eoh) (point))) + (let ((fromstring (mail-fetch-field "From"))) + (cond + ;; Try first to match addresses that look like + ;; thompson@wg2.waii.com (Jim Thompson) + ((and fromstring (string-match ".*[ \t]+(\\(.*\\))" fromstring)) + (match-string 1 fromstring)) + ;; Next try to match addresses that look like + ;; Jim Thompson or + ;; "Jim Thompson" + ((and fromstring + (string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring)) + (match-string 2 fromstring)) + ;; Couldn't find a real name -- show the address instead. + (fromstring) + (t "From ???")))))) + +;; A hook to bind to `gnus-article-prepare-hook'. This will set +;; `ps-left-header' specially for gnus articles. Unfortunately, ;; `gnus-article-mode-hook' is called only once, the first time the *Article* ;; buffer enters that mode, so it would only work for the first time ;; we ran gnus. The second time, this hook wouldn't get set up. The ;; only alternative is `gnus-article-prepare-hook'. (defun ps-gnus-article-prepare-hook () - (setq ps-header-lines 3 - ps-left-header - ;; The left headers will display the article's subject, its - ;; author, and the newsgroup it was in. - '(ps-article-subject ps-article-author gnus-newsgroup-name))) + (setq-local ps-header-lines 3) + ;; The left headers will display the article's subject, its + ;; author, and the newsgroup it was in. + (setq-local ps-left-header + '(ps-article-subject ps-article-author gnus-newsgroup-name))) -;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the -;; `ps-left-headers' specially for mail messages. +;; A hook to bind to `vm-mode-hook' to locally bind prsc and set +;; `ps-left-header' specially for mail messages. (defun ps-vm-mode-hook () - (local-set-key [(f22)] 'ps-vm-print-message-from-summary) - (setq ps-header-lines 3 - ps-left-header - ;; The left headers will display the message's subject, its - ;; author, and the name of the folder it was in. + (local-set-key [print] 'ps-vm-print-message-from-summary) + (setq-local ps-header-lines 3) + ;; The left headers will display the message's subject, its + ;; author, and the name of the folder it was in. + (setq-local ps-left-header '(ps-article-subject ps-article-author buffer-name))) ;; Every now and then I forget to switch from the *Summary* buffer to @@ -138,55 +126,43 @@ ;; article subjects shows up at the printer. This function, bound to ;; prsc for the gnus *Summary* buffer means I don't have to switch ;; buffers first. -;; sb: Updated for Gnus 5. (defun ps-gnus-print-article-from-summary () (interactive) (ps-print-message-from-summary 'gnus-article-buffer "*Article*")) -;; See `ps-gnus-print-article-from-summary'. This function does the -;; same thing for vm. +;; Like `ps-gnus-print-article-from-summary', but for vm. (defun ps-vm-print-message-from-summary () (interactive) (ps-print-message-from-summary 'vm-mail-buffer "")) -;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind -;; prsc. +;; A hook to bind to `gnus-summary-setup-buffer' to locally bind prsc. (defun ps-gnus-summary-setup () - (local-set-key [(f22)] 'ps-gnus-print-article-from-summary)) + (local-set-key [print] 'ps-gnus-print-article-from-summary)) -;; Look in an article or mail message for the Subject: line. To be -;; placed in `ps-left-headers'. (defun ps-info-file () (save-excursion (goto-char (point-min)) (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t) - (buffer-substring (match-beginning 1) (match-end 1)) + (match-string 1) "File ???"))) -;; Look in an article or mail message for the Subject: line. To be -;; placed in `ps-left-headers'. (defun ps-info-node () (save-excursion (goto-char (point-min)) (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t) - (buffer-substring (match-beginning 1) (match-end 1)) + (match-string 1) "Node ???"))) (defun ps-info-mode-hook () - (setq ps-left-header - ;; The left headers will display the node name and file name. - '(ps-info-node ps-info-file))) - -;; WARNING! The following function is a *sample* only, and is *not* -;; meant to be used as a whole unless you understand what the effects -;; will be! (In fact, this is a copy of Jim's setup for ps-print -- -;; I'd be very surprised if it was useful to *anybody*, without -;; modification.) - -(defun ps-jts-ps-setup () - (global-set-key [(f22)] 'ps-spool-buffer-with-faces) ;f22 is prsc - (global-set-key [(shift f22)] 'ps-spool-region-with-faces) - (global-set-key [(control f22)] 'ps-despool) + ;; The left headers will display the node name and file name. + (setq-local ps-left-header '(ps-info-node ps-info-file))) + +;; WARNING! The following function is a *sample* only, and is *not* meant +;; to be used as a whole unless you understand what the effects will be! +(defun ps-samp-ps-setup () + (global-set-key [print] 'ps-spool-buffer-with-faces) + (global-set-key [S-print] 'ps-spool-region-with-faces) + (global-set-key [C-print] 'ps-despool) (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook) (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup) (add-hook 'vm-mode-hook 'ps-vm-mode-hook) @@ -195,24 +171,10 @@ (setq ps-spool-duplex t ps-print-color-p nil ps-lpr-command "lpr" - ps-lpr-switches '("-Jjct,duplex_long")) - 'ps-jts-ps-setup) - -;; WARNING! The following function is a *sample* only, and is *not* -;; meant to be used as a whole unless it corresponds to your needs. -;; (In fact, this is a copy of Jack's setup for ps-print -- -;; I would not be that surprised if it was useful to *anybody*, -;; without modification.) - -(defun ps-jack-setup () - (setq ps-print-color-p nil - ps-lpr-command "lpr" - ps-lpr-switches nil - + ps-lpr-switches '("-Jjct,duplex_long") ps-paper-type 'a4 ps-landscape-mode t ps-number-of-columns 2 - ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm @@ -225,13 +187,11 @@ ps-header-lines 2 ps-show-n-of-n t ps-spool-duplex nil - ps-font-family 'Courier ps-font-size 5.5 ps-header-font-family 'Helvetica ps-header-font-size 6 - ps-header-title-font-size 8) - 'ps-jack-setup) + ps-header-title-font-size 8)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ------------------------------------------------------------ revno: 117409 committer: Glenn Morris branch nick: trunk timestamp: Wed 2014-06-25 23:28:04 -0700 message: * lisp/progmodes/idlw-shell.el (idlwave-shell-make-temp-file): Optimize away code unneeded on any modern Emacs. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-06-26 06:24:56 +0000 +++ lisp/ChangeLog 2014-06-26 06:28:04 +0000 @@ -1,5 +1,8 @@ 2014-06-26 Glenn Morris + * progmodes/idlw-shell.el (idlwave-shell-make-temp-file): + Optimize away code unneeded on any modern Emacs. + * emacs-lisp/authors.el: Move to ../admin. * emacs-lisp/ert.el (ert-summarize-tests-batch-and-exit): New. === modified file 'lisp/progmodes/idlw-shell.el' --- lisp/progmodes/idlw-shell.el 2014-01-06 23:34:05 +0000 +++ lisp/progmodes/idlw-shell.el 2014-06-26 06:28:04 +0000 @@ -590,27 +590,28 @@ (defun idlwave-shell-make-temp-file (prefix) "Create a temporary file." - ; Hard coded make-temp-file for Emacs<21 - (if (fboundp 'make-temp-file) + (if (featurep 'emacs) (make-temp-file prefix) - (let (file - (temp-file-dir (if (boundp 'temporary-file-directory) - temporary-file-directory - "/tmp"))) - (while (condition-case () - (progn - (setq file - (make-temp-name - (expand-file-name prefix temp-file-dir))) - (if (featurep 'xemacs) - (write-region "" nil file nil 'silent nil) - (write-region "" nil file nil 'silent nil 'excl)) - nil) - (file-already-exists t)) - ;; the file was somehow created by someone else between - ;; `make-temp-name' and `write-region', let's try again. - nil) - file))) + (if (fboundp 'make-temp-file) + (make-temp-file prefix) + (let (file + (temp-file-dir (if (boundp 'temporary-file-directory) + temporary-file-directory + "/tmp"))) + (while (condition-case () + (progn + (setq file + (make-temp-name + (expand-file-name prefix temp-file-dir))) + (if (featurep 'xemacs) + (write-region "" nil file nil 'silent nil) + (write-region "" nil file nil 'silent nil 'excl)) + nil) + (file-already-exists t)) + ;; the file was somehow created by someone else between + ;; `make-temp-name' and `write-region', let's try again. + nil) + file)))) (defvar idlwave-shell-dirstack-query "cd,current=___cur & print,___cur" ------------------------------------------------------------ revno: 117408 committer: Glenn Morris branch nick: trunk timestamp: Wed 2014-06-25 23:24:56 -0700 message: Move lisp/emacs-lisp/authors.el to admin/ It is not useful for anything other than maintaining Emacs. diff: === modified file 'admin/ChangeLog' --- admin/ChangeLog 2014-06-25 06:23:04 +0000 +++ admin/ChangeLog 2014-06-26 06:24:56 +0000 @@ -1,3 +1,7 @@ +2014-06-26 Glenn Morris + + * authors.el: Move here from ../lisp/emacs-lisp. + 2014-06-25 Glenn Morris * grammars/Makefile.in (${bovinedir}/c-by.el, ${bovinedir}/make-by.el): === renamed file 'lisp/emacs-lisp/authors.el' => 'admin/authors.el' === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-06-26 05:47:10 +0000 +++ lisp/ChangeLog 2014-06-26 06:24:56 +0000 @@ -1,5 +1,7 @@ 2014-06-26 Glenn Morris + * emacs-lisp/authors.el: Move to ../admin. + * emacs-lisp/ert.el (ert-summarize-tests-batch-and-exit): New. 2014-06-25 Glenn Morris ------------------------------------------------------------ revno: 117407 committer: Glenn Morris branch nick: trunk timestamp: Wed 2014-06-25 23:21:55 -0700 message: * etc/NEWS: Maybe ert-summarize-tests-batch-and-exit worth mentioning. diff: === modified file 'etc/NEWS' --- etc/NEWS 2014-06-24 07:55:36 +0000 +++ etc/NEWS 2014-06-26 06:21:55 +0000 @@ -96,6 +96,8 @@ *** Calendar can list and mark diary entries with Chinese dates. See `diary-chinese-list-entries' and `diary-chinese-mark-entries'. +** New ERT function `ert-summarize-tests-batch-and-exit'. + --- ** The Rmail commands d, C-d and u now handle repeat counts to delete or undelete multiple messages. ------------------------------------------------------------ revno: 117406 committer: Glenn Morris branch nick: trunk timestamp: Wed 2014-06-25 23:18:53 -0700 message: lib-src/Makefile trivial simplifications * lib-src/Makefile.in (blessmail): Depend on lisp/mail/blessmail.el. Use $<, $@. (regex.o, etags${EXEEXT}, ctags${EXEEXT}, ebrowse${EXEEXT}) (profile${EXEEXT}, make-docfile${EXEEXT}, movemail${EXEEXT}) (pop.o, emacsclient${EXEEXT}, emacsclientw${EXEEXT}, ntlib.o) (hexl${EXEEXT}, update-game-score${EXEEXT}, emacsclient.res): Use $<. (ctags${EXEEXT}): Add $srcdir to dependency rather than using VPATH. diff: === modified file 'lib-src/ChangeLog' --- lib-src/ChangeLog 2014-06-17 16:09:19 +0000 +++ lib-src/ChangeLog 2014-06-26 06:18:53 +0000 @@ -1,3 +1,13 @@ +2014-06-26 Glenn Morris + + * Makefile.in (blessmail): Depend on lisp/mail/blessmail.el. + Use $<, $@. + (regex.o, etags${EXEEXT}, ctags${EXEEXT}, ebrowse${EXEEXT}) + (profile${EXEEXT}, make-docfile${EXEEXT}, movemail${EXEEXT}) + (pop.o, emacsclient${EXEEXT}, emacsclientw${EXEEXT}, ntlib.o) + (hexl${EXEEXT}, update-game-score${EXEEXT}, emacsclient.res): Use $<. + (ctags${EXEEXT}): Add $srcdir to dependency rather than using VPATH. + 2014-06-17 Paul Eggert Omit redundant extern decls. === modified file 'lib-src/Makefile.in' --- lib-src/Makefile.in 2014-06-15 22:42:31 +0000 +++ lib-src/Makefile.in 2014-06-26 06:18:53 +0000 @@ -1,7 +1,7 @@ ### @configure_input@ -# Copyright (C) 1985, 1987-1988, 1993-1994, 2001-2014 Free Software -# Foundation, Inc. +# Copyright (C) 1985, 1987-1988, 1993-1994, 2001-2014 +# Free Software Foundation, Inc. # This file is part of GNU Emacs. @@ -211,9 +211,9 @@ ## Only used if we need blessmail, but no harm in always defining. ## This makes the actual blessmail executable. -blessmail: - $(EMACS) $(EMACSOPT) -l $(srcdir)/../lisp/mail/blessmail.el - chmod +x blessmail +blessmail: $(srcdir)/../lisp/mail/blessmail.el + $(EMACS) $(EMACSOPT) -l $< + chmod +x $@ ## This checks if we need to run blessmail. ## Do not charge ahead and do it! Let the installer decide. @@ -311,7 +311,7 @@ $(MAKE) -C ../lib libgnu.a regex.o: $(srcdir)/../src/regex.c $(srcdir)/../src/regex.h $(config_h) - ${CC} -c ${CPP_CFLAGS} ${srcdir}/../src/regex.c + ${CC} -c ${CPP_CFLAGS} $< etags_deps = ${srcdir}/etags.c regex.o $(NTLIB) $(config_h) @@ -319,42 +319,41 @@ etags_libs = regex.o $(LOADLIBES) $(NTLIB) etags${EXEEXT}: ${etags_deps} - $(CC) ${ALL_CFLAGS} $(etags_cflags) $(srcdir)/etags.c $(etags_libs) + $(CC) ${ALL_CFLAGS} $(etags_cflags) $< $(etags_libs) ## ctags.c is distinct from etags.c so that parallel makes do not write two ## etags.o files on top of each other. ## FIXME? ## Can't we use a wrapper that calls 'etags --ctags'? -ctags${EXEEXT}: ctags.c ${etags_deps} - $(CC) ${ALL_CFLAGS} $(etags_cflags) $(srcdir)/ctags.c $(etags_libs) +ctags${EXEEXT}: ${srcdir}/ctags.c ${etags_deps} + $(CC) ${ALL_CFLAGS} $(etags_cflags) $< $(etags_libs) ebrowse${EXEEXT}: ${srcdir}/ebrowse.c ${srcdir}/../lib/min-max.h $(NTLIB) \ $(config_h) $(CC) ${ALL_CFLAGS} -DVERSION="\"${version}\"" \ - ${srcdir}/ebrowse.c $(LOADLIBES) $(NTLIB) -o $@ + $< $(LOADLIBES) $(NTLIB) -o $@ profile${EXEEXT}: ${srcdir}/profile.c $(NTLIB) $(config_h) - $(CC) ${ALL_CFLAGS} ${srcdir}/profile.c \ + $(CC) ${ALL_CFLAGS} $< \ $(LOADLIBES) $(NTLIB) $(LIB_CLOCK_GETTIME) -o $@ make-docfile${EXEEXT}: ${srcdir}/make-docfile.c $(NTLIB) $(config_h) - $(CC) ${ALL_CFLAGS} ${srcdir}/make-docfile.c $(LOADLIBES) $(NTLIB) \ - -o $@ + $(CC) ${ALL_CFLAGS} $< $(LOADLIBES) $(NTLIB) -o $@ movemail${EXEEXT}: ${srcdir}/movemail.c pop.o $(NTLIB) $(config_h) - $(CC) ${ALL_CFLAGS} ${MOVE_FLAGS} ${srcdir}/movemail.c pop.o \ + $(CC) ${ALL_CFLAGS} ${MOVE_FLAGS} $< pop.o \ $(LOADLIBES) $(NTLIB) $(LIBS_MOVE) -o $@ pop.o: ${srcdir}/pop.c ${srcdir}/pop.h ${srcdir}/../lib/min-max.h $(config_h) - $(CC) -c ${CPP_CFLAGS} ${MOVE_FLAGS} ${srcdir}/pop.c + $(CC) -c ${CPP_CFLAGS} ${MOVE_FLAGS} $< emacsclient${EXEEXT}: ${srcdir}/emacsclient.c $(NTLIB) $(config_h) - $(CC) ${ALL_CFLAGS} ${srcdir}/emacsclient.c \ + $(CC) ${ALL_CFLAGS} $< \ -DVERSION="\"${version}\"" $(NTLIB) $(LOADLIBES) $(LIB_FDATASYNC) \ $(LIB_WSOCK32) $(LIBS_ECLIENT) -o $@ emacsclientw${EXEEXT}: ${srcdir}/emacsclient.c $(NTLIB) $(CLIENTRES) $(config_h) - $(CC) ${ALL_CFLAGS} $(CLIENTRES) -mwindows ${srcdir}/emacsclient.c \ + $(CC) ${ALL_CFLAGS} $(CLIENTRES) -mwindows $< \ -DVERSION="\"${version}\"" $(LOADLIBES) $(LIB_FDATASYNC) \ $(LIB_WSOCK32) $(LIBS_ECLIENT) -o $@ @@ -366,18 +365,16 @@ # The dependency on $(NTDEPS) is a trick intended to cause recompile of # programs on MinGW whenever some private header in nt/inc is modified. ntlib.o: ${srcdir}/ntlib.c ${srcdir}/ntlib.h $(NTDEPS) - $(CC) -c ${CPP_CFLAGS} ${srcdir}/ntlib.c + $(CC) -c ${CPP_CFLAGS} $< hexl${EXEEXT}: ${srcdir}/hexl.c $(NTLIB) $(config_h) - $(CC) ${ALL_CFLAGS} ${srcdir}/hexl.c $(LOADLIBES) -o $@ + $(CC) ${ALL_CFLAGS} $< $(LOADLIBES) -o $@ update-game-score${EXEEXT}: ${srcdir}/update-game-score.c $(NTLIB) $(config_h) $(CC) ${ALL_CFLAGS} -DHAVE_SHARED_GAME_DIR="\"$(gamedir)\"" \ - ${srcdir}/update-game-score.c $(LOADLIBES) $(NTLIB) \ - -o $@ + $< $(LOADLIBES) $(NTLIB) -o $@ emacsclient.res: $(NTINC)/../emacsclient.rc - $(WINDRES) -O coff --include-dir=$(NTINC)/.. -o $@ \ - $(NTINC)/../emacsclient.rc + $(WINDRES) -O coff --include-dir=$(NTINC)/.. -o $@ $< ## Makefile ends here. ------------------------------------------------------------ revno: 117405 fixes bugs: http://debbugs.gnu.org/17851 http://debbugs.gnu.org/17852 committer: Glenn Morris branch nick: trunk timestamp: Wed 2014-06-25 23:02:52 -0700 message: Disable byte-compilation in two test/automated files * test/automated/eieio-tests.el (no-byte-compile): Set it. * test/automated/ert-tests.el (no-byte-compile): Set it. diff: === modified file 'test/ChangeLog' --- test/ChangeLog 2014-06-26 05:47:10 +0000 +++ test/ChangeLog 2014-06-26 06:02:52 +0000 @@ -1,5 +1,9 @@ 2014-06-26 Glenn Morris + * automated/ert-tests.el (no-byte-compile): Set it. (Bug#17851) + + * automated/eieio-tests.el (no-byte-compile): Set it. (Bug#17852) + * automated/Makefile.in: Simplify and parallelize. (Bug#15991) (XARGS_LIMIT, BYTE_COMPILE_EXTRA_FLAGS) (setwins, compile-targets, compile-main, compile-clean): Remove. === modified file 'test/automated/eieio-tests.el' --- test/automated/eieio-tests.el 2014-01-01 07:43:34 +0000 +++ test/automated/eieio-tests.el 2014-06-26 06:02:52 +0000 @@ -1,7 +1,6 @@ ;;; eieio-tests.el -- eieio tests routines -;; Copyright (C) 1999-2003, 2005-2010, 2012-2014 Free Software -;; Foundation, Inc. +;; Copyright (C) 1999-2003, 2005-2010, 2012-2014 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam @@ -888,3 +887,7 @@ (provide 'eieio-tests) ;;; eieio-tests.el ends here + +;; Local Variables: +;; no-byte-compile: t +;; End: === modified file 'test/automated/ert-tests.el' --- test/automated/ert-tests.el 2014-01-13 10:53:36 +0000 +++ test/automated/ert-tests.el 2014-06-26 06:02:52 +0000 @@ -831,3 +831,7 @@ (provide 'ert-tests) ;;; ert-tests.el ends here + +;; Local Variables: +;; no-byte-compile: t +;; End: ------------------------------------------------------------ revno: 117404 fixes bug: http://debbugs.gnu.org/15991 committer: Glenn Morris branch nick: trunk timestamp: Wed 2014-06-25 22:47:10 -0700 message: Simplify and parallize test/automated Makefile * Makefile.in (mostlyclean, clean): Maybe clean test/automated. * lisp/emacs-lisp/ert.el (ert-summarize-tests-batch-and-exit): New. * test/automated/Makefile.in: Simplify and parallelize. (XARGS_LIMIT, BYTE_COMPILE_EXTRA_FLAGS) (setwins, compile-targets, compile-main, compile-clean): Remove. (GREP_OPTIONS): Unexport. (.el.elc): Replace with pattern rule. (%.elc, %.log): New pattern rules. (ELFILES, LOGFILES): New variables. (check): Depend on LOGFILES. Call ert-summarize-tests-batch-and-exit. (clean, mostlyclean): New rules. (bootstrap-clean): Simplify. (bootstrap-clean, distclean): Depend on clean. * .bzrignore: Ignore test/automated/*.log. diff: === modified file '.bzrignore' --- .bzrignore 2014-06-10 01:44:11 +0000 +++ .bzrignore 2014-06-26 05:47:10 +0000 @@ -227,3 +227,4 @@ admin/charsets/eucjp-ms.el admin/charsets/jisx2131-filter test/automated/flymake/warnpred/a.out +test/automated/*.log === modified file 'ChangeLog' --- ChangeLog 2014-06-21 19:45:59 +0000 +++ ChangeLog 2014-06-26 05:47:10 +0000 @@ -1,3 +1,7 @@ +2014-06-26 Glenn Morris + + * Makefile.in (mostlyclean, clean): Maybe clean test/automated. + 2014-06-21 Paul Eggert * configure.ac: Warn about --enable-link-time-optimization's issues === modified file 'Makefile.in' --- Makefile.in 2014-06-20 16:05:10 +0000 +++ Makefile.in 2014-06-26 05:47:10 +0000 @@ -798,7 +798,9 @@ $(foreach dir,$(mostlyclean_dirs),$(eval $(call submake_template,$(dir),mostlyclean))) mostlyclean: $(mostlyclean_dirs:=_mostlyclean) - + for dir in test/automated; do \ + [ ! -d $$dir ] || $(MAKE) -C $$dir mostlyclean; \ + done ### `clean' ### Delete all files from the current directory that are normally @@ -813,6 +815,9 @@ $(foreach dir,$(clean_dirs),$(eval $(call submake_template,$(dir),clean))) clean: $(clean_dirs:=_clean) + for dir in test/automated; do \ + [ ! -d $$dir ] || $(MAKE) -C $$dir clean; \ + done -rm -f etc/emacs.tmpdesktop ### `bootclean' === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-06-25 23:51:10 +0000 +++ lisp/ChangeLog 2014-06-26 05:47:10 +0000 @@ -1,3 +1,7 @@ +2014-06-26 Glenn Morris + + * emacs-lisp/ert.el (ert-summarize-tests-batch-and-exit): New. + 2014-06-25 Glenn Morris * Makefile.in ($(lisp)/progmodes/cc-defs.elc) === modified file 'lisp/emacs-lisp/ert.el' --- lisp/emacs-lisp/ert.el 2014-06-22 05:43:58 +0000 +++ lisp/emacs-lisp/ert.el 2014-06-26 05:47:10 +0000 @@ -1463,6 +1463,65 @@ (kill-emacs 2)))) +(defun ert-summarize-tests-batch-and-exit () + "Summarize the results of testing. +Expects to be called in batch mode, with logfiles as command-line arguments. +The logfiles should have the `ert-run-tests-batch' format. When finished, +this exits Emacs, with status as per `ert-run-tests-batch-and-exit'." + (or noninteractive + (user-error "This function is only for use in batch mode")) + (let ((nlogs (length command-line-args-left)) + (ntests 0) (nrun 0) (nexpected 0) (nunexpected 0) (nskipped 0) + nnotrun logfile notests badtests unexpected) + (with-temp-buffer + (while (setq logfile (pop command-line-args-left)) + (erase-buffer) + (insert-file-contents logfile) + (if (not (re-search-forward "^Running \\([0-9]+\\) tests" nil t)) + (push logfile notests) + (setq ntests (+ ntests (string-to-number (match-string 1)))) + (if (not (re-search-forward "^\\(Aborted: \\)?\ +Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\ +\\(?:, \\([0-9]+\\) unexpected\\)?\ +\\(?:, \\([0-9]+\\) skipped\\)?" nil t)) + (push logfile badtests) + (if (match-string 1) (push logfile badtests)) + (setq nrun (+ nrun (string-to-number (match-string 2))) + nexpected (+ nexpected (string-to-number (match-string 3)))) + (when (match-string 4) + (push logfile unexpected) + (setq nunexpected (+ nunexpected + (string-to-number (match-string 4))))) + (if (match-string 5) + (setq nskipped (+ nskipped + (string-to-number (match-string 5))))))))) + (setq nnotrun (- ntests nrun)) + (message "\nSUMMARY OF TEST RESULTS") + (message "-----------------------") + (message "Files examined: %d" nlogs) + (message "Ran %d tests%s, %d results as expected%s%s" + nrun + (if (zerop nnotrun) "" (format ", %d failed to run" nnotrun)) + nexpected + (if (zerop nunexpected) + "" + (format ", %d unexpected" nunexpected)) + (if (zerop nskipped) + "" + (format ", %d skipped" nskipped))) + (when notests + (message "%d files did not contain any tests:" (length notests)) + (mapc (lambda (l) (message " %s" l)) notests)) + (when badtests + (message "%d files did not finish:" (length badtests)) + (mapc (lambda (l) (message " %s" l)) badtests)) + (when unexpected + (message "%d files contained unexpected results:" (length unexpected)) + (mapc (lambda (l) (message " %s" l)) unexpected)) + (kill-emacs (cond ((or notests badtests (not (zerop nnotrun))) 2) + (unexpected 1) + (t 0))))) + ;;; Utility functions for load/unload actions. (defun ert--activate-font-lock-keywords () === modified file 'test/ChangeLog' --- test/ChangeLog 2014-06-25 19:12:14 +0000 +++ test/ChangeLog 2014-06-26 05:47:10 +0000 @@ -1,3 +1,17 @@ +2014-06-26 Glenn Morris + + * automated/Makefile.in: Simplify and parallelize. (Bug#15991) + (XARGS_LIMIT, BYTE_COMPILE_EXTRA_FLAGS) + (setwins, compile-targets, compile-main, compile-clean): Remove. + (GREP_OPTIONS): Unexport. + (.el.elc): Replace with pattern rule. + (%.elc, %.log): New pattern rules. + (ELFILES, LOGFILES): New variables. + (check): Depend on LOGFILES. Call ert-summarize-tests-batch-and-exit. + (clean, mostlyclean): New rules. + (bootstrap-clean): Simplify. + (bootstrap-clean, distclean): Depend on clean. + 2014-06-25 Glenn Morris * automated/flymake-tests.el (flymake-tests--current-face): === modified file 'test/automated/Makefile.in' --- test/automated/Makefile.in 2014-06-13 23:05:00 +0000 +++ test/automated/Makefile.in 2014-06-26 05:47:10 +0000 @@ -24,10 +24,6 @@ SEPCHAR = @SEPCHAR@ -# Empty for all systems except MinGW, where xargs needs an explicit -# limitation. -XARGS_LIMIT = @XARGS_LIMIT@ - # We never change directory before running Emacs, so a relative file # name is fine, and makes life easier. If we need to change # directory, we can use emacs --chdir. @@ -38,87 +34,73 @@ # but we might as well be explicit. EMACSOPT = -batch --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" -# Extra flags to pass to the byte compiler. -BYTE_COMPILE_EXTRA_FLAGS = - # Prevent any settings in the user environment causing problems. -unexport EMACSDATA EMACSDOC EMACSPATH +unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS # The actual Emacs command run in the targets below. # Prevent any setting of EMACSLOADPATH in user environment causing problems. emacs = EMACSLOADPATH= LC_ALL=C EMACS_TEST_DIRECTORY=$(srcdir) "$(EMACS)" $(EMACSOPT) -# Common command to find subdirectories -setwins=for file in `find $(srcdir) -type d -print`; do \ - case $$file in $(srcdir)*/data* | $(srcdir)*/flymake* ) ;; \ - *) wins="$$wins$${wins:+ }$$file" ;; \ - esac; \ - done - .PHONY: all check all: check -# The compilation stuff is copied from lisp/Makefile - see comments there. - -.SUFFIXES: .elc .el - -.el.elc: +%.elc: %.el @echo Compiling $< - @$(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $< - - -.PHONY: compile-targets compile-main compile-clean - -# TARGETS is set dynamically in the recursive call from `compile-main'. -compile-targets: $(TARGETS) - -# Compile all the Elisp files that need it. Beware: it approximates -# `no-byte-compile', so watch out for false-positives! -compile-main: compile-clean - @$(setwins); \ - els=`echo "$$wins " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.el |g'`; \ - for el in $$els; do \ - test -f $$el || continue; \ - test ! -f $${el}c && GREP_OPTIONS= grep '^;.*no-byte-compile: t' $$el > /dev/null && continue; \ - echo "$${el}c"; \ - done | xargs $(XARGS_LIMIT) echo | \ - while read chunk; do \ - $(MAKE) compile-targets EMACS="$(EMACS)" TARGETS="$$chunk"; \ - done - -# Erase left-over .elc files that do not have a corresponding .el file. -compile-clean: - @$(setwins); \ - elcs=`echo "$$wins " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.elc |g'`; \ - for el in $$(echo $$elcs | sed -e 's/\.elc/\.el/g'); do \ - if test -f "$$el" -o \! -f "$${el}c"; then :; else \ - echo rm "$${el}c"; \ - rm "$${el}c"; \ - fi \ - done - - -.PHONY: bootstrap-clean distclean maintainer-clean - -bootstrap-clean: - -cd $(srcdir) && rm -f *.elc */*.elc */*/*.elc */*/*/*.elc - -distclean: + @$(emacs) -f batch-byte-compile $< + +## Ignore any test errors so we can continue to test other files. +## (It would be nice if we could get an error when running an +## individual test, but not when running check.) +## But compilation errors are always fatal. +## +## I'd prefer to use -emacs -f ert-run-tests-batch-and-exit rather +## than || true, since the former makes problems more obvious. +## I'd also prefer to @-hide the grep part and not the +## ert-run-tests-batch-and-exit part. +## +## We need to use $loadfile because: +## i) -L :$srcdir -l basename does not work, because we have files whose +## basename duplicates a file in lisp/ (eg eshell.el). +## ii) Although -l basename will automatically load .el or .elc, +## -l ./basename treats basename as a literal file (it would be nice +## to change this). +## +## Beware: it approximates `no-byte-compile', so watch out for false-positives! +%.log: ${srcdir}/%.el + @if grep '^;.*no-byte-compile: t' $< > /dev/null; then \ + loadfile=$<; \ + else \ + loadfile=$& $@ || stat=ERROR; \ + echo $$stat: $@ + +ELFILES = $(wildcard ${srcdir}/*.el) +LOGFILES = $(patsubst %.el,%.log,$(notdir ${ELFILES})) + +## If we have to interrupt a hanging test, preserve the log so we can +## see what the problem was. +.PRECIOUS: %.log + +check: ${LOGFILES} + $(emacs) -l ert -f ert-summarize-tests-batch-and-exit $^ + +.PHONY: mostlyclean clean bootstrap-clean distclean maintainer-clean + +clean mostlyclean: + -rm -f *.log + +bootstrap-clean: clean + -rm -f ${srcdir}/*.elc + +distclean: clean rm -f Makefile maintainer-clean: distclean bootstrap-clean - -check: compile-main - @$(setwins); \ - pattern=`echo "$$wins " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.el |g'`; \ - for el in $$pattern; do \ - test -f $$el || continue; \ - args="$$args -l $$el"; \ - els="$$els $$el"; \ - done; \ - echo Testing $$els; \ - $(emacs) $$args -f ert-run-tests-batch-and-exit - # Makefile ends here. ------------------------------------------------------------ revno: 117403 committer: Luke Lee branch nick: trunk timestamp: Thu 2014-06-26 12:18:12 +0800 message: HideIfDef mode bug fixes and enhancements. This is #2 of 3 patches based on the completed work posted on http://www.emacswiki.org/emacs/HideIfDef. - Supporting argumented macro expansion. - Stringification, tokenization and concatenation of strings and tokens. - Add functions to find defines and parse argumented macros into a macro tree containing macro name, formal parameters and macro body. - On macro evaluation, macros will be applied with actual parameters and then got expanded recursively. - Apply review changes. * lisp/progmodes/hideif.el (hif-string-to-number): Fix return value bug. (hif-simple-token-only, hif-tokenize): Commentted in detail mainly for performance enhancements. (hif-parse-if-exp): Rename to `hif-parse-exp'. Enhanced for macro expansion. (hif-factor, hif-string-concatenation, intern-safe): Support string concatenation and argumented macro expansion. (hif-if-valid-identifier-p, hif-define-operator, hif-flatten) (hif-expand-token-list, hif-get-argument-list, hif-define-macro) (hif-delimit, hif-macro-supply-arguments, hif-invoke, hif-canonicalize) (hif-canonicalize-tokens, hif-looking-at-elif, hif-place-macro-invocation) (hif-parse-macro-arglist): Mostly new functions for supporting argumented macro expansion. (hif-string-concatenation, hif-stringify, hif-token-concat) (hif-token-stringification, hif-token-concatenation): Stringify and concatentation. (hif-find-next-relevant): Fix comments (hif-ifdef-to-endif, hif-looking-at-elif, hif-hide-line): Bug fix for some cases involving #elif. (hif-find-define, hif-add-new-defines): New functions for automatically scanning of defined symbols. (hide-ifdef-guts): Fix for auto defined symbol scanning. (hide-ifdef-undef): Fix behavior to match CPP. diff: === modified file 'lisp/progmodes/hideif.el' --- lisp/progmodes/hideif.el 2014-06-19 21:08:44 +0000 +++ lisp/progmodes/hideif.el 2014-06-26 04:18:12 +0000 @@ -36,6 +36,8 @@ ;; ;; Hide-ifdef suppresses the display of code that the preprocessor wouldn't ;; pass through. Support complete C/C++ expression and precedence. +;; It will automatically scans for new #define symbols and macros on the way +;; parsing. ;; ;; The hidden code is marked by ellipses (...). Be ;; cautious when editing near ellipses, since the hidden text is @@ -97,11 +99,12 @@ ;; Extensively modified by Daniel LaLiberte (while at Gould). ;; ;; Extensively modified by Luke Lee in 2013 to support complete C expression -;; evaluation. +;; evaluation and argumented macro expansion. ;;; Code: (require 'cc-mode) +(require 'cl-lib) (defgroup hide-ifdef nil "Hide selected code within `ifdef'." @@ -133,6 +136,9 @@ :group 'hide-ifdef :version "23.1") +(defcustom hide-ifdef-exclude-define-regexp nil + "Ignore #define names if those names match this exclusion pattern." + :type 'string) (defvar hide-ifdef-mode-submap ;; Set up the submap that goes after the prefix key. @@ -356,12 +362,32 @@ ;;; The code that understands what ifs and ifdef in files look like. (defconst hif-cpp-prefix "\\(^\\|\r\\)[ \t]*#[ \t]*") +(defconst hif-ifxdef-regexp (concat hif-cpp-prefix "if\\(n\\)?def")) (defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef")) (defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\(n?def\\)?[ \t]+")) +(defconst hif-elif-regexp (concat hif-cpp-prefix "elif")) (defconst hif-else-regexp (concat hif-cpp-prefix "else")) (defconst hif-endif-regexp (concat hif-cpp-prefix "endif")) (defconst hif-ifx-else-endif-regexp - (concat hif-ifx-regexp "\\|" hif-else-regexp "\\|" hif-endif-regexp)) + (concat hif-ifx-regexp "\\|" hif-elif-regexp "\\|" hif-else-regexp "\\|" + hif-endif-regexp)) +(defconst hif-macro-expr-prefix-regexp + (concat hif-cpp-prefix "\\(if\\(n?def\\)?\\|elif\\|define\\)[ \t]+")) + +(defconst hif-white-regexp "[ \t]*") +(defconst hif-define-regexp + (concat hif-cpp-prefix "\\(define\\|undef\\)")) +(defconst hif-id-regexp + (concat "[[:alpha:]_][[:alnum:]_]*")) +(defconst hif-macroref-regexp + (concat hif-white-regexp "\\(" hif-id-regexp "\\)" hif-white-regexp + "\\(" + "(" hif-white-regexp + "\\(" hif-id-regexp "\\)?" hif-white-regexp + "\\(" "," hif-white-regexp hif-id-regexp hif-white-regexp "\\)*" + "\\(\\.\\.\\.\\)?" hif-white-regexp + ")" + "\\)?" )) ;; Used to store the current token and the whole token list during parsing. ;; Only bound dynamically. @@ -397,7 +423,12 @@ ("/" . hif-divide) ("%" . hif-modulo) ("?" . hif-conditional) - (":" . hif-colon))) + (":" . hif-colon) + ("," . hif-comma) + ("#" . hif-stringify) + ("..." . hif-etc))) + +(defconst hif-valid-token-list (mapcar 'cdr hif-token-alist)) (defconst hif-token-regexp (concat (regexp-opt (mapcar 'car hif-token-alist)) @@ -413,16 +444,23 @@ (string-to-number string base) (let* ((parts (split-string string "\\." t "[ \t]+")) (frac (cadr parts)) - (quot (expt (* base 1.0) (length frac))) - (num (/ (string-to-number (concat (car parts) frac) base) - quot))) - (if (= num (truncate num)) - (truncate num) - num)))) + (fraclen (length frac)) + (quot (expt (if (zerop fraclen) + base + (* base 1.0)) fraclen))) + (/ (string-to-number (concat (car parts) frac) base) quot)))) + +;; The dynamic binding variable `hif-simple-token-only' is shared only by +;; `hif-tokenize' and `hif-find-define'. The purpose is to prevent `hif-tokenize' +;; from returning one more value to indicate a simple token is scanned. This help +;; speeding up macro evaluation on those very simple cases like integers or +;; literals. +;; Check the long comments before `hif-find-define' for more details. [lukelee] (defun hif-tokenize (start end) "Separate string between START and END into a list of tokens." (let ((token-list nil)) + (setq hif-simple-token-only t) (with-syntax-table hide-ifdef-syntax-table (save-excursion (goto-char start) @@ -435,8 +473,10 @@ ((looking-at hif-string-literal-regexp) (push (substring-no-properties (match-string 1)) token-list) (goto-char (match-end 0))) + ((looking-at hif-token-regexp) - (let ((token (buffer-substring (point) (match-end 0)))) + (let ((token (buffer-substring-no-properties + (point) (match-end 0)))) (goto-char (match-end 0)) ;; (message "token: %s" token) (sit-for 1) (push @@ -444,7 +484,7 @@ (if (string-equal token "defined") 'hif-defined) ;; TODO: ;; 1. postfix 'l', 'll', 'ul' and 'ull' - ;; 2. floating number formats + ;; 2. floating number formats (like 1.23e4) ;; 3. 098 is interpreted as octal conversion error (if (string-match "0x\\([0-9a-fA-F]+\\.?[0-9a-fA-F]*\\)" token) @@ -454,9 +494,12 @@ (if (string-match "\\`[1-9][0-9]*\\(\\.[0-9]+\\)?\\'" token) (string-to-number token)) ;; decimal - (intern token)) + (prog1 (intern token) + (setq hif-simple-token-only nil))) token-list))) + (t (error "Bad #if expression: %s" (buffer-string))))))) + (nreverse token-list))) ;;------------------------------------------------------------------------ @@ -491,9 +534,115 @@ "Pop the next token from token-list into the let variable `hif-token'." (setq hif-token (pop hif-token-list))) -(defun hif-parse-if-exp (token-list) - "Parse the TOKEN-LIST. Return translated list in prefix form." - (let ((hif-token-list token-list)) +(defsubst hif-if-valid-identifier-p (id) + (not (or (numberp id) + (stringp id)))) + +(defun hif-define-operator (tokens) + "`Upgrade' hif-define xxx to '(hif-define xxx)' so that it won't be +subsitituted" + (let ((result nil) + (tok nil)) + (while (setq tok (pop tokens)) + (push + (if (eq tok 'hif-defined) + (progn + (setq tok (cadr tokens)) + (if (eq (car tokens) 'hif-lparen) + (if (and (hif-if-valid-identifier-p tok) + (eq (caddr tokens) 'hif-rparen)) + (setq tokens (cdddr tokens)) + (error "#define followed by non-identifier: %S" tok)) + (setq tok (car tokens) + tokens (cdr tokens)) + (unless (hif-if-valid-identifier-p tok) + (error "#define followed by non-identifier: %S" tok))) + (list 'hif-defined 'hif-lparen tok 'hif-rparen)) + tok) + result)) + (nreverse result))) + +(defun hif-flatten (l) + "Flatten a tree" + (apply #'nconc + (mapcar (lambda (x) (if (listp x) + (hif-flatten x) + (list x))) l))) + +(defun hif-expand-token-list (tokens &optional macroname expand_list) + "Perform expansion till everything expanded. No self-reference expansion. + EXPAND_LIST is the list of macro names currently being expanded." + (catch 'self-referencing + (let ((expanded nil) + (remains (hif-define-operator + (hif-token-concatenation + (hif-token-stringification tokens)))) + tok rep) + (if macroname + (setq expand_list (cons macroname expand_list))) + ;; Expanding all tokens till list exhausted + (while (setq tok (pop remains)) + (if (memq tok expand_list) + ;; For self-referencing tokens, don't expand it + (throw 'self-referencing tokens)) + (push + (cond + ((or (memq tok hif-valid-token-list) + (numberp tok) + (stringp tok)) + tok) + + ((setq rep (hif-lookup tok)) + (if (and (listp rep) + (eq (car rep) 'hif-define-macro)) ;; a defined macro + ;; Recursively expand it + (if (cadr rep) ;; Argument list is not nil + (if (not (eq (car remains) 'hif-lparen)) + ;; No argument, no invocation + tok + ;; Argumented macro, get arguments and invoke it. + ;; Dynamically bind hif-token-list and hif-token + ;; for hif-macro-supply-arguments + (let* ((hif-token-list (cdr remains)) + (hif-token nil) + (parmlist (mapcar 'hif-expand-token-list + (hif-get-argument-list + tok))) + (result + (hif-expand-token-list + (hif-macro-supply-arguments tok parmlist) + tok expand_list))) + (setq remains (cons hif-token hif-token-list)) + result)) + ;; Argument list is nil, direct expansion + (setq rep (hif-expand-token-list + (caddr rep) ;; Macro's token list + tok expand_list)) + ;; Replace all remaining references immediately + (setq remains (substitute tok rep remains)) + rep) + ;; Lookup tok returns an atom + rep)) + + ;;[2013-10-22 16:06:12 +0800] Must keep the token, removing + ;; this token might results in an incomplete expression that + ;; cannot be parsed further. + ;;((= 1 (hif-defined tok)) ;; defined (hif-defined tok)=1, + ;; ;;but empty (hif-lookup tok)=nil, thus remove this token + ;; (setq remains (delete tok remains)) + ;; nil) + + (t ;; Usual IDs + tok)) + + expanded)) + + (hif-flatten (nreverse expanded))))) + +(defun hif-parse-exp (token-list &optional macroname) + "Parse the TOKEN-LIST. Return translated list in prefix form. MACRONAME +is applied when invoking macros to prevent self-referencing macros." + (let ((hif-token-list (hif-expand-token-list token-list macroname))) (hif-nexttoken) (prog1 (and hif-token @@ -583,7 +732,8 @@ "Parse a comp-expr : logshift | comp-expr `<'|`>'|`>='|`<=' logshift." (let ((result (hif-logshift-expr)) (comp-token nil)) - (while (memq hif-token '(hif-greater hif-less hif-greater-equal hif-less-equal)) + (while (memq hif-token '(hif-greater hif-less hif-greater-equal + hif-less-equal)) (setq comp-token hif-token) (hif-nexttoken) (setq result (list comp-token result (hif-logshift-expr)))) @@ -622,7 +772,8 @@ result)) (defun hif-factor () - "Parse a factor: '!' factor | '~' factor | '(' expr ')' | 'defined(' id ')' | 'id(parmlist)' | strings | id." + "Parse a factor: '!' factor | '~' factor | '(' expr ')' | +'defined(' id ')' | 'id(parmlist)' | strings | id." (cond ((eq hif-token 'hif-not) (hif-nexttoken) @@ -655,6 +806,8 @@ ((numberp hif-token) (prog1 hif-token (hif-nexttoken))) + ((stringp hif-token) + (hif-string-concatenation)) ;; Unary plus/minus. ((memq hif-token '(hif-minus hif-plus)) @@ -662,10 +815,91 @@ (t ; identifier (let ((ident hif-token)) - (if (memq ident '(or and)) - (error "Error: missing identifier")) (hif-nexttoken) - `(hif-lookup (quote ,ident)))))) + (if (eq hif-token 'hif-lparen) + (hif-place-macro-invocation ident) + `(hif-lookup (quote ,ident))))))) + +(defun hif-get-argument-list (ident) + (let ((nest 0) + (parmlist nil) ;; A "token" list of parameters, will later be parsed + (parm nil)) + + (while (or (not (eq (hif-nexttoken) 'hif-rparen)) + (/= nest 0)) + (if (eq (car (last parm)) 'hif-comma) + (setq parm nil)) + (cond + ((eq hif-token 'hif-lparen) + (setq nest (1+ nest))) + ((eq hif-token 'hif-rparen) + (setq nest (1- nest))) + ((and (eq hif-token 'hif-comma) + (= nest 0)) + (push (nreverse parm) parmlist) + (setq parm nil))) + (push hif-token parm)) + + (push (nreverse parm) parmlist) ;; Okay even if parm is nil + (hif-nexttoken) ;; Drop the hif-rparen, get next token + (nreverse parmlist))) + +(defun hif-place-macro-invocation (ident) + (let ((parmlist (hif-get-argument-list ident))) + `(hif-invoke (quote ,ident) (quote ,parmlist)))) + +(defun hif-string-concatenation () + "Parse concatenated strings: string | strings string" + (let ((result (substring-no-properties hif-token))) + (while (stringp (hif-nexttoken)) + (setq result (concat + (substring result 0 -1) ; remove trailing '"' + (substring hif-token 1)))) ; remove leading '"' + result)) + +(defun hif-define-macro (parmlist token-body) + "A marker for defined macro with arguments, cannot be evaluated alone with +no parameters inputed." + ;;TODO: input arguments at run time, use minibuffer to query all arguments + (error + "Argumented macro cannot be evaluated without passing any parameter.")) + +(defun hif-stringify (a) + "Stringify a number, string or symbol." + (cond + ((numberp a) + (number-to-string a)) + ((atom a) + (symbol-name a)) + ((stringp a) + (concat "\"" a "\"")) + (t + (error "Invalid token to stringify")))) + +(defun intern-safe (str) + (if (stringp str) + (intern str))) + +(defun hif-token-concat (a b) + "Concatenate two tokens into a longer token, currently support only simple +token concatenation. Also support weird (but valid) token concatenation like +'>' ## '>' becomes '>>'. Here we take care only those that can be evaluated +during preprocessing time and ignore all those that can only be evaluated at +C(++) runtime (like '++', '--' and '+='...)." + (if (or (memq a hif-valid-token-list) + (memq b hif-valid-token-list)) + (let* ((ra (car (rassq a hif-token-alist))) + (rb (car (rassq b hif-token-alist))) + (result (and ra rb + (cdr (assoc (concat ra rb) hif-token-alist))))) + (or result + ;;(error "Invalid token to concatenate") + (error "Concatenating \"%s\" and \"%s\" does not give a valid \ +preprocessing token." + (or ra (symbol-name a)) + (or rb (symbol-name b))))) + (intern-safe (concat (hif-stringify a) + (hif-stringify b))))) (defun hif-mathify (val) "Treat VAL as a number: if it's t or nil, use 1 or 0." @@ -728,23 +962,157 @@ (setq result (funcall hide-ifdef-evaluator e)))) result)) +(defun hif-token-stringification (l) + "Scan token list for 'hif-stringify' ('#') token and stringify the next +token." + (let (result) + (while l + (push (if (eq (car l) 'hif-stringify) + (prog1 + (if (cadr l) + (hif-stringify (cadr l)) + (error "No token to stringify")) + (setq l (cdr l))) + (car l)) + result) + (setq l (cdr l))) + (nreverse result))) + +(defun hif-token-concatenation (l) + "Scan token list for 'hif-token-concat' ('##') token and concatenate two +tokens." + (let ((prev nil) + result) + (while l + (while (eq (car l) 'hif-token-concat) + (unless prev + (error "No token before ## to concatenate")) + (unless (cdr l) + (error "No token after ## to concatenate")) + (setq prev (hif-token-concat prev (cadr l))) + (setq l (cddr l))) + (if prev + (setq result (append result (list prev)))) + (setq prev (car l) + l (cdr l))) + (if prev + (append result (list prev)) + result))) + +(defun hif-delimit (lis atom) + (nconc (mapcan (lambda (l) (list l atom)) + (butlast lis)) + (last lis))) + +;; Perform token replacement: +(defun hif-macro-supply-arguments (macro-name actual-parms) + "Expand a macro call, replace ACTUAL-PARMS in the macro body." + (let* ((SA (assoc macro-name hide-ifdef-env)) + (macro (and SA + (cdr SA) + (eq (cadr SA) 'hif-define-macro) + (cddr SA))) + (formal-parms (and macro (car macro))) + (macro-body (and macro (cadr macro))) + (hide-ifdef-local-env nil) ; dynamic binding local table + actual-count + formal-count + actual + formal + etc) + + (when (and actual-parms formal-parms macro-body) + ;; For each actual parameter, evaluate each one and associate it + ;; with the associated actual parameter, put it into local table and finally + ;; evaluate the macro body. + (if (setq etc (eq (car formal-parms) 'hif-etc)) + ;; Take care of 'hif-etc first. Prefix 'hif-comma back if needed. + (setq formal-parms (cdr formal-parms))) + (setq formal-count (length formal-parms) + actual-count (length actual-parms)) + + (if (> formal-count actual-count) + (error "Too few parmameter for macro %S" macro-name) + (if (< formal-count actual-count) + (or etc + (error "Too many parameters for macro %S" macro-name)))) + + ;; Perform token replacement on the macro-body on the parameters + (while (setq formal (pop formal-parms)) + ;; Prevent repetitive substitutation, thus cannot use 'subst' + ;; for example: + ;; #define mac(a,b) (a+b) + ;; #define testmac mac(b,y) + ;; testmac should expand to (b+y): replace of argument a and b + ;; occurs simultaneously, not sequentially. If sequentially, + ;; according to the argument order, it will become: + ;; 1. formal parm #1 'a' replaced by actual parm 'b', thus (a+b) + ;; becomes (b+b) + ;; 2. formal parm #2 'b' replaced by actual parm 'y', thus (b+b) + ;; becomes (y+y). + (setq macro-body + ;; Unlike 'subst', 'substitute' replace only the top level + ;; instead of the whole tree; more importantly, it's not + ;; destructive. + (substitute (if (and etc (null formal-parms)) + (hif-delimit actual-parms 'hif-comma) + (car actual-parms)) + formal macro-body)) + (setq actual-parms (cdr actual-parms))) + + ;; Replacement completed, flatten the whole token list + (setq macro-body (hif-flatten macro-body)) + + ;; Stringification and token concatenation happens here + (hif-token-concatenation (hif-token-stringification macro-body))))) + +(defun hif-invoke (macro-name actual-parms) + "Invoke a macro by first expanding it, then reparse the macro-body, +finally invoke the macro." + ;; Reparse the macro body and evaluate it + (funcall hide-ifdef-evaluator + (hif-parse-exp + (hif-macro-supply-arguments macro-name actual-parms) + macro-name))) ;;;----------- end of parser ----------------------- -(defun hif-canonicalize () - "When at beginning of #ifX, return a Lisp expression for its condition." +(defun hif-canonicalize-tokens (regexp) ;; for debugging + "Return the expanded result of the scanned tokens." (save-excursion - (let ((negate (looking-at hif-ifndef-regexp))) - (re-search-forward hif-ifx-regexp) - (let* ((tokens (hif-tokenize (point) - (progn (hif-end-of-line) (point)))) - (expr (hif-parse-if-exp tokens))) - ;; (message "hif-canonicalized: %s" expr) - (if negate - (list 'hif-not expr) - expr))))) + (re-search-forward regexp) + (let* ((curr-regexp (match-string 0)) + (defined (string-match hif-ifxdef-regexp curr-regexp)) + (negate (and defined + (string= (match-string 2 curr-regexp) "n"))) + (hif-simple-token-only nil) ;; Dynamic binding var for `hif-tokenize' + (tokens (hif-tokenize (point) + (progn (hif-end-of-line) (point))))) + (if defined + (setq tokens (list 'hif-defined tokens))) + (if negate + (setq tokens (list 'hif-not tokens))) + tokens))) +(defun hif-canonicalize (regexp) + "When at beginning of `regexp' (i.e. #ifX), return a Lisp expression for +its condition." + (let ((case-fold-search nil)) + (save-excursion + (re-search-forward regexp) + (let* ((curr-regexp (match-string 0)) + (defined (string-match hif-ifxdef-regexp curr-regexp)) + (negate (and defined + (string= (match-string 2 curr-regexp) "n"))) + (hif-simple-token-only nil) ;; Dynamic binding for `hif-tokenize' + (tokens (hif-tokenize (point) + (progn (hif-end-of-line) (point))))) + (if defined + (setq tokens (list 'hif-defined tokens))) + (if negate + (setq tokens (list 'hif-not tokens))) + (hif-parse-exp tokens))))) (defun hif-find-any-ifX () "Move to next #if..., or #ifndef, at point or after." @@ -755,10 +1123,10 @@ (defun hif-find-next-relevant () - "Move to next #if..., #else, or #endif, after the current line." + "Move to next #if..., #elif..., #else, or #endif, after the current line." ;; (message "hif-find-next-relevant at %d" (point)) (end-of-line) - ;; avoid infinite recursion by only going to beginning of line if match found + ;; Avoid infinite recursion by only going to line-beginning if match found (if (re-search-forward hif-ifx-else-endif-regexp (point-max) t) (beginning-of-line))) @@ -766,7 +1134,7 @@ "Move to previous #if..., #else, or #endif, before the current line." ;; (message "hif-find-previous-relevant at %d" (point)) (beginning-of-line) - ;; avoid infinite recursion by only going to beginning of line if match found + ;; Avoid infinite recursion by only going to line-beginning if match found (if (re-search-backward hif-ifx-else-endif-regexp (point-min) t) (beginning-of-line))) @@ -778,15 +1146,19 @@ (defun hif-looking-at-else () (looking-at hif-else-regexp)) +(defun hif-looking-at-elif () + (looking-at hif-elif-regexp)) (defun hif-ifdef-to-endif () - "If positioned at #ifX or #else form, skip to corresponding #endif." + "If positioned at #ifX, #elif, or #else form, skip to corresponding #endif." ;; (message "hif-ifdef-to-endif at %d" (point)) (sit-for 1) (hif-find-next-relevant) (cond ((hif-looking-at-ifX) (hif-ifdef-to-endif) ; find endif of nested if (hif-ifdef-to-endif)) ; find outer endif or else + ((hif-looking-at-elif) + (hif-ifdef-to-endif)) ((hif-looking-at-else) (hif-ifdef-to-endif)) ; find endif following else ((hif-looking-at-endif) @@ -959,7 +1331,7 @@ ;;; A bit slimy. (defun hif-hide-line (point) - "Hide the line containing point. Does nothing if `hide-ifdef-lines' is nil." + "Hide the line containing point. Does nothing if `hide-ifdef-lines' is nil." (when hide-ifdef-lines (save-excursion (goto-char point) @@ -1003,7 +1375,7 @@ "Called at #ifX expression, this hides those parts that should be hidden. It uses the judgment of `hide-ifdef-evaluator'." ;; (message "hif-possibly-hide") (sit-for 1) - (let ((test (hif-canonicalize)) + (let ((test (hif-canonicalize hif-ifx-regexp)) (range (hif-find-range))) ;; (message "test = %s" test) (sit-for 1) @@ -1031,16 +1403,145 @@ (goto-char (hif-range-end range)) (end-of-line))) - +(defun hif-parse-macro-arglist (str) + "Parse argument list formatted as '( arg1 [ , argn] [...] )', including +the '...'. Return a list of the arguments, if '...' exists the first arg +will be hif-etc." + (let* ((hif-simple-token-only nil) ;; Dynamic binding var for `hif-tokenize' + (tokenlist + (cdr (hif-tokenize + (- (point) (length str)) (point)))) ; remove hif-lparen + etc result token) + (while (not (eq (setq token (pop tokenlist)) 'hif-rparen)) + (cond + ((eq token 'hif-etc) + (setq etc t)) + ((eq token 'hif-comma) + t) + (t + (push token result)))) + (if etc + (cons 'hif-etc (nreverse result)) + (nreverse result)))) + +;; The original version of hideif evaluates the macro early and store the +;; final values for the defined macro into the symbol database (aka +;; `hide-ifdef-env'). The evaluation process is "strings -> tokens -> parsed +;; tree -> [value]". (The square bracket refers to what's stored in in our +;; `hide-ifdef-env'.) +;; +;; This forbids the evaluation of an argumented macro since the parameters +;; are applied at run time. In order to support argumented macro I then +;; postponed the evaluation process one stage and store the "parsed tree" +;; into symbol database. The evaluation process was then "strings -> tokens +;; -> [parsed tree] -> value". Hideif therefore run slower since it need to +;; evaluate the parsed tree everytime when trying to expand the symbol. These +;; temporarily code changes are obsolete and not in Emacs source repository. +;; +;; Furthermore, CPP did allow partial expression to be defined in several +;; macros and later got concatenated into a complete expression and then +;; evaluate it. In order to match this behavior I had to postpone one stage +;; further, otherwise those partial expression will be fail on parsing and +;; we'll miss all macros that reference it. The evaluation process thus +;; became "strings -> [tokens] -> parsed tree -> value." This degraded the +;; performance since we need to parse tokens and evaluate them everytime +;; when that symbol is referenced. +;; +;; In real cases I found a lot portion of macros are "simple macros" that +;; expand to literals like integers or other symbols. In order to enhance +;; the performance I use this `hif-simple-token-only' to notify my code and +;; save the final [value] into symbol database. [lukelee] + +(defun hif-find-define (&optional min max) + "Parse texts and retrieve all defines within the region MIN and MAX." + (interactive) + (and min (goto-char min)) + (and (re-search-forward hif-define-regexp max t) + (or + (let* ((defining (string= "define" (match-string 2))) + (name (and (re-search-forward hif-macroref-regexp max t) + (match-string 1))) + (parsed nil) + (parmlist (and (match-string 3) ;; First arg id found + (hif-parse-macro-arglist (match-string 2))))) + (if defining + ;; Ignore name (still need to return 't), or define the name + (or (and hide-ifdef-exclude-define-regexp + (string-match hide-ifdef-exclude-define-regexp + name)) + + (let* ((start (point)) + (end (progn (hif-end-of-line) (point))) + (hif-simple-token-only nil) ;; Dynamic binding + (tokens + (and name + ;; `hif-simple-token-only' is set/clear + ;; only in this block + (condition-case nil + ;; Prevent C statements like + ;; 'do { ... } while (0)' + (hif-tokenize start end) + (error + ;; We can't just return nil here since + ;; this will stop hideif from searching + ;; for more #defines. + (setq hif-simple-token-only t) + (buffer-substring-no-properties + start end))))) + ;; For simple tokens we save only the parsed result; + ;; otherwise we save the tokens and parse it after + ;; parameter replacement + (expr (and tokens + ;; `hif-simple-token-only' is checked only + ;; here. + (or (and hif-simple-token-only + (listp tokens) + (= (length tokens) 1) + (hif-parse-exp tokens)) + `(hif-define-macro ,parmlist + ,tokens)))) + (SA (and name + (assoc (intern name) hide-ifdef-env)))) + (and name + (if SA + (or (setcdr SA expr) t) + ;; Lazy evaluation, eval only if hif-lookup find it. + ;; Define it anyway, even if nil it's still in list + ;; and therefore considerred defined + (push (cons (intern name) expr) hide-ifdef-env))))) + ;; #undef + (and name + (hif-undefine-symbol (intern name)))))) + t)) + + +(defun hif-add-new-defines (&optional min max) + "Scan and add all #define macros between MIN and MAX" + (interactive) + (save-excursion + (save-restriction + ;; (mark-region min max) ;; for debugging + (while (hif-find-define min max) + (setf min (point))) + (if max (goto-char max) + (goto-char (point-max)))))) (defun hide-ifdef-guts () "Does most of the work of `hide-ifdefs'. It does not do the work that's pointless to redo on a recursive entry." ;; (message "hide-ifdef-guts") (save-excursion + (let ((case-fold-search nil) + min max) (goto-char (point-min)) - (while (hif-find-any-ifX) - (hif-possibly-hide)))) + (setf min (point)) + (loop do + (setf max (hif-find-any-ifX)) + (hif-add-new-defines min max) + (if max + (hif-possibly-hide)) + (setf min (point)) + while max)))) ;;===%%SF%% hide-ifdef-hiding (End) === @@ -1054,7 +1555,8 @@ (message "Hide-Read-Only %s" (if hide-ifdef-read-only "ON" "OFF")) (if hide-ifdef-hiding - (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only))) + (setq buffer-read-only (or hide-ifdef-read-only + hif-outside-read-only))) (force-mode-line-update)) (defun hide-ifdef-toggle-outside-read-only () @@ -1090,12 +1592,32 @@ (hif-set-var var 1) (if hide-ifdef-hiding (hide-ifdefs))) -(defun hide-ifdef-undef (var) +(defun hif-undefine-symbol (var) + (setq hide-ifdef-env + (delete (assoc var hide-ifdef-env) hide-ifdef-env))) + +;;(defun hide-ifdef-undef (var) +;; "Undefine a VAR so that #ifdef VAR would not be included." +;; (interactive "SUndefine what? ") +;; ;;(hif-set-var var nil);;Luke fixed: set it nil is still considered +;; ;;defined so #ifdef VAR is still true. +;; (hif-undefine-symbol var) +;; (if hide-ifdef-hiding (hide-ifdefs))) + +(defun hide-ifdef-undef (start end) "Undefine a VAR so that #ifdef VAR would not be included." - (interactive "SUndefine what? ") - (hif-set-var var nil) - (if hide-ifdef-hiding (hide-ifdefs))) - + (interactive "r") + (let* ((symstr + (or (and mark-active + (buffer-substring-no-properties start end)) + (read-string "Undefine what? " (current-word)))) + (sym (and symstr + (intern symstr)))) + (if (zerop (hif-defined sym)) + (message "`%s' not defined, no need to undefine it" symstr) + (hif-undefine-symbol sym) + (if hide-ifdef-hiding (hide-ifdefs)) + (message "`%S' undefined" sym)))) (defun hide-ifdefs (&optional nomsg) "Hide the contents of some #ifdefs. ------------------------------------------------------------ revno: 117402 committer: Glenn Morris branch nick: trunk timestamp: Wed 2014-06-25 19:51:10 -0400 message: lisp/Makefile: Remove cc-*.el dependencies on non-cc files * lisp/Makefile.in ($(lisp)/progmodes/cc-defs.elc) ($(lisp)/progmodes/cc-fonts.elc, $(lisp)/progmodes/cc-langs.elc) ($(lisp)/progmodes/cc-vars.elc): Drop hand-written deps on non-cc files. They are not relevant to the original issue (bug#1004), and cause unnecessary recompilation (bug#2151). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-06-25 18:11:45 +0000 +++ lisp/ChangeLog 2014-06-25 23:51:10 +0000 @@ -1,3 +1,11 @@ +2014-06-25 Glenn Morris + + * Makefile.in ($(lisp)/progmodes/cc-defs.elc) + ($(lisp)/progmodes/cc-fonts.elc, $(lisp)/progmodes/cc-langs.elc) + ($(lisp)/progmodes/cc-vars.elc): Drop hand-written deps on non-cc + files. They are not relevant to the original issue (bug#1004), + and cause unnecessary recompilation (bug#2151). + 2014-06-25 Stefan Monnier * play/landmark.el: Use lexical-binding and avoid `intangible'. === modified file 'lisp/Makefile.in' --- lisp/Makefile.in 2014-06-15 00:34:22 +0000 +++ lisp/Makefile.in 2014-06-25 23:51:10 +0000 @@ -519,28 +519,22 @@ $(lisp)/progmodes/cc-vars.elc: \ $(lisp)/progmodes/cc-bytecomp.elc $(lisp)/progmodes/cc-defs.elc -$(lisp)/progmodes/cc-align.elc: \ - $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc - -$(lisp)/progmodes/cc-cmds.elc: \ +$(lisp)/progmodes/cc-align.elc $(lisp)/progmodes/cc-cmds.elc: \ $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc $(lisp)/progmodes/cc-compat.elc: \ $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-styles.elc \ $(lisp)/progmodes/cc-engine.elc -$(lisp)/progmodes/cc-defs.elc: $(lisp)/progmodes/cc-bytecomp.elc \ - $(lisp)/emacs-lisp/cl.elc $(lisp)/emacs-lisp/regexp-opt.elc +$(lisp)/progmodes/cc-defs.elc: $(lisp)/progmodes/cc-bytecomp.elc $(lisp)/progmodes/cc-engine.elc: $(lisp)/progmodes/cc-langs.elc \ $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-fonts.elc: $(lisp)/progmodes/cc-langs.elc \ - $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc \ - $(lisp)/font-lock.elc + $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc -$(lisp)/progmodes/cc-langs.elc: $(lisp)/progmodes/cc-vars.elc \ - $(lisp)/emacs-lisp/cl.elc +$(lisp)/progmodes/cc-langs.elc: $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-mode.elc: $(lisp)/progmodes/cc-langs.elc \ $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc \ @@ -550,6 +544,4 @@ $(lisp)/progmodes/cc-styles.elc: $(lisp)/progmodes/cc-vars.elc \ $(lisp)/progmodes/cc-align.elc -$(lisp)/progmodes/cc-vars.elc: $(lisp)/custom.elc $(lisp)/widget.elc - # Makefile ends here. ------------------------------------------------------------ revno: 117401 committer: Glenn Morris branch nick: trunk timestamp: Wed 2014-06-25 18:59:37 -0400 message: * flymake-tests.el (flymake-tests--current-face): Tweak previous sleep change. Using the time-honored principle of "if it doesn't when you do X, do it again and see what happens". diff: === modified file 'test/automated/flymake-tests.el' --- test/automated/flymake-tests.el 2014-06-25 19:12:14 +0000 +++ test/automated/flymake-tests.el 2014-06-25 22:59:37 +0000 @@ -33,19 +33,16 @@ ;; Warning predicate (defun flymake-tests--current-face (file predicate) (let ((buffer (find-file-noselect - (expand-file-name file flymake-tests-data-directory)))) + (expand-file-name file flymake-tests-data-directory))) + (i 0)) (unwind-protect (with-current-buffer buffer (setq-local flymake-warning-predicate predicate) (goto-char (point-min)) (flymake-mode 1) - ;; XXX: is this reliable enough? - ;; By experiment, no it is not! - ;; For some reason, a single (sleep-for 1.0) does nothing here, - ;; but 2 * (sleep-for 0.5) works. - ;; FIXME what is going on...? - (sleep-for (+ 0.5 flymake-no-changes-timeout)) - (sleep-for (+ 0.5 flymake-no-changes-timeout)) + ;; Weirdness here... http://debbugs.gnu.org/17647#25 + (while (and flymake-is-running (< (setq i (1+ i)) 10)) + (sleep-for (+ 0.5 flymake-no-changes-timeout))) (flymake-goto-next-error) (face-at-point)) (and buffer (let (kill-buffer-query-functions) (kill-buffer buffer)))))) ------------------------------------------------------------ revno: 117400 committer: Glenn Morris branch nick: trunk timestamp: Wed 2014-06-25 15:12:14 -0400 message: Try to fix some flymake-tests weirdness * test/automated/flymake-tests.el (flymake-tests--current-face): Sleep for longer. Avoid querying. diff: === modified file 'test/ChangeLog' --- test/ChangeLog 2014-06-25 10:36:51 +0000 +++ test/ChangeLog 2014-06-25 19:12:14 +0000 @@ -1,3 +1,8 @@ +2014-06-25 Glenn Morris + + * automated/flymake-tests.el (flymake-tests--current-face): + Sleep for longer. Avoid querying. + 2014-06-25 Dmitry Antipov * automated/fns-tests.el (fns-tests-compare-string): New test. === modified file 'test/automated/flymake-tests.el' --- test/automated/flymake-tests.el 2014-01-01 07:43:34 +0000 +++ test/automated/flymake-tests.el 2014-06-25 19:12:14 +0000 @@ -40,10 +40,15 @@ (goto-char (point-min)) (flymake-mode 1) ;; XXX: is this reliable enough? + ;; By experiment, no it is not! + ;; For some reason, a single (sleep-for 1.0) does nothing here, + ;; but 2 * (sleep-for 0.5) works. + ;; FIXME what is going on...? + (sleep-for (+ 0.5 flymake-no-changes-timeout)) (sleep-for (+ 0.5 flymake-no-changes-timeout)) (flymake-goto-next-error) (face-at-point)) - (and buffer (kill-buffer buffer))))) + (and buffer (let (kill-buffer-query-functions) (kill-buffer buffer)))))) (ert-deftest warning-predicate-rx-gcc () "Test GCC warning via regexp predicate." ------------------------------------------------------------ revno: 117399 committer: Stefan Monnier branch nick: trunk timestamp: Wed 2014-06-25 14:11:45 -0400 message: * lisp/play/landmark.el: Use lexical-binding and avoid `intangible'. (landmark--last-pos): New var. (landmark--intangible-chars): New const. (landmark--intangible): New function. (landmark-mode, landmark-move): Use it. (landmark-mode): Remove properties. (landmark-plot-square, landmark-point-square, landmark-goto-xy) (landmark-cross-qtuple): Don't worry about `intangible' any more. (landmark-click, landmark-point-y): Same; and don't assume point-min==1. (landmark-init-display): Don't set `intangible' and `point-entered'. (square): Remove. Inline it instead. (landmark--distance): Rename from `distance'. (landmark-calc-distance-of-robot-from): Rename from calc-distance-of-robot-from. (landmark-calc-smell-internal): Rename from calc-smell-internal. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-06-25 10:36:51 +0000 +++ lisp/ChangeLog 2014-06-25 18:11:45 +0000 @@ -1,3 +1,22 @@ +2014-06-25 Stefan Monnier + + * play/landmark.el: Use lexical-binding and avoid `intangible'. + (landmark--last-pos): New var. + (landmark--intangible-chars): New const. + (landmark--intangible): New function. + (landmark-mode, landmark-move): Use it. + (landmark-mode): Remove properties. + (landmark-plot-square, landmark-point-square, landmark-goto-xy) + (landmark-cross-qtuple): + Don't worry about `intangible' any more. + (landmark-click, landmark-point-y): Same; and don't assume point-min==1. + (landmark-init-display): Don't set `intangible' and `point-entered'. + (square): Remove. Inline it instead. + (landmark--distance): Rename from `distance'. + (landmark-calc-distance-of-robot-from): Rename from + calc-distance-of-robot-from. + (landmark-calc-smell-internal): Rename from calc-smell-internal. + 2014-06-25 Dmitry Antipov * files.el (dir-locals-find-file, file-relative-name): === modified file 'lisp/play/landmark.el' --- lisp/play/landmark.el 2014-06-21 21:36:44 +0000 +++ lisp/play/landmark.el 2014-06-25 18:11:45 +0000 @@ -1,10 +1,11 @@ -;;; landmark.el --- neural-network robot that learns landmarks +;;; landmark.el --- Neural-network robot that learns landmarks -*- lexical-binding:t -*- ;; Copyright (C) 1996-1997, 2000-2014 Free Software Foundation, Inc. ;; Author: Terrence Brannon (was: ) ;; Created: December 16, 1996 - first release to usenet ;; Keywords: games, neural network, adaptive search, chemotaxis +;; Version: 1.0 ;; This file is part of GNU Emacs. @@ -225,9 +226,6 @@ 'landmark-font-lock-face-X))) "Font lock rules for Landmark.") -(put 'landmark-mode 'front-sticky - (put 'landmark-mode 'rear-nonsticky '(intangible))) -(put 'landmark-mode 'intangible 1) ;; This one is for when they set view-read-only to t: Landmark cannot ;; allow View Mode to be activated in its buffer. (define-derived-mode landmark-mode special-mode "Lm" @@ -244,7 +242,8 @@ is non-nil. One interesting value is `turn-on-font-lock'." (landmark-display-statistics) (setq-local font-lock-defaults '(landmark-font-lock-keywords t)) - (setq buffer-read-only t)) + (setq buffer-read-only t) + (add-hook 'post-command-hook #'landmark--intangible nil t)) ;;;_ + THE SCORE TABLE. @@ -679,8 +678,8 @@ (landmark-prompt-for-other-game)) (t (message "Let me think...") - (let (square score) - (setq square (landmark-strongest-square)) + (let ((square (landmark-strongest-square)) + score) (cond ((null square) (landmark-terminate-game 'nobody-won)) (t @@ -722,8 +721,7 @@ (min (max (/ (+ (- (cdr click) landmark-y-offset 1) - (let ((inhibit-point-motion-hooks t)) - (count-lines 1 (window-start))) + (count-lines (point-min) (window-start)) landmark-square-height (% landmark-square-height 2) (/ landmark-square-height 2)) @@ -749,8 +747,8 @@ ((not landmark-game-in-progress) (landmark-prompt-for-other-game)) (t - (let (square score) - (setq square (landmark-point-square)) + (let ((square (landmark-point-square)) + score) (cond ((null square) (error "Your point is not on a square. Retry!")) ((not (zerop (aref landmark-board square))) @@ -844,16 +842,15 @@ (defun landmark-point-y () "Return the board row where point is." - (let ((inhibit-point-motion-hooks t)) - (1+ (/ (- (count-lines 1 (point)) landmark-y-offset (if (bolp) 0 1)) - landmark-square-height)))) + (1+ (/ (- (count-lines (point-min) (point)) + landmark-y-offset (if (bolp) 0 1)) + landmark-square-height))) (defun landmark-point-square () "Return the index of the square point is on." - (let ((inhibit-point-motion-hooks t)) (landmark-xy-to-index (1+ (/ (- (current-column) landmark-x-offset) landmark-square-width)) - (landmark-point-y)))) + (landmark-point-y))) (defun landmark-goto-square (index) "Move point to square number INDEX." @@ -861,23 +858,21 @@ (defun landmark-goto-xy (x y) "Move point to square at X, Y coords." - (let ((inhibit-point-motion-hooks t)) (goto-char (point-min)) - (forward-line (+ landmark-y-offset (* landmark-square-height (1- y))))) + (forward-line (+ landmark-y-offset (* landmark-square-height (1- y)))) (move-to-column (+ landmark-x-offset (* landmark-square-width (1- x))))) (defun landmark-plot-square (square value) "Draw 'X', 'O' or '.' on SQUARE depending on VALUE, leave point there." (or (= value 1) (landmark-goto-square square)) - (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t)) - (insert-and-inherit (cond ((= value 1) ?.) - ((= value 2) ?N) - ((= value 3) ?S) - ((= value 4) ?E) - ((= value 5) ?W) - ((= value 6) ?^))) + (let ((inhibit-read-only t)) + (insert (cond ((= value 1) ?.) + ((= value 2) ?N) + ((= value 3) ?S) + ((= value 4) ?E) + ((= value 5) ?W) + ((= value 6) ?^))) (and (zerop value) (add-text-properties (1- (point)) (point) @@ -892,8 +887,7 @@ "Display an N by M Landmark board." (buffer-disable-undo (current-buffer)) (let ((inhibit-read-only t) - (point 1) opoint - (intangible t) + (point (point-min)) opoint (i m) j x) ;; Try to minimize number of chars (because of text properties) (setq tab-width @@ -902,7 +896,7 @@ (max (/ (+ (% landmark-x-offset landmark-square-width) landmark-square-width 1) 2) 2))) (erase-buffer) - (newline landmark-y-offset) + (insert-char ?\n landmark-y-offset) (while (progn (setq j n x (- landmark-x-offset landmark-square-width)) @@ -910,9 +904,7 @@ (insert-char ?\t (/ (- (setq x (+ x landmark-square-width)) (current-column)) tab-width)) - (insert-char ? (- x (current-column))) - (if (setq intangible (not intangible)) - (put-text-property point (point) 'intangible 2)) + (insert-char ?\s (- x (current-column))) (and (zerop j) (= i (- m 2)) (progn @@ -929,14 +921,7 @@ (if (= i (1- m)) (setq opoint point)) (insert-char ?\n landmark-square-height)) - (or (eq (char-after 1) ?.) - (put-text-property 1 2 'point-entered - (lambda (_x _y) (if (bobp) (forward-char))))) - (or intangible - (put-text-property point (point) 'intangible 2)) - (put-text-property point (point) 'point-entered - (lambda (_x _y) (if (eobp) (backward-char)))) - (put-text-property (point-min) (point) 'category 'landmark-mode)) + (insert-char ?\n)) (landmark-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board (sit-for 0)) ; Display NOW @@ -998,8 +983,7 @@ "Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction." (save-excursion ; Not moving point from last square (let ((depl (landmark-xy-to-index dx dy)) - (inhibit-read-only t) - (inhibit-point-motion-hooks t)) + (inhibit-read-only t)) ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1 (while (/= square1 square2) (landmark-goto-square square1) @@ -1018,20 +1002,40 @@ (setq landmark-n (1+ landmark-n)) (forward-line 1) (indent-to column) - (insert-and-inherit ?|)))) + (insert ?|)))) ((= dx -1) ; 1st Diagonal (indent-to (prog1 (- (current-column) (/ landmark-square-width 2)) (forward-line (/ landmark-square-height 2)))) - (insert-and-inherit ?/)) + (insert ?/)) (t ; 2nd Diagonal (indent-to (prog1 (+ (current-column) (/ landmark-square-width 2)) (forward-line (/ landmark-square-height 2)))) - (insert-and-inherit ?\\)))))) + (insert ?\\)))))) (sit-for 0)) ; Display NOW ;;;_ + CURSOR MOTION. +(defvar-local landmark--last-pos 0) + +(defconst landmark--intangible-chars "- \t\n|/\\\\") + +(defun landmark--intangible () + (when (or (eobp) + (save-excursion + (not (zerop (skip-chars-forward landmark--intangible-chars))))) + (if (<= landmark--last-pos (point)) ;Moving forward. + (progn + (skip-chars-forward landmark--intangible-chars) + (when (eobp) + (skip-chars-backward landmark--intangible-chars) + (forward-char -1))) + (skip-chars-backward landmark--intangible-chars) + (if (bobp) + (skip-chars-forward landmark--intangible-chars) + (forward-char -1)))) + (setq landmark--last-pos (point))) + ;; previous-line and next-line don't work right with intangible newlines (defun landmark-move-down () "Move point down one row on the Landmark board." @@ -1138,7 +1142,7 @@ (defun landmark-print-distance () - (insert (format "tree: %S \n" (calc-distance-of-robot-from 'landmark-tree))) + (insert (format "tree: %S \n" (landmark-calc-distance-of-robot-from 'landmark-tree))) (mapc 'landmark-print-distance-int landmark-directions)) @@ -1303,9 +1307,9 @@ ;;;_ - landmark-plot-internal (sym) (defun landmark-plot-internal (sym) (landmark-plot-square (landmark-xy-to-index - (get sym 'x) - (get sym 'y)) - (get sym 'sym))) + (get sym 'x) + (get sym 'y)) + (get sym 'sym))) ;;;_ - landmark-plot-landmarks () (defun landmark-plot-landmarks () (setq landmark-cx (/ landmark-board-width 2)) @@ -1336,26 +1340,24 @@ ;;;_ + Distance-calculation functions -;;;_ - square (a) -(defun square (a) - (* a a)) ;;;_ - distance (x x0 y y0) -(defun distance (x x0 y y0) - (sqrt (+ (square (- x x0)) (square (- y y0))))) +(defun landmark--distance (x x0 y y0) + (let ((dx (- x x0)) (dy (- y y0))) + (sqrt (+ (* dx dx) (* dy dy))))) -;;;_ - calc-distance-of-robot-from (direction) -(defun calc-distance-of-robot-from (direction) +;;;_ - landmark-calc-distance-of-robot-from (direction) +(defun landmark-calc-distance-of-robot-from (direction) (put direction 'distance - (distance (get direction 'x) - (landmark-index-to-x (landmark-point-square)) - (get direction 'y) - (landmark-index-to-y (landmark-point-square))))) + (landmark--distance (get direction 'x) + (landmark-index-to-x (landmark-point-square)) + (get direction 'y) + (landmark-index-to-y (landmark-point-square))))) -;;;_ - calc-smell-internal (sym) -(defun calc-smell-internal (sym) +;;;_ - landmark-calc-smell-internal (sym) +(defun landmark-calc-smell-internal (sym) (let ((r (get sym 'r)) - (d (calc-distance-of-robot-from sym))) + (d (landmark-calc-distance-of-robot-from sym))) (if (> (* 0.5 (- 1 (/ d r))) 0) (* 0.5 (- 1 (/ d r))) 0))) @@ -1402,12 +1404,12 @@ (defun landmark-calc-current-smells () (mapc (lambda (direction) - (put direction 'smell (calc-smell-internal direction))) + (put direction 'smell (landmark-calc-smell-internal direction))) landmark-directions)) (defun landmark-calc-payoff () (put 'z 't-1 (get 'z 't)) - (put 'z 't (calc-smell-internal 'landmark-tree)) + (put 'z 't (landmark-calc-smell-internal 'landmark-tree)) (if (= (- (get 'z 't) (get 'z 't-1)) 0.0) (cl-incf landmark-no-payoff) (setf landmark-no-payoff 0))) @@ -1448,8 +1450,9 @@ (message "e-w normalization")))) (mapc (lambda (pair) - (if (> (get (car pair) 'y_t) 0) - (funcall (car (cdr pair))))) + (when (> (get (car pair) 'y_t) 0) + (funcall (car (cdr pair))) + (landmark--intangible))) '( (landmark-n landmark-move-up) (landmark-s landmark-move-down) @@ -1471,7 +1474,7 @@ (defun landmark-amble-robot () (interactive) - (while (> (calc-distance-of-robot-from 'landmark-tree) 0) + (while (> (landmark-calc-distance-of-robot-from 'landmark-tree) 0) (landmark-store-old-y_t) (landmark-calc-current-smells) @@ -1505,8 +1508,7 @@ ((not landmark-game-in-progress) (landmark-prompt-for-other-game)) (t - (let (square) - (setq square (landmark-point-square)) + (let ((square (landmark-point-square))) (cond ((null square) (error "Your point is not on a square. Retry!")) ((not (zerop (aref landmark-board square))) @@ -1517,7 +1519,7 @@ (landmark-store-old-y_t) (landmark-calc-current-smells) - (put 'z 't (calc-smell-internal 'landmark-tree)) + (put 'z 't (landmark-calc-smell-internal 'landmark-tree)) (landmark-random-move) @@ -1590,7 +1592,9 @@ ;; distance on scent. (defun landmark-set-landmark-signal-strengths () - (setq landmark-tree-r (* (sqrt (+ (square landmark-cx) (square landmark-cy))) 1.5)) + (setq landmark-tree-r (* (sqrt (+ (* landmark-cx landmark-cx) + (* landmark-cy landmark-cy))) + 1.5)) (mapc (lambda (direction) (put direction 'r (* landmark-cx 1.1))) landmark-ew) @@ -1609,7 +1613,7 @@ "Run 100 Landmark games, each time saving the weights from the previous game." (interactive) (landmark 1) - (dotimes (scratch-var 100) + (dotimes (_ 100) (landmark 2))) ;;;###autoload ------------------------------------------------------------ revno: 117398 committer: Dmitry Antipov branch nick: trunk timestamp: Wed 2014-06-25 16:53:12 +0400 message: Fix ChangeLog entry. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2014-06-25 12:11:08 +0000 +++ src/ChangeLog 2014-06-25 12:53:12 +0000 @@ -2,8 +2,10 @@ Consistently use validate_subarray to verify substring. * fns.c (validate_substring): Not static any more. Adjust to - use ptrdiff_t, not EMACS_INT, becase string and vector limits + use ptrdiff_t, not EMACS_INT, because string and vector limits can't exceed ptrdiff_t even if EMACS_INT is wider. + (Fcompare_strings, Fsubstring, Fsubstring_no_properties) + (secure_hash): Adjust user. * lisp.h (validate_subarray): Add prototype. * coding.c (Fundecodable_char_position): * composite.c (Fcomposition_get_gstring, Fcompose_string_internal): ------------------------------------------------------------ revno: 117397 committer: Dmitry Antipov branch nick: trunk timestamp: Wed 2014-06-25 16:11:08 +0400 message: Consistently use validate_subarray to verify substring. * fns.c (validate_substring): Not static any more. Adjust to use ptrdiff_t, not EMACS_INT, becase string and vector limits can't exceed ptrdiff_t even if EMACS_INT is wider. * lisp.h (validate_subarray): Add prototype. * coding.c (Fundecodable_char_position): * composite.c (Fcomposition_get_gstring, Fcompose_string_internal): Use validate_subarray. Adjust comment to mention substring. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2014-06-25 10:36:51 +0000 +++ src/ChangeLog 2014-06-25 12:11:08 +0000 @@ -1,5 +1,16 @@ 2014-06-25 Dmitry Antipov + Consistently use validate_subarray to verify substring. + * fns.c (validate_substring): Not static any more. Adjust to + use ptrdiff_t, not EMACS_INT, becase string and vector limits + can't exceed ptrdiff_t even if EMACS_INT is wider. + * lisp.h (validate_subarray): Add prototype. + * coding.c (Fundecodable_char_position): + * composite.c (Fcomposition_get_gstring, Fcompose_string_internal): + Use validate_subarray. Adjust comment to mention substring. + +2014-06-25 Dmitry Antipov + Do not allow out-of-range character position in Fcompare_strings. * fns.c (validate_subarray): Add prototype. (Fcompare_substring): Use validate_subarray to check ranges. === modified file 'src/coding.c' --- src/coding.c 2014-06-23 04:11:29 +0000 +++ src/coding.c 2014-06-25 12:11:08 +0000 @@ -9091,8 +9091,7 @@ DEFUN ("unencodable-char-position", Funencodable_char_position, Sunencodable_char_position, 3, 5, 0, - doc: /* -Return position of first un-encodable character in a region. + doc: /* Return position of first un-encodable character in a region. START and END specify the region and CODING-SYSTEM specifies the encoding to check. Return nil if CODING-SYSTEM does encode the region. @@ -9102,8 +9101,9 @@ If optional 5th argument STRING is non-nil, it is a string to search for un-encodable characters. In that case, START and END are indexes -to the string. */) - (Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object count, Lisp_Object string) +to the string and treated as in `substring'. */) + (Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, + Lisp_Object count, Lisp_Object string) { EMACS_INT n; struct coding_system coding; @@ -9140,12 +9140,7 @@ else { CHECK_STRING (string); - CHECK_NATNUM (start); - CHECK_NATNUM (end); - if (! (XINT (start) <= XINT (end) && XINT (end) <= SCHARS (string))) - args_out_of_range_3 (string, start, end); - from = XINT (start); - to = XINT (end); + validate_subarray (string, start, end, SCHARS (string), &from, &to); if (! STRING_MULTIBYTE (string)) return Qnil; p = SDATA (string) + string_char_to_byte (string, from); === modified file 'src/composite.c' --- src/composite.c 2014-06-17 03:14:00 +0000 +++ src/composite.c 2014-06-25 12:11:08 +0000 @@ -1684,9 +1684,10 @@ frame, or nil for the selected frame's terminal device. If the optional 4th argument STRING is not nil, it is a string -containing the target characters between indices FROM and TO. -Otherwise FROM and TO are character positions in current buffer; -they can be in either order, and can be integers or markers. +containing the target characters between indices FROM and TO, +which are treated as in `substring'. Otherwise FROM and TO are +character positions in current buffer; they can be in either order, +and can be integers or markers. A glyph-string is a vector containing information about how to display a specific character sequence. The format is: @@ -1742,15 +1743,10 @@ } else { - CHECK_NATNUM (from); - CHECK_NATNUM (to); CHECK_STRING (string); + validate_subarray (string, from, to, SCHARS (string), &frompos, &topos); if (! STRING_MULTIBYTE (string)) error ("Attempt to shape unibyte text"); - if (! (XINT (from) <= XINT (to) && XINT (to) <= SCHARS (string))) - args_out_of_range_3 (string, from, to); - frompos = XFASTINT (from); - topos = XFASTINT (to); frombyte = string_char_to_byte (string, frompos); } @@ -1795,21 +1791,18 @@ Scompose_string_internal, 3, 5, 0, doc: /* Internal use only. -Compose text between indices START and END of STRING. -Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC +Compose text between indices START and END of STRING, where +START and END are treated as in `substring'. Optional 4th +and 5th arguments are COMPONENTS and MODIFICATION-FUNC for the composition. See `compose-string' for more details. */) - (Lisp_Object string, Lisp_Object start, Lisp_Object end, Lisp_Object components, Lisp_Object modification_func) + (Lisp_Object string, Lisp_Object start, Lisp_Object end, + Lisp_Object components, Lisp_Object modification_func) { + ptrdiff_t from, to; + CHECK_STRING (string); - CHECK_NUMBER (start); - CHECK_NUMBER (end); - - if (XINT (start) < 0 || - XINT (start) > XINT (end) - || XINT (end) > SCHARS (string)) - args_out_of_range (start, end); - - compose_text (XINT (start), XINT (end), components, modification_func, string); + validate_subarray (string, start, end, SCHARS (string), &from, &to); + compose_text (from, to, components, modification_func, string); return string; } === modified file 'src/fns.c' --- src/fns.c 2014-06-25 10:36:51 +0000 +++ src/fns.c 2014-06-25 12:11:08 +0000 @@ -50,8 +50,6 @@ static Lisp_Object Qmd5, Qsha1, Qsha224, Qsha256, Qsha384, Qsha512; static bool internal_equal (Lisp_Object, Lisp_Object, int, bool, Lisp_Object); -static void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object, - ptrdiff_t, EMACS_INT *, EMACS_INT *); DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, doc: /* Return the argument unchanged. */) @@ -250,8 +248,7 @@ (Lisp_Object str1, Lisp_Object start1, Lisp_Object end1, Lisp_Object str2, Lisp_Object start2, Lisp_Object end2, Lisp_Object ignore_case) { - EMACS_INT from1, to1, from2, to2; - ptrdiff_t i1, i1_byte, i2, i2_byte; + ptrdiff_t from1, to1, from2, to2, i1, i1_byte, i2, i2_byte; CHECK_STRING (str1); CHECK_STRING (str2); @@ -1114,9 +1111,9 @@ Count negative values backwards from the end. Set *IFROM and *ITO to the two indexes used. */ -static void +void validate_subarray (Lisp_Object array, Lisp_Object from, Lisp_Object to, - ptrdiff_t size, EMACS_INT *ifrom, EMACS_INT *ito) + ptrdiff_t size, ptrdiff_t *ifrom, ptrdiff_t *ito) { EMACS_INT f, t; @@ -1165,8 +1162,7 @@ (Lisp_Object string, Lisp_Object from, Lisp_Object to) { Lisp_Object res; - ptrdiff_t size; - EMACS_INT ifrom, ito; + ptrdiff_t size, ifrom, ito; if (STRINGP (string)) size = SCHARS (string); @@ -1206,9 +1202,7 @@ With one argument, just copy STRING without its properties. */) (Lisp_Object string, register Lisp_Object from, Lisp_Object to) { - ptrdiff_t size; - EMACS_INT from_char, to_char; - ptrdiff_t from_byte, to_byte; + ptrdiff_t from_char, to_char, from_byte, to_byte, size; CHECK_STRING (string); @@ -4637,12 +4631,12 @@ /* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */ static Lisp_Object -secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, Lisp_Object binary) +secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, + Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, + Lisp_Object binary) { int i; - ptrdiff_t size; - EMACS_INT start_char = 0, end_char = 0; - ptrdiff_t start_byte, end_byte; + ptrdiff_t size, start_char = 0, start_byte, end_char = 0, end_byte; register EMACS_INT b, e; register struct buffer *bp; EMACS_INT temp; === modified file 'src/lisp.h' --- src/lisp.h 2014-06-24 08:10:48 +0000 +++ src/lisp.h 2014-06-25 12:11:08 +0000 @@ -3464,7 +3464,8 @@ ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, EMACS_UINT); extern struct hash_table_test hashtest_eql, hashtest_equal; - +extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object, + ptrdiff_t, ptrdiff_t *, ptrdiff_t *); extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t); extern Lisp_Object merge (Lisp_Object, Lisp_Object, Lisp_Object); ------------------------------------------------------------ revno: 117396 committer: Dmitry Antipov branch nick: trunk timestamp: Wed 2014-06-25 14:36:51 +0400 message: Do not allow out-of-range character position in Fcompare_strings. * src/fns.c (validate_subarray): Add prototype. (Fcompare_substring): Use validate_subarray to check ranges. Adjust comment to mention that the semantics was changed. Also see http://lists.gnu.org/archive/html/emacs-devel/2014-06/msg00447.html. * lisp/files.el (dir-locals-find-file, file-relative-name): * lisp/info.el (Info-complete-menu-item): * lisp/minibuffer.el (completion-table-subvert): Prefer string-prefix-p to compare-strings to avoid out-of-range errors. * lisp/subr.el (string-prefix-p): Adjust to match strict range checking in compare-strings. * test/automated/fns-tests.el (fns-tests-compare-string): New test. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-06-25 01:29:07 +0000 +++ lisp/ChangeLog 2014-06-25 10:36:51 +0000 @@ -1,3 +1,12 @@ +2014-06-25 Dmitry Antipov + + * files.el (dir-locals-find-file, file-relative-name): + * info.el (Info-complete-menu-item): + * minibuffer.el (completion-table-subvert): Prefer string-prefix-p + to compare-strings to avoid out-of-range errors. + * subr.el (string-prefix-p): Adjust to match strict range + checking in compare-strings. + 2014-06-24 Leonard Randall (tiny change) * textmodes/reftex-parse.el (reftex-using-biblatex-p): Make search === modified file 'lisp/files.el' --- lisp/files.el 2014-06-12 02:14:45 +0000 +++ lisp/files.el 2014-06-25 10:36:51 +0000 @@ -3659,10 +3659,9 @@ ;;; (setq locals-file nil)) ;; Find the best cached value in `dir-locals-directory-cache'. (dolist (elt dir-locals-directory-cache) - (when (and (eq t (compare-strings file nil (length (car elt)) - (car elt) nil nil - (memq system-type - '(windows-nt cygwin ms-dos)))) + (when (and (string-prefix-p (car elt) file + (memq system-type + '(windows-nt cygwin ms-dos))) (> (length (car elt)) (length (car dir-elt)))) (setq dir-elt elt))) (if (and dir-elt @@ -4507,18 +4506,14 @@ (let ((ancestor ".") (filename-dir (file-name-as-directory filename))) (while (not - (or - (eq t (compare-strings filename-dir nil (length directory) - directory nil nil fold-case)) - (eq t (compare-strings filename nil (length directory) - directory nil nil fold-case)))) + (or (string-prefix-p directory filename-dir fold-case) + (string-prefix-p directory filename fold-case))) (setq directory (file-name-directory (substring directory 0 -1)) ancestor (if (equal ancestor ".") ".." (concat "../" ancestor)))) ;; Now ancestor is empty, or .., or ../.., etc. - (if (eq t (compare-strings filename nil (length directory) - directory nil nil fold-case)) + (if (string-prefix-p directory filename fold-case) ;; We matched within FILENAME's directory part. ;; Add the rest of FILENAME onto ANCESTOR. (let ((rest (substring filename (length directory)))) === modified file 'lisp/info.el' --- lisp/info.el 2014-05-11 03:49:53 +0000 +++ lisp/info.el 2014-06-25 10:36:51 +0000 @@ -2691,9 +2691,7 @@ (equal (nth 1 Info-complete-cache) Info-current-node) (equal (nth 2 Info-complete-cache) Info-complete-next-re) (equal (nth 5 Info-complete-cache) Info-complete-nodes) - (let ((prev (nth 3 Info-complete-cache))) - (eq t (compare-strings string 0 (length prev) - prev 0 nil t)))) + (string-prefix-p (nth 3 Info-complete-cache) string) t) ;; We can reuse the previous list. (setq completions (nth 4 Info-complete-cache)) ;; The cache can't be used. === modified file 'lisp/minibuffer.el' --- lisp/minibuffer.el 2014-06-02 00:18:22 +0000 +++ lisp/minibuffer.el 2014-06-25 10:36:51 +0000 @@ -244,8 +244,7 @@ form (concat S1 S) in the same way as TABLE completes strings of the form (concat S2 S)." (lambda (string pred action) - (let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil - completion-ignore-case)) + (let* ((str (if (string-prefix-p s1 string completion-ignore-case) (concat s2 (substring string (length s1))))) (res (if str (complete-with-action action table str pred)))) (when res @@ -257,8 +256,7 @@ (+ beg (- (length s1) (length s2)))) . ,(and (eq (car-safe res) 'boundaries) (cddr res))))) ((stringp res) - (if (eq t (compare-strings res 0 (length s2) s2 nil nil - completion-ignore-case)) + (if (string-prefix-p s2 string completion-ignore-case) (concat s1 (substring res (length s2))))) ((eq action t) (let ((bounds (completion-boundaries str table pred ""))) === modified file 'lisp/subr.el' --- lisp/subr.el 2014-06-15 00:06:30 +0000 +++ lisp/subr.el 2014-06-25 10:36:51 +0000 @@ -3677,12 +3677,14 @@ (setq matches (cons (substring string start l) matches)) ; leftover (apply #'concat (nreverse matches))))) -(defun string-prefix-p (str1 str2 &optional ignore-case) - "Return non-nil if STR1 is a prefix of STR2. +(defun string-prefix-p (prefix string &optional ignore-case) + "Return non-nil if PREFIX is a prefix of STRING. If IGNORE-CASE is non-nil, the comparison is done without paying attention to case differences." - (eq t (compare-strings str1 nil nil - str2 0 (length str1) ignore-case))) + (let ((prefix-length (length prefix))) + (if (> prefix-length (length string)) nil + (eq t (compare-strings prefix 0 prefix-length string + 0 prefix-length ignore-case))))) (defun string-suffix-p (suffix string &optional ignore-case) "Return non-nil if SUFFIX is a suffix of STRING. === modified file 'src/ChangeLog' --- src/ChangeLog 2014-06-24 08:10:48 +0000 +++ src/ChangeLog 2014-06-25 10:36:51 +0000 @@ -1,3 +1,11 @@ +2014-06-25 Dmitry Antipov + + Do not allow out-of-range character position in Fcompare_strings. + * fns.c (validate_subarray): Add prototype. + (Fcompare_substring): Use validate_subarray to check ranges. + Adjust comment to mention that the semantics was changed. Also see + http://lists.gnu.org/archive/html/emacs-devel/2014-06/msg00447.html. + 2014-06-24 Paul Eggert Be more consistent about the 'Qfoo' naming convention. === modified file 'src/fns.c' --- src/fns.c 2014-05-21 03:49:58 +0000 +++ src/fns.c 2014-06-25 10:36:51 +0000 @@ -50,7 +50,9 @@ static Lisp_Object Qmd5, Qsha1, Qsha224, Qsha256, Qsha384, Qsha512; static bool internal_equal (Lisp_Object, Lisp_Object, int, bool, Lisp_Object); - +static void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object, + ptrdiff_t, EMACS_INT *, EMACS_INT *); + DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, doc: /* Return the argument unchanged. */) (Lisp_Object arg) @@ -232,6 +234,7 @@ \(exclusive). If START1 is nil, it defaults to 0, the beginning of the string; if END1 is nil, it defaults to the length of the string. Likewise, in string STR2, compare the part between START2 and END2. +Like in `substring', negative values are counted from the end. The strings are compared by the numeric values of their characters. For instance, STR1 is "less than" STR2 if its first differing @@ -244,43 +247,25 @@ - 1 - N is the number of characters that match at the beginning. If string STR1 is greater, the value is a positive number N; N - 1 is the number of characters that match at the beginning. */) - (Lisp_Object str1, Lisp_Object start1, Lisp_Object end1, Lisp_Object str2, Lisp_Object start2, Lisp_Object end2, Lisp_Object ignore_case) + (Lisp_Object str1, Lisp_Object start1, Lisp_Object end1, Lisp_Object str2, + Lisp_Object start2, Lisp_Object end2, Lisp_Object ignore_case) { - register ptrdiff_t end1_char, end2_char; - register ptrdiff_t i1, i1_byte, i2, i2_byte; + EMACS_INT from1, to1, from2, to2; + ptrdiff_t i1, i1_byte, i2, i2_byte; CHECK_STRING (str1); CHECK_STRING (str2); - if (NILP (start1)) - start1 = make_number (0); - if (NILP (start2)) - start2 = make_number (0); - CHECK_NATNUM (start1); - CHECK_NATNUM (start2); - if (! NILP (end1)) - CHECK_NATNUM (end1); - if (! NILP (end2)) - CHECK_NATNUM (end2); - - end1_char = SCHARS (str1); - if (! NILP (end1) && end1_char > XINT (end1)) - end1_char = XINT (end1); - if (end1_char < XINT (start1)) - args_out_of_range (str1, start1); - - end2_char = SCHARS (str2); - if (! NILP (end2) && end2_char > XINT (end2)) - end2_char = XINT (end2); - if (end2_char < XINT (start2)) - args_out_of_range (str2, start2); - - i1 = XINT (start1); - i2 = XINT (start2); + + validate_subarray (str1, start1, end1, SCHARS (str1), &from1, &to1); + validate_subarray (str2, start2, end2, SCHARS (str2), &from2, &to2); + + i1 = from1; + i2 = from2; i1_byte = string_char_to_byte (str1, i1); i2_byte = string_char_to_byte (str2, i2); - while (i1 < end1_char && i2 < end2_char) + while (i1 < to1 && i2 < to2) { /* When we find a mismatch, we must compare the characters, not just the bytes. */ @@ -307,12 +292,8 @@ if (! NILP (ignore_case)) { - Lisp_Object tem; - - tem = Fupcase (make_number (c1)); - c1 = XINT (tem); - tem = Fupcase (make_number (c2)); - c2 = XINT (tem); + c1 = XINT (Fupcase (make_number (c1))); + c2 = XINT (Fupcase (make_number (c2))); } if (c1 == c2) @@ -322,15 +303,15 @@ past the character that we are comparing; hence we don't add or subtract 1 here. */ if (c1 < c2) - return make_number (- i1 + XINT (start1)); + return make_number (- i1 + from1); else - return make_number (i1 - XINT (start1)); + return make_number (i1 - from1); } - if (i1 < end1_char) - return make_number (i1 - XINT (start1) + 1); - if (i2 < end2_char) - return make_number (- i1 + XINT (start1) - 1); + if (i1 < to1) + return make_number (i1 - from1 + 1); + if (i2 < to2) + return make_number (- i1 + from1 - 1); return Qt; } === modified file 'test/ChangeLog' --- test/ChangeLog 2014-06-24 07:48:19 +0000 +++ test/ChangeLog 2014-06-25 10:36:51 +0000 @@ -1,3 +1,7 @@ +2014-06-25 Dmitry Antipov + + * automated/fns-tests.el (fns-tests-compare-string): New test. + 2014-06-24 Michael Albinus * automated/tramp-tests.el (tramp-test26-process-file): Extend test === modified file 'test/automated/fns-tests.el' --- test/automated/fns-tests.el 2014-05-22 01:09:51 +0000 +++ test/automated/fns-tests.el 2014-06-25 10:36:51 +0000 @@ -69,3 +69,34 @@ (nreverse A) (should (equal [nil nil nil nil nil t t t t t] (vconcat A))) (should (equal [t t t t t nil nil nil nil nil] (vconcat (nreverse A)))))) + +(ert-deftest fns-tests-compare-strings () + (should-error (compare-strings)) + (should-error (compare-strings "xyzzy" "xyzzy")) + (should-error (compare-strings "xyzzy" 0 10 "zyxxy" 0 5)) + (should-error (compare-strings "xyzzy" 0 5 "zyxxy" -1 2)) + (should-error (compare-strings "xyzzy" 'foo nil "zyxxy" 0 1)) + (should-error (compare-strings "xyzzy" 0 'foo "zyxxy" 2 3)) + (should-error (compare-strings "xyzzy" 0 2 "zyxxy" 'foo 3)) + (should-error (compare-strings "xyzzy" nil 3 "zyxxy" 4 'foo)) + (should (compare-strings "" nil nil "" nil nil)) + (should (compare-strings "" 0 0 "" 0 0)) + (should (compare-strings "test" nil nil "test" nil nil)) + (should (compare-strings "test" nil nil "test" nil nil t)) + (should (compare-strings "test" nil nil "test" nil nil nil)) + (should (compare-strings "Test" nil nil "test" nil nil t)) + (should (= (compare-strings "Test" nil nil "test" nil nil) -1)) + (should (= (compare-strings "Test" nil nil "test" nil nil) -1)) + (should (= (compare-strings "test" nil nil "Test" nil nil) 1)) + (should (= (compare-strings "foobaz" nil nil "barbaz" nil nil) 1)) + (should (= (compare-strings "barbaz" nil nil "foobar" nil nil) -1)) + (should (= (compare-strings "foobaz" nil nil "farbaz" nil nil) 2)) + (should (= (compare-strings "farbaz" nil nil "foobar" nil nil) -2)) + (should (compare-strings "abcxyz" 0 2 "abcprq" 0 2)) + (should (compare-strings "abcxyz" 0 -3 "abcprq" 0 -3)) + (should (= (compare-strings "abcxyz" 0 6 "abcprq" 0 6) 4)) + (should (= (compare-strings "abcprq" 0 6 "abcxyz" 0 6) -4)) + (should (compare-strings "xyzzy" -3 4 "azza" -3 3)) + (should (compare-strings "こんにちはｺﾝﾆﾁﾊ" nil nil "こんにちはｺﾝﾆﾁﾊ" nil nil)) + (should (= (compare-strings "んにちはｺﾝﾆﾁﾊこ" nil nil "こんにちはｺﾝﾆﾁﾊ" nil nil) 1)) + (should (= (compare-strings "こんにちはｺﾝﾆﾁﾊ" nil nil "んにちはｺﾝﾆﾁﾊこ" nil nil) -1))) ------------------------------------------------------------ revno: 117395 committer: Glenn Morris branch nick: trunk timestamp: Wed 2014-06-25 06:17:41 -0400 message: Auto-commit of loaddefs files. diff: === modified file 'lisp/textmodes/reftex.el' --- lisp/textmodes/reftex.el 2014-05-26 10:21:18 +0000 +++ lisp/textmodes/reftex.el 2014-06-25 10:17:41 +0000 @@ -2778,7 +2778,7 @@ ;;;*** -;;;### (autoloads nil "reftex-parse" "reftex-parse.el" "73f6bbd6c6d423835a7a0428204eb3f5") +;;;### (autoloads nil "reftex-parse" "reftex-parse.el" "69a531bd0ac3f97f076b7dda4ec2304d") ;;; Generated autoloads from reftex-parse.el (autoload 'reftex-parse-one "reftex-parse" "\ ------------------------------------------------------------ revno: 117394 committer: Glenn Morris branch nick: trunk timestamp: Tue 2014-06-24 23:39:03 -0700 message: nextstep: trivial Makefile simplification * nextstep/Makefile.in (${ns_appbindir}): New. (${ns_appbindir}/Emacs): Use order-only prereq to create output dir. diff: === modified file 'nextstep/ChangeLog' --- nextstep/ChangeLog 2014-06-15 00:17:21 +0000 +++ nextstep/ChangeLog 2014-06-25 06:39:03 +0000 @@ -1,3 +1,8 @@ +2014-06-25 Glenn Morris + + * Makefile.in (${ns_appbindir}): New. + (${ns_appbindir}/Emacs): Use order-only prereq to create output dir. + 2014-06-15 Glenn Morris * Makefile.in (bootstrap-clean): New. === modified file 'nextstep/Makefile.in' --- nextstep/Makefile.in 2014-06-15 00:17:21 +0000 +++ nextstep/Makefile.in 2014-06-25 06:39:03 +0000 @@ -43,9 +43,12 @@ ( cd ${ns_appdir} ; umask 022; tar xf - ) touch ${ns_appdir} -${ns_appbindir}/Emacs: ${ns_appdir} ${ns_check_file} ../src/emacs${EXEEXT} - ${MKDIR_P} ${ns_appbindir} - cp -f ../src/emacs${EXEEXT} ${ns_appbindir}/Emacs +${ns_appbindir}: + ${MKDIR_P} $@ + +${ns_appbindir}/Emacs: ${ns_appdir} ${ns_check_file} ../src/emacs${EXEEXT} | \ + ${ns_appbindir} + cp -f ../src/emacs${EXEEXT} $@ .PHONY: all ------------------------------------------------------------ Use --include-merged or -n0 to see merged revisions.