Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 102841. ------------------------------------------------------------ revno: 102841 committer: Glenn Morris branch nick: trunk timestamp: Thu 2011-01-13 18:44:25 -0800 message: * admin/bzrmerge.el: Require cl when compiling. (bzrmerge-merges): Doc fix. diff: === modified file 'admin/ChangeLog' --- admin/ChangeLog 2011-01-07 20:42:11 +0000 +++ admin/ChangeLog 2011-01-14 02:44:25 +0000 @@ -1,3 +1,8 @@ +2011-01-14 Glenn Morris + + * bzrmerge.el: Require cl when compiling. + (bzrmerge-merges): Doc fix. + 2011-01-07 Paul Eggert * notes/copyright: There's only one install-sh, not two, so fix a @@ -989,7 +994,6 @@ ;; Local Variables: ;; coding: utf-8 -;; add-log-time-zone-rule: t ;; End: Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, @@ -1009,5 +1013,3 @@ You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . - -;;; arch-tag: 97728c77-77c0-4156-b669-0e8c07d94e5a === modified file 'admin/bzrmerge.el' --- admin/bzrmerge.el 2011-01-12 04:28:12 +0000 +++ admin/bzrmerge.el 2011-01-14 02:44:25 +0000 @@ -24,8 +24,11 @@ ;;; Code: +(eval-when-compile + (require 'cl)) ; assert + (defun bzrmerge-merges () - "Return the list of already merged (not not committed) revisions. + "Return the list of already merged (not yet committed) revisions. The list returned is sorted by oldest-first." (with-current-buffer (get-buffer-create "*bzrmerge*") (erase-buffer) ------------------------------------------------------------ revno: 102840 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2011-01-13 21:12:43 -0500 message: * lisp/emacs-lisp/easymenu.el: Add :enable, and obey :label. Require CL. (easy-menu-create-menu, easy-menu-convert-item-1): Use :label rather than nil for labels. Use `case'. Add :enable as alias for :active. (easy-menu-binding): Obey :label. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-13 23:14:30 +0000 +++ lisp/ChangeLog 2011-01-14 02:12:43 +0000 @@ -1,3 +1,12 @@ +2011-01-14 Stefan Monnier + + * emacs-lisp/easymenu.el: Add :enable (bug#7754), and obey :label. + Require CL. + (easy-menu-create-menu, easy-menu-convert-item-1): + Use :label rather than nil for labels. Use `case'. + Add :enable as alias for :active. + (easy-menu-binding): Obey :label. + 2011-01-13 Stefan Monnier Use run-mode-hooks for major mode hooks (bug#513). === modified file 'lisp/emacs-lisp/easymenu.el' --- lisp/emacs-lisp/easymenu.el 2010-08-30 13:03:05 +0000 +++ lisp/emacs-lisp/easymenu.el 2011-01-14 02:12:43 +0000 @@ -1,7 +1,7 @@ ;;; easymenu.el --- support the easymenu interface for defining a menu ;; Copyright (C) 1994, 1996, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. ;; Keywords: emulations ;; Author: Richard Stallman @@ -30,6 +30,8 @@ ;;; Code: +(eval-when-compile (require 'cl)) + (defvar easy-menu-precalculate-equivalent-keybindings nil "Determine when equivalent key bindings are computed for easy-menu menus. It can take some time to calculate the equivalent key bindings that are shown @@ -66,8 +68,8 @@ :active ENABLE -ENABLE is an expression; the menu is enabled for selection -whenever this expression's value is non-nil. +ENABLE is an expression; the menu is enabled for selection whenever +this expression's value is non-nil. `:enable' is an alias for `:active'. The rest of the elements in MENU, are menu items. @@ -104,8 +106,8 @@ :active ENABLE -ENABLE is an expression; the item is enabled for selection -whenever this expression's value is non-nil. +ENABLE is an expression; the item is enabled for selection whenever +this expression's value is non-nil. `:enable' is an alias for `:active'. :visible INCLUDE @@ -163,10 +165,13 @@ (prog1 (get menu 'menu-prop) (setq menu (symbol-function menu)))))) (cons 'menu-item - (cons (or item-name - (if (keymapp menu) - (keymap-prompt menu)) - "") + (cons (if (eq :label (car props)) + (prog1 (cadr props) + (setq props (cddr props))) + (or item-name + (if (keymapp menu) + (keymap-prompt menu)) + "")) (cons menu props))))) ;;;###autoload @@ -232,15 +237,14 @@ (keywordp (setq keyword (car menu-items)))) (setq arg (cadr menu-items)) (setq menu-items (cddr menu-items)) - (cond - ((eq keyword :filter) + (case keyword + (:filter (setq filter `(lambda (menu) (easy-menu-filter-return (,arg menu) ,menu-name)))) - ((eq keyword :active) (setq enable (or arg ''nil))) - ((eq keyword :label) (setq label arg)) - ((eq keyword :help) (setq help arg)) - ((or (eq keyword :included) (eq keyword :visible)) - (setq visible (or arg ''nil))))) + ((:enable :active) (setq enable (or arg ''nil))) + (:label (setq label arg)) + (:help (setq help arg)) + ((:included :visible) (setq visible (or arg ''nil))))) (if (equal visible ''nil) nil ; Invisible menu entry, return nil. (if (and visible (not (easy-menu-always-true-p visible))) @@ -249,14 +253,14 @@ (setq prop (cons :enable (cons enable prop)))) (if filter (setq prop (cons :filter (cons filter prop)))) (if help (setq prop (cons :help (cons help prop)))) - (if label (setq prop (cons nil (cons label prop)))) - (if filter - ;; The filter expects the menu in its XEmacs form and the pre-filter - ;; form will only be passed to the filter anyway, so we'd better - ;; not convert it at all (it will be converted on the fly by - ;; easy-menu-filter-return). - (setq menu menu-items) - (setq menu (append menu (mapcar 'easy-menu-convert-item menu-items)))) + (if label (setq prop (cons :label (cons label prop)))) + (setq menu (if filter + ;; The filter expects the menu in its XEmacs form and the + ;; pre-filter form will only be passed to the filter + ;; anyway, so we'd better not convert it at all (it will + ;; be converted on the fly by easy-menu-filter-return). + menu-items + (append menu (mapcar 'easy-menu-convert-item menu-items)))) (when prop (setq menu (easy-menu-make-symbol menu 'noexp)) (put menu 'menu-prop prop)) @@ -312,7 +316,7 @@ ;; Invisible menu item. Don't insert into keymap. (setq remove t) (when (and (symbolp command) (setq prop (get command 'menu-prop))) - (when (null (car prop)) + (when (eq :label (car prop)) (setq label (cadr prop)) (setq prop (cddr prop))) (setq command (symbol-function command))))) @@ -331,30 +335,28 @@ (setq keyword (aref item count)) (setq arg (aref item (1+ count))) (setq count (+ 2 count)) - (cond - ((or (eq keyword :included) (eq keyword :visible)) - (setq visible (or arg ''nil))) - ((eq keyword :key-sequence) - (setq cache arg cache-specified t)) - ((eq keyword :keys) (setq keys arg no-name nil)) - ((eq keyword :label) (setq label arg)) - ((eq keyword :active) (setq active (or arg ''nil))) - ((eq keyword :help) (setq prop (cons :help (cons arg prop)))) - ((eq keyword :suffix) (setq suffix arg)) - ((eq keyword :style) (setq style arg)) - ((eq keyword :selected) (setq selected (or arg ''nil))))) + (case keyword + ((:included :visible) (setq visible (or arg ''nil))) + (:key-sequence (setq cache arg cache-specified t)) + (:keys (setq keys arg no-name nil)) + (:label (setq label arg)) + ((:active :enable) (setq active (or arg ''nil))) + (:help (setq prop (cons :help (cons arg prop)))) + (:suffix (setq suffix arg)) + (:style (setq style arg)) + (:selected (setq selected (or arg ''nil))))) (if suffix (setq label (if (stringp suffix) (if (stringp label) (concat label " " suffix) - (list 'concat label (concat " " suffix))) + `(concat ,label ,(concat " " suffix))) (if (stringp label) - (list 'concat (concat label " ") suffix) - (list 'concat label " " suffix))))) + `(concat ,(concat label " ") ,suffix) + `(concat ,label " " ,suffix))))) (cond ((eq style 'button) (setq label (if (stringp label) (concat "[" label "]") - (list 'concat "[" label "]")))) + `(concat "[" ,label "]")))) ((and selected (setq style (assq style easy-menu-button-prefix))) (setq prop (cons :button ------------------------------------------------------------ revno: 102839 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2011-01-13 18:14:30 -0500 message: Use run-mode-hooks for major mode hooks. * lisp/textmodes/reftex-toc.el (reftex-toc-mode-map): Rename from reftex-toc-map. (reftex-toc-mode): Use define-derived-mode. * lisp/textmodes/reftex-sel.el (reftex-select-shared-map): New map. (reftex-select-label-mode-map, reftex-select-bib-mode-map): Rename from reftex-select-(label|bib)-map. Move init into declaration. (reftex-select-label-mode, reftex-select-bib-mode): Use define-derived-mode. * lisp/textmodes/reftex-index.el (reftex-index-phrases-mode-map) (reftex-index-mode-map): Rename from reftex-index(-phrases)-map. Move init into delcaration. (reftex-index-mode, reftex-index-phrases-mode): Use define-derived-mode. * lisp/speedbar.el (speedbar-mode-syntax-table): Renaqme from speedbar-syntax-table. Move init into declaration. (speedbar-mode-map): Rename from speedbar-key-map. Move init into declaration. (speedbar-file-key-map): Move init into declaration. (speedbar-mode): Use define-derived-mode. * lisp/recentf.el (recentf-mode): Don't run hook (or message) redundantly. * lisp/net/rcirc.el (rcirc-mode): Use run-mode-hooks. * lisp/emacs-lisp/chart.el (chart-mode-map): Rename from chart-map. (chart-face-list): Move initialization into declaration. (chart-mode): Use define-derived-mode. * lisp/calculator.el (calculator-mode-map): Move init into declaration. (calculator-mode): Use define-derived-mode. * lisp/cedet/srecode/srt-mode.el (srecode-template-mode): Use define-derived-mode. * lisp/cedet/semantic/symref/list.el (semantic-symref-results-mode): Use run-mode-hooks. * lisp/erc/erc.el (erc-mode): * lisp/erc/erc-dcc.el (erc-dcc-chat-mode): Use define-derived-mode. * lisp/org/org-remember.el (org-remember-mode): * lisp/org/org-capture.el (org-capture-mode): Don't run hook redundantly. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-13 21:48:34 +0000 +++ lisp/ChangeLog 2011-01-13 23:14:30 +0000 @@ -1,5 +1,33 @@ 2011-01-13 Stefan Monnier + Use run-mode-hooks for major mode hooks (bug#513). + * textmodes/reftex-toc.el (reftex-toc-mode-map): + Rename from reftex-toc-map. + (reftex-toc-mode): Use define-derived-mode. + * textmodes/reftex-sel.el (reftex-select-shared-map): New map. + (reftex-select-label-mode-map, reftex-select-bib-mode-map): + Rename from reftex-select-(label|bib)-map. Move init into declaration. + (reftex-select-label-mode, reftex-select-bib-mode): + Use define-derived-mode. + * textmodes/reftex-index.el (reftex-index-phrases-mode-map) + (reftex-index-mode-map): Rename from reftex-index(-phrases)-map. + Move init into delcaration. + (reftex-index-mode, reftex-index-phrases-mode): + Use define-derived-mode. + * speedbar.el (speedbar-mode-syntax-table): Renaqme from + speedbar-syntax-table. Move init into declaration. + (speedbar-mode-map): Rename from speedbar-key-map. + Move init into declaration. + (speedbar-file-key-map): Move init into declaration. + (speedbar-mode): Use define-derived-mode. + * recentf.el (recentf-mode): Don't run hook (or message) redundantly. + * net/rcirc.el (rcirc-mode): Use run-mode-hooks. + * emacs-lisp/chart.el (chart-mode-map): Rename from chart-map. + (chart-face-list): Move initialization into declaration. + (chart-mode): Use define-derived-mode. + * calculator.el (calculator-mode-map): Move init into declaration. + (calculator-mode): Use define-derived-mode. + * mail/mail-utils.el (mail-strip-quoted-names): Make the regexp code work for nested comments. === modified file 'lisp/calculator.el' --- lisp/calculator.el 2010-09-23 19:00:31 +0000 +++ lisp/calculator.el 2011-01-13 23:14:30 +0000 @@ -1,7 +1,7 @@ ;;; calculator.el --- a [not so] simple calculator for Emacs ;; Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, -;; 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2008, 2009, 2010, 2011 Free Software Foundation, Inc. ;; Author: Eli Barzilay ;; Keywords: tools, convenience @@ -382,10 +382,7 @@ ;;;--------------------------------------------------------------------- ;;; Key bindings -(defvar calculator-mode-map nil - "The calculator key map.") - -(or calculator-mode-map +(defvar calculator-mode-map (let ((map (make-sparse-keymap))) (suppress-keymap map t) (define-key map "i" nil) @@ -471,113 +468,114 @@ ("Binary" bin "B") ("Octal" oct "O") ("Hexadecimal" hex "H")))) - (op '(lambda (name key) - `[,name (calculator-op ,key) :keys ,key]))) + (op (lambda (name key) + `[,name (calculator-op ,key) :keys ,key]))) (easy-menu-define - calculator-menu map "Calculator menu." - `("Calculator" - ["Help" - (let ((last-command 'calculator-help)) (calculator-help)) - :keys "?"] - "---" - ["Copy" calculator-copy] - ["Paste" calculator-paste] - "---" - ["Electric mode" - (progn (calculator-quit) - (setq calculator-restart-other-mode t) - (run-with-timer 0.1 nil '(lambda () (message nil))) - ;; the message from the menu will be visible, - ;; couldn't make it go away... - (calculator)) - :active (not calculator-electric-mode)] - ["Normal mode" - (progn (setq calculator-restart-other-mode t) - (calculator-quit)) - :active calculator-electric-mode] - "---" - ("Functions" - ,(funcall op "Repeat-right" ">") - ,(funcall op "Repeat-left" "<") - "------General------" - ,(funcall op "Reciprocal" ";") - ,(funcall op "Log" "L") - ,(funcall op "Square-root" "Q") - ,(funcall op "Factorial" "!") - "------Trigonometric------" - ,(funcall op "Sinus" "S") - ,(funcall op "Cosine" "C") - ,(funcall op "Tangent" "T") - ,(funcall op "Inv-Sinus" "IS") - ,(funcall op "Inv-Cosine" "IC") - ,(funcall op "Inv-Tangent" "IT") - "------Bitwise------" - ,(funcall op "Or" "|") - ,(funcall op "Xor" "#") - ,(funcall op "And" "&") - ,(funcall op "Not" "~")) - ("Saved List" - ["Eval+Save" calculator-save-on-list] - ["Prev number" calculator-saved-up] - ["Next number" calculator-saved-down] - ["Delete current" calculator-clear - :active (and calculator-display-fragile - calculator-saved-list - (= (car calculator-stack) - (nth calculator-saved-ptr - calculator-saved-list)))] - ["Delete all" calculator-clear-saved] - "---" - ,(funcall op "List-total" "l") - ,(funcall op "List-average" "v")) - ("Registers" - ["Get register" calculator-get-register] - ["Set register" calculator-set-register]) - ("Modes" - ["Radians" - (progn - (and (or calculator-input-radix calculator-output-radix) - (calculator-radix-mode "D")) - (and calculator-deg (calculator-dec/deg-mode))) - :keys "D" - :style radio - :selected (not (or calculator-input-radix - calculator-output-radix - calculator-deg))] - ["Degrees" - (progn - (and (or calculator-input-radix calculator-output-radix) - (calculator-radix-mode "D")) - (or calculator-deg (calculator-dec/deg-mode))) - :keys "D" - :style radio - :selected (and calculator-deg - (not (or calculator-input-radix - calculator-output-radix)))] - "---" - ,@(mapcar 'car radix-selectors) - ("Separate I/O" - ,@(mapcar (lambda (x) (nth 1 x)) radix-selectors) - "---" - ,@(mapcar (lambda (x) (nth 2 x)) radix-selectors))) - ("Decimal Display" - ,@(mapcar (lambda (d) - (vector (cadr d) - ;; Note: inserts actual object here - `(calculator-rotate-displayer ',d))) - calculator-displayers) - "---" - ["Change Prev Display" calculator-displayer-prev] - ["Change Next Display" calculator-displayer-next]) - "---" - ["Copy+Quit" calculator-save-and-quit] - ["Quit" calculator-quit])))) - (setq calculator-mode-map map))) + calculator-menu map "Calculator menu." + `("Calculator" + ["Help" + (let ((last-command 'calculator-help)) (calculator-help)) + :keys "?"] + "---" + ["Copy" calculator-copy] + ["Paste" calculator-paste] + "---" + ["Electric mode" + (progn (calculator-quit) + (setq calculator-restart-other-mode t) + (run-with-timer 0.1 nil '(lambda () (message nil))) + ;; the message from the menu will be visible, + ;; couldn't make it go away... + (calculator)) + :active (not calculator-electric-mode)] + ["Normal mode" + (progn (setq calculator-restart-other-mode t) + (calculator-quit)) + :active calculator-electric-mode] + "---" + ("Functions" + ,(funcall op "Repeat-right" ">") + ,(funcall op "Repeat-left" "<") + "------General------" + ,(funcall op "Reciprocal" ";") + ,(funcall op "Log" "L") + ,(funcall op "Square-root" "Q") + ,(funcall op "Factorial" "!") + "------Trigonometric------" + ,(funcall op "Sinus" "S") + ,(funcall op "Cosine" "C") + ,(funcall op "Tangent" "T") + ,(funcall op "Inv-Sinus" "IS") + ,(funcall op "Inv-Cosine" "IC") + ,(funcall op "Inv-Tangent" "IT") + "------Bitwise------" + ,(funcall op "Or" "|") + ,(funcall op "Xor" "#") + ,(funcall op "And" "&") + ,(funcall op "Not" "~")) + ("Saved List" + ["Eval+Save" calculator-save-on-list] + ["Prev number" calculator-saved-up] + ["Next number" calculator-saved-down] + ["Delete current" calculator-clear + :active (and calculator-display-fragile + calculator-saved-list + (= (car calculator-stack) + (nth calculator-saved-ptr + calculator-saved-list)))] + ["Delete all" calculator-clear-saved] + "---" + ,(funcall op "List-total" "l") + ,(funcall op "List-average" "v")) + ("Registers" + ["Get register" calculator-get-register] + ["Set register" calculator-set-register]) + ("Modes" + ["Radians" + (progn + (and (or calculator-input-radix calculator-output-radix) + (calculator-radix-mode "D")) + (and calculator-deg (calculator-dec/deg-mode))) + :keys "D" + :style radio + :selected (not (or calculator-input-radix + calculator-output-radix + calculator-deg))] + ["Degrees" + (progn + (and (or calculator-input-radix calculator-output-radix) + (calculator-radix-mode "D")) + (or calculator-deg (calculator-dec/deg-mode))) + :keys "D" + :style radio + :selected (and calculator-deg + (not (or calculator-input-radix + calculator-output-radix)))] + "---" + ,@(mapcar 'car radix-selectors) + ("Separate I/O" + ,@(mapcar (lambda (x) (nth 1 x)) radix-selectors) + "---" + ,@(mapcar (lambda (x) (nth 2 x)) radix-selectors))) + ("Decimal Display" + ,@(mapcar (lambda (d) + (vector (cadr d) + ;; Note: inserts actual object here + `(calculator-rotate-displayer ',d))) + calculator-displayers) + "---" + ["Change Prev Display" calculator-displayer-prev] + ["Change Next Display" calculator-displayer-next]) + "---" + ["Copy+Quit" calculator-save-and-quit] + ["Quit" calculator-quit])))) + map) + "The calculator key map.") ;;;--------------------------------------------------------------------- ;;; Startup and mode stuff -(defun calculator-mode () +(define-derived-mode calculator-mode fundamental-mode "Calculator" ;; this help is also used as the major help screen "A [not so] simple calculator for Emacs. @@ -671,13 +669,7 @@ See the documentation for these variables, and \"calculator.el\" for more information. -\\{calculator-mode-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'calculator-mode) - (setq mode-name "Calculator") - (use-local-map calculator-mode-map) - (run-mode-hooks 'calculator-mode-hook)) +\\{calculator-mode-map}") (eval-when-compile (require 'electric) (require 'ehelp)) === modified file 'lisp/cedet/ChangeLog' --- lisp/cedet/ChangeLog 2010-11-12 03:23:58 +0000 +++ lisp/cedet/ChangeLog 2011-01-13 23:14:30 +0000 @@ -1,3 +1,9 @@ +2011-01-13 Stefan Monnier + + * srecode/srt-mode.el (srecode-template-mode): Use define-derived-mode. + * semantic/symref/list.el (semantic-symref-results-mode): + Use run-mode-hooks. + 2010-11-12 Glenn Morris * semantic/wisent/comp.el: Remove unnecessary eval-when-compiles. @@ -60,8 +66,8 @@ * semantic/db-typecache.el (semanticdb-typecache-find-default): * semantic/imenu.el (semantic-create-imenu-index): * semantic/grammar.el (semantic--grammar-macro-function-tag): - * semantic/fw.el (semanticdb-without-unloaded-file-searches): Fix - require. Suggested by David Engster. + * semantic/fw.el (semanticdb-without-unloaded-file-searches): + Fix require. Suggested by David Engster. * semantic/bovine/c-by.el: Regenerate. @@ -105,8 +111,8 @@ * srecode/texi.el (srecode-texi-insert-tag-as-doc): New function. (semantic-insert-foreign-tag): Use it. - * srecode/mode.el (srecode-bind-insert): Call - srecode-load-tables-for-mode. + * srecode/mode.el (srecode-bind-insert): + Call srecode-load-tables-for-mode. (srecode-minor-mode-templates-menu): Do not list templates that are not in the current project. (srecode-menu-bar): Add binding for srecode-macro-help. @@ -159,8 +165,8 @@ compare of built-in templates. Give built-ins lower piority. Support special variable "project". (srecode-compile-template-table): Set :project slot of new tables. - (srecode-compile-one-template-tag): Use - srecode-create-dictionaries-from-tags. + (srecode-compile-one-template-tag): + Use srecode-create-dictionaries-from-tags. 2010-09-21 Eric Ludlam @@ -210,8 +216,8 @@ (autoconf-new-automake-string): Deleted. (autoconf-new-program): Use SRecode to fill an empty file. - * ede/cpp-root.el (ede-create-lots-of-projects-under-dir): New - function. + * ede/cpp-root.el (ede-create-lots-of-projects-under-dir): + New function. * ede/files.el (ede-flush-project-hash): New command. (ede-convert-path): Add optional PROJECT arg. @@ -232,8 +238,8 @@ list whether or not the vars are already in the Makefile. (ede-pmake-insert-variable-once): New macro. - * ede/project-am.el (project-am-with-makefile-current): Add - recentf-exclude. + * ede/project-am.el (project-am-with-makefile-current): + Add recentf-exclude. (project-am-load-makefile): Obey an optional suggested name. (project-am-expand-subdirlist): New function. (project-am-makefile::project-rescan): Use it. Combine SUBDIRS @@ -248,16 +254,16 @@ (project-am-extract-package-info): Fix separators. * ede/proj.el (project-run-target): New method. - (project-make-dist, project-compile-project): Use - ede-proj-automake-p to determine which kind of compile to use. + (project-make-dist, project-compile-project): + Use ede-proj-automake-p to determine which kind of compile to use. (project-rescan): Call ede-load-project-file. (ede-buffer-mine): Add more file names that belong to the project. (ede-proj-compilers): Improve error message. * ede/proj-obj.el (ede-ld-linker): Use the LDDEPS variable. (ede-source-c++): Add more C++ extensions. - (ede-proj-target-makefile-objectcode): Quote initforms. Support - lex and yacc. + (ede-proj-target-makefile-objectcode): Quote initforms. + Support lex and yacc. * ede/proj-prog.el (ede-proj-makefile-insert-rules): Removed. (ede-proj-makefile-insert-variables): New, add LDDEPS. @@ -267,8 +273,8 @@ they show up in the same order as in the command line. (ede-proj-target-makefile-program): Add ldlibs-local slot. - * ede/proj-shared.el (ede-g++-libtool-shared-compiler): Fix - inference rule to use cpp files. + * ede/proj-shared.el (ede-g++-libtool-shared-compiler): + Fix inference rule to use cpp files. (ede-proj-target-makefile-shared-object): Quote initforms. * ede/proj-misc.el (ede-proj-target-makefile-miscelaneous): @@ -327,8 +333,8 @@ (semantic-analyze-scoped-inherited-tag-map): Take the tag we are looking for as part of the scoped tags list. - * semantic/html.el (semantic-default-html-setup): Add - senator-step-at-tag-classes. + * semantic/html.el (semantic-default-html-setup): + Add senator-step-at-tag-classes. * semantic/decorate/include.el (semantic-decoration-on-unknown-includes): Change light bgcolor. @@ -355,8 +361,8 @@ * semantic/util.el (semantic-hack-search) (semantic-recursive-find-nonterminal-by-name) (semantic-current-tag-interactive): Deleted. - (semantic-describe-buffer): Fix expand-nonterminal. Add - lex-syntax-mods, type relation separator char, and command + (semantic-describe-buffer): Fix expand-nonterminal. + Add lex-syntax-mods, type relation separator char, and command separation char. (semantic-sanity-check): Only message if called interactively. @@ -372,8 +378,8 @@ * semantic/idle.el: Add breadcrumbs support. (semantic-idle-summary-current-symbol-info-default) (semantic-idle-tag-highlight) - (semantic-idle-completion-list-default): Use - semanticdb-without-unloaded-file-searches for speed, and to + (semantic-idle-completion-list-default): + Use semanticdb-without-unloaded-file-searches for speed, and to conform to the controls that specify if the idle timer is supposed to be parsing unparsed includes. (semantic-idle-symbol-highlight-face) @@ -448,8 +454,8 @@ (semantic-analyze-find-tag-sequence-default): Be robust to calculated scopes being nil. - * semantic/bovine/c.el (semantic-c-describe-environment): Add - project macro symbol array. + * semantic/bovine/c.el (semantic-c-describe-environment): + Add project macro symbol array. (semantic-c-parse-lexical-token): Add recursion limit. (semantic-ctxt-imported-packages, semanticdb-expand-nested-tag): New overrides. @@ -458,8 +464,8 @@ (semantic-expand-c-tag-namelist): Do not split out a typedef'd inline type if it is an anonymous type. (semantic-c-reconstitute-token): Use the optional initializers as - a clue that some function is probably a constructor. When - defining the type of these constructors, split the parent name, + a clue that some function is probably a constructor. + When defining the type of these constructors, split the parent name, and use only the class part, if applicable. * semantic/bovine/c-by.el: @@ -594,8 +600,8 @@ * semantic/db-find.el (semanticdb-find-translate-path-brutish-default): - * ede/make.el (ede-make-check-version): Use - with-current-buffer instead of save-excursion. + * ede/make.el (ede-make-check-version): + Use with-current-buffer instead of save-excursion. 2010-02-24 Eduard Wiebe @@ -783,8 +789,8 @@ * ede.el (ede-apply-preprocessor-map): Accept lists of ede-objects as targets. - * ede/pmake.el (ede-proj-makefile-insert-variables): Output - a target's object list even if compiler vars are already in the + * ede/pmake.el (ede-proj-makefile-insert-variables): + Output a target's object list even if compiler vars are already in the Makefile. * ede/emacs.el (ede-preprocessor-map): Add config.h to the @@ -880,8 +886,8 @@ 2009-11-08 Chong Yidong - * semantic/ctxt.el (semantic-get-local-variables): Disable - the progress reporter entirely. + * semantic/ctxt.el (semantic-get-local-variables): + Disable the progress reporter entirely. 2009-11-03 Stefan Monnier === modified file 'lisp/cedet/semantic/symref/list.el' --- lisp/cedet/semantic/symref/list.el 2010-10-31 14:40:01 +0000 +++ lisp/cedet/semantic/symref/list.el 2011-01-13 23:14:30 +0000 @@ -1,6 +1,6 @@ ;;; semantic/symref/list.el --- Symref Output List UI. -;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2008, 2009, 2010, 2011 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam @@ -189,6 +189,7 @@ "The current results in a results mode buffer.") (defun semantic-symref-results-mode (results) + ;; FIXME: Use define-derived-mode. "Major-mode for displaying Semantic Symbol Reference RESULTS. RESULTS is an object of class `semantic-symref-results'." (interactive) @@ -204,7 +205,7 @@ (buffer-disable-undo) (set (make-local-variable 'font-lock-global-modes) nil) (font-lock-mode -1) - (run-hooks 'semantic-symref-results-mode-hook) + (run-mode-hooks 'semantic-symref-results-mode-hook) ) (defun semantic-symref-hide-buffer () === modified file 'lisp/cedet/srecode/srt-mode.el' --- lisp/cedet/srecode/srt-mode.el 2010-01-13 08:35:10 +0000 +++ lisp/cedet/srecode/srt-mode.el 2011-01-13 23:14:30 +0000 @@ -1,6 +1,6 @@ ;;; srecode/srt-mode.el --- Major mode for writing screcode macros -;; Copyright (C) 2005, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2005, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -183,27 +183,20 @@ "Keymap used in srecode mode.") ;;;###autoload -(defun srecode-template-mode () +(define-derived-mode srecode-template-mode fundamental-mode "SRecorder" "Major-mode for writing SRecode macros." - (interactive) - (kill-all-local-variables) - (setq major-mode 'srecode-template-mode - mode-name "SRecoder" - comment-start ";;" + (setq comment-start ";;" comment-end "") (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'comment-start-skip) "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") - (set-syntax-table srecode-template-mode-syntax-table) - (use-local-map srecode-template-mode-map) (set (make-local-variable 'font-lock-defaults) '(srecode-font-lock-keywords nil ;; perform string/comment fontification nil ;; keywords are case sensitive. ;; This puts _ & - as a word constituant, ;; simplifying our keywords significantly - ((?_ . "w") (?- . "w")))) - (run-hooks 'srecode-template-mode-hook)) + ((?_ . "w") (?- . "w"))))) ;;;###autoload (defalias 'srt-mode 'srecode-template-mode) === modified file 'lisp/dired.el' --- lisp/dired.el 2011-01-09 19:34:20 +0000 +++ lisp/dired.el 2011-01-13 23:14:30 +0000 @@ -4021,7 +4021,7 @@ ;;;*** ;;;### (autoloads (dired-do-relsymlink dired-jump) "dired-x" "dired-x.el" -;;;;;; "27c312d6d5d40d8cb4ef8d62e30d5f4a") +;;;;;; "6181a5bcc2b61255676a7a41549b9f40") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\ === modified file 'lisp/emacs-lisp/chart.el' --- lisp/emacs-lisp/chart.el 2010-11-07 01:36:33 +0000 +++ lisp/emacs-lisp/chart.el 2011-01-13 23:14:30 +0000 @@ -1,7 +1,7 @@ ;;; chart.el --- Draw charts (bar charts, etc) ;; Copyright (C) 1996, 1998, 1999, 2001, 2004, 2005, 2007, 2008, 2009, -;; 2010 Free Software Foundation, Inc. +;; 2010, 2011 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam ;; Version: 0.2 @@ -62,17 +62,13 @@ (require 'eieio) ;;; Code: -(defvar chart-map (make-sparse-keymap) "Keymap used in chart mode.") +(defvar chart-mode-map (make-sparse-keymap) "Keymap used in chart mode.") +(define-obsolete-variable-alias 'chart-map 'chart-mode-map "24.1") (defvar chart-local-object nil "Local variable containing the locally displayed chart object.") (make-variable-buffer-local 'chart-local-object) -(defvar chart-face-list nil - "Faces used to colorize charts. -List is limited currently, which is ok since you really can't display -too much in text characters anyways.") - (defvar chart-face-color-list '("red" "green" "blue" "cyan" "yellow" "purple") "Colors to use when generating `chart-face-list'. @@ -90,41 +86,42 @@ :group 'eieio :type 'boolean) -(if (and (if (fboundp 'display-color-p) - (display-color-p) - window-system) - (not chart-face-list)) - (let ((cl chart-face-color-list) - (pl chart-face-pixmap-list) - nf) - (while cl - (setq nf (make-face (intern (concat "chart-" (car cl) "-" (car pl))))) - (if (condition-case nil - (> (x-display-color-cells) 4) - (error t)) - (set-face-background nf (car cl)) - (set-face-background nf "white")) - (set-face-foreground nf "black") - (if (and chart-face-use-pixmaps - pl - (fboundp 'set-face-background-pixmap)) - (condition-case nil - (set-face-background-pixmap nf (car pl)) - (error (message "Cannot set background pixmap %s" (car pl))))) - (setq chart-face-list (cons nf chart-face-list)) - (setq cl (cdr cl) - pl (cdr pl))))) +(defvar chart-face-list + (if (if (fboundp 'display-color-p) + (display-color-p) + window-system) + (let ((cl chart-face-color-list) + (pl chart-face-pixmap-list) + (faces ()) + nf) + (while cl + (setq nf (make-face + (intern (concat "chart-" (car cl) "-" (car pl))))) + (set-face-background nf (if (condition-case nil + (> (x-display-color-cells) 4) + (error t)) + (car cl) + "white")) + (set-face-foreground nf "black") + (if (and chart-face-use-pixmaps + pl + (fboundp 'set-face-background-pixmap)) + (condition-case nil + (set-face-background-pixmap nf (car pl)) + (error (message "Cannot set background pixmap %s" (car pl))))) + (push nf faces) + (setq cl (cdr cl) + pl (cdr pl))) + faces)) + "Faces used to colorize charts. +List is limited currently, which is ok since you really can't display +too much in text characters anyways.") -(defun chart-mode () +(define-derived-mode chart-mode fundamental-mode "CHART" "Define a mode in Emacs for displaying a chart." - (kill-all-local-variables) - (use-local-map chart-map) - (setq major-mode 'chart-mode - mode-name "CHART") (buffer-disable-undo) (set (make-local-variable 'font-lock-global-modes) nil) - (font-lock-mode -1) - (run-hooks 'chart-mode-hook) + (font-lock-mode -1) ;Isn't it off already? --Stef ) (defun chart-new-buffer (obj) === modified file 'lisp/erc/ChangeLog' --- lisp/erc/ChangeLog 2010-11-11 03:50:20 +0000 +++ lisp/erc/ChangeLog 2011-01-13 23:14:30 +0000 @@ -1,3 +1,8 @@ +2011-01-13 Stefan Monnier + + * erc.el (erc-mode): + * erc-dcc.el (erc-dcc-chat-mode): Use define-derived-mode. + 2010-11-11 Glenn Morris * erc-lang.el (erc-cmd-LANG): Fix what may have been a typo. @@ -25,17 +30,17 @@ 2010-08-14 Vivek Dasmohapatra * erc-join.el (erc-autojoin-timing, erc-autojoin-delay): New vars. - (erc-autojoin-channels-delayed, erc-autojoin-after-ident): New - functions. + (erc-autojoin-channels-delayed, erc-autojoin-after-ident): + New functions. (erc-autojoin-channels): Allow autojoining after ident (Bug#5521). 2010-08-08 Fran Litterio - * erc-backend.el (erc-server-filter-function): Call - erc-log-irc-protocol. + * erc-backend.el (erc-server-filter-function): + Call erc-log-irc-protocol. - * erc.el (erc-toggle-debug-irc-protocol): Bind - erc-toggle-debug-irc-protocol to t. + * erc.el (erc-toggle-debug-irc-protocol): + Bind erc-toggle-debug-irc-protocol to t. 2010-05-07 Chong Yidong @@ -126,7 +131,7 @@ See ChangeLog.08 for earlier changes. - Copyright (C) 2009, 2010 Free Software Foundation, Inc. + Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. This file is part of GNU Emacs. === modified file 'lisp/erc/erc-dcc.el' --- lisp/erc/erc-dcc.el 2010-01-13 08:35:10 +0000 +++ lisp/erc/erc-dcc.el 2011-01-13 23:14:30 +0000 @@ -1,7 +1,7 @@ ;;; erc-dcc.el --- CTCP DCC module for ERC ;; Copyright (C) 1993, 1994, 1995, 1998, 2002, 2003, 2004, 2006, 2007, -;; 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2008, 2009, 2010, 2011 Free Software Foundation, Inc. ;; Author: Ben A. Mesander ;; Noah Friedman @@ -1098,17 +1098,11 @@ map) "Keymap for `erc-dcc-mode'.") -(defun erc-dcc-chat-mode () +(define-derived-mode erc-dcc-chat-mode fundamental-mode "DCC-Chat" "Major mode for wasting time via DCC chat." - (interactive) - (kill-all-local-variables) (setq mode-line-process '(":%s") - mode-name "DCC-Chat" - major-mode 'erc-dcc-chat-mode erc-send-input-line-function 'erc-dcc-chat-send-input-line - erc-default-recipients '(dcc)) - (use-local-map erc-dcc-chat-mode-map) - (run-hooks 'erc-dcc-chat-mode-hook)) + erc-default-recipients '(dcc))) (defun erc-dcc-chat-send-input-line (recipient line &optional force) "Send LINE to the remote end. === modified file 'lisp/erc/erc.el' --- lisp/erc/erc.el 2010-08-29 20:10:43 +0000 +++ lisp/erc/erc.el 2011-01-13 23:14:30 +0000 @@ -1,7 +1,7 @@ ;; erc.el --- An Emacs Internet Relay Chat client ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. ;; Author: Alexander L. Belikoff (alexander@belikoff.net) ;; Contributors: Sergey Berezin (sergey.berezin@cs.cmu.edu), @@ -1439,28 +1439,16 @@ ;; Mode activation routines -(defun erc-mode () - "Major mode for Emacs IRC. -Special commands: - -\\{erc-mode-map} - -Turning on `erc-mode' runs the hook `erc-mode-hook'." - (kill-all-local-variables) - (use-local-map erc-mode-map) - (setq mode-name "ERC" - major-mode 'erc-mode - local-abbrev-table erc-mode-abbrev-table) - (set-syntax-table erc-mode-syntax-table) +(define-derived-mode erc-mode fundamental-mode "ERC" + "Major mode for Emacs IRC." + (setq local-abbrev-table erc-mode-abbrev-table) (when (boundp 'next-line-add-newlines) (set (make-local-variable 'next-line-add-newlines) nil)) (setq line-move-ignore-invisible t) (set (make-local-variable 'paragraph-separate) (concat "\C-l\\|\\(^" (regexp-quote (erc-prompt)) "\\)")) (set (make-local-variable 'paragraph-start) - (concat "\\(" (regexp-quote (erc-prompt)) "\\)")) - ;; Run the mode hooks - (run-hooks 'erc-mode-hook)) + (concat "\\(" (regexp-quote (erc-prompt)) "\\)"))) ;; activation === modified file 'lisp/net/rcirc.el' --- lisp/net/rcirc.el 2010-09-12 11:06:19 +0000 +++ lisp/net/rcirc.el 2011-01-13 23:14:30 +0000 @@ -1,6 +1,6 @@ ;;; rcirc.el --- default, simple IRC client. -;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 +;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011 ;; Free Software Foundation, Inc. ;; Author: Ryan Yeske @@ -895,6 +895,7 @@ This number is independent of the number of lines in the buffer.") (defun rcirc-mode (process target) + ;; FIXME: Use define-derived-mode. "Major mode for IRC channel buffers. \\{rcirc-mode-map}" @@ -973,7 +974,7 @@ (add-hook 'completion-at-point-functions 'rcirc-completion-at-point nil 'local) - (run-hooks 'rcirc-mode-hook)) + (run-mode-hooks 'rcirc-mode-hook)) (defun rcirc-update-prompt (&optional all) "Reset the prompt string in the current buffer. === modified file 'lisp/org/ChangeLog' --- lisp/org/ChangeLog 2011-01-09 21:24:07 +0000 +++ lisp/org/ChangeLog 2011-01-13 23:14:30 +0000 @@ -1,3 +1,8 @@ +2011-01-13 Stefan Monnier + + * org-remember.el (org-remember-mode): + * org-capture.el (org-capture-mode): Don't run hook redundantly. + 2011-01-09 Chong Yidong * org-faces.el (org-link): Inherit from link face. @@ -263,8 +268,8 @@ 2010-12-11 Sébastien Vauban - * org.el (org-complete-tags-always-offer-all-agenda-tags): Fix - docstring. + * org.el (org-complete-tags-always-offer-all-agenda-tags): + Fix docstring. 2010-12-11 Julien Danjou @@ -280,10 +285,10 @@ 2010-12-11 Nicolas Goaziou - * org-latex.el (org-export-latex-lists): do not add an + * org-latex.el (org-export-latex-lists): Do not add an unnecessary newline character after a list. - * org-list.el (org-list-bottom-point-with-indent): ensure bottom + * org-list.el (org-list-bottom-point-with-indent): Ensure bottom point is just after a non blank line. 2010-12-11 Eric Schulte @@ -323,7 +328,7 @@ 2010-12-11 Eric Schulte - * ob-eval.el (org-babel-eval-wipe-error-buffer): Fixed compiler + * ob-eval.el (org-babel-eval-wipe-error-buffer): Fix compiler warning and added documentation string. 2010-12-11 Eric Schulte @@ -376,8 +381,8 @@ 2010-12-11 Eric Schulte - * ob-python.el (org-babel-python-table-or-string): Using - `org-babel-script-escape' for reading string input from scripting + * ob-python.el (org-babel-python-table-or-string): + Using `org-babel-script-escape' for reading string input from scripting languages. 2010-12-11 Achim Gratz (tiny change) @@ -388,7 +393,7 @@ 2010-12-11 Eric Schulte - * ob.el (org-babel-parse-header-arguments): Removed addition of + * ob.el (org-babel-parse-header-arguments): Remove addition of ":" to singleton first header arguments as it was leading to errors. 2010-12-11 Carsten Dominik @@ -419,7 +424,7 @@ 2010-12-11 Achim Gratz (tiny change) - * org-clock.el (org-get-clocktable): previous patch incorrectly + * org-clock.el (org-get-clocktable): Previous patch incorrectly required whitespace in front of #+BEGIN: and #+END: 2010-12-11 Dan Davison @@ -429,12 +434,12 @@ 2010-12-11 Nicolas Goaziou - * org-list.el (org-cycle-list-bullet): ensure point is at bol before + * org-list.el (org-cycle-list-bullet): Ensure point is at bol before checking item indentation. 2010-12-11 Eric Schulte - * ob.el (org-babel-map-src-blocks): Moved to earlier in the file + * ob.el (org-babel-map-src-blocks): Move to earlier in the file and now autoloading. 2010-12-11 Eric Schulte @@ -512,7 +517,7 @@ 2010-12-11 Noorul Islam * org-latex.el (org-export-latex-hyperref-format): New option. - (org-export-latex-href-format): Renamed the existing variable + (org-export-latex-href-format): Rename the existing variable `org-export-latex-hyperref-format' as `org-export-latex-href-format' (org-export-latex-links): Use `org-export-latex-hyperref-format' and `org-export-latex-href-format' @@ -650,8 +655,8 @@ * org.el (org-shorten-string): New function. * org-exp.el (org-export-convert-protected-spaces): New function. - (org-export-preprocess-string): Call - `org-export-convert-protected-spaces' to handle new hard spaces. + (org-export-preprocess-string): + Call `org-export-convert-protected-spaces' to handle new hard spaces. 2010-12-11 David Maus @@ -731,8 +736,8 @@ 2010-11-11 Dan Davison - * org-exp.el (org-export-format-source-code-or-example): Use - minted for latex source code export if `org-export-latex-listings' + * org-exp.el (org-export-format-source-code-or-example): + Use minted for latex source code export if `org-export-latex-listings' has the value 'minted * org-latex.el (org-export-latex-listings): Document special value @@ -747,8 +752,8 @@ 2010-11-11 Eric Schulte - * ob-gnuplot.el (org-babel-variable-assignments:gnuplot): Fixed - bug in gnuplot data file assignment using user variables. + * ob-gnuplot.el (org-babel-variable-assignments:gnuplot): + Fix bug in gnuplot data file assignment using user variables. 2010-11-11 Eric Schulte @@ -792,7 +797,7 @@ 2010-11-11 Eric Schulte - * ob-clojure.el (org-babel-clojure-babel-clojure-cmd): Fixed error + * ob-clojure.el (org-babel-clojure-babel-clojure-cmd): Fix error message when clojure binary is not found. 2010-11-11 Carsten Dominik @@ -822,8 +827,8 @@ 2010-11-11 David Maus - * ob-haskell.el (org-babel-variable-assignments:haskell): Don't - pass more than two arguments to mapc. + * ob-haskell.el (org-babel-variable-assignments:haskell): + Don't pass more than two arguments to mapc. 2010-11-11 David Maus @@ -910,8 +915,8 @@ 2010-11-11 Carsten Dominik - * org-indent.el (org-indent-add-properties): Use - `with-silent-modificatons'. + * org-indent.el (org-indent-add-properties): + Use `with-silent-modificatons'. (org-indent-remove-properties): Use `with-silent-modificatons'. 2010-11-11 Carsten Dominik @@ -919,8 +924,8 @@ * org-table.el (org-table-cookie-line-p): Fix indentation. * org-exp.el (org-store-forced-table-alignment): New function. - (org-export-preprocess-string): Call - `org-store-forced-table-alignment'. + (org-export-preprocess-string): + Call `org-store-forced-table-alignment'. * org-html.el (org-format-org-table-html): Use stored alignment information. @@ -932,7 +937,7 @@ 2010-11-11 Eric Schulte - * ob.el (org-babel-execute-src-block): Removed needless param + * ob.el (org-babel-execute-src-block): Remove needless param sorting from ob-execute-src-block, the params are sorted already by ob-sha1-hash. @@ -974,7 +979,7 @@ 2010-11-11 Eric Schulte - * ob.el (org-babel-map-src-blocks): Fixed minor bug in and + * ob.el (org-babel-map-src-blocks): Fix minor bug in and improved efficiency of org-babel-map-src-blocks. 2010-11-11 Eric Schulte @@ -1293,7 +1298,7 @@ 2010-11-11 Eric Schulte - * ob.el (org-babel-merge-params): Fixed order or precedence for + * ob.el (org-babel-merge-params): Fix order or precedence for variables. 2010-11-11 Eric Schulte @@ -1477,16 +1482,16 @@ 2010-11-11 Eric Schulte - * ob-emacs-lisp.el (org-babel-expand-body:emacs-lisp): Whitespace - (org-babel-execute:emacs-lisp): Whitespace. + * ob-emacs-lisp.el (org-babel-expand-body:emacs-lisp): + Whitespace (org-babel-execute:emacs-lisp): Whitespace. 2010-11-11 Dan Davison * ob-sh.el (org-babel-sh-variable-assignments): Provide missing docstring - * ob-python.el (org-babel-python-variable-assignments): Provide - missing docstring. + * ob-python.el (org-babel-python-variable-assignments): + Provide missing docstring. 2010-11-11 Dan Davison @@ -1534,9 +1539,8 @@ 2010-11-11 Eric Schulte - * ob.el (org-number-sequence): Declared - - * ob-R.el (org-number-sequence): Declared. + * ob.el (org-number-sequence): + Declared * ob-R.el (org-number-sequence): Declared. 2010-11-11 Dan Davison @@ -1554,8 +1558,8 @@ * ob-R.el (org-babel-expand-body:R): Use `org-number-sequence'. - * ob.el (org-babel-where-is-src-block-result): Use - `org-number-sequence'. + * ob.el (org-babel-where-is-src-block-result): + Use `org-number-sequence'. (org-babel-current-buffer-properties): Fix variable definition. * ob-ref.el (org-babel-ref-index-list): Use `org-number-sequence'. @@ -1575,8 +1579,8 @@ * org.el (org-agenda-jump-prefer-future): New option. - * org-agenda.el (org-agenda-goto-date): Use - `org-agenda-jump-prefer-future'. + * org-agenda.el (org-agenda-goto-date): + Use `org-agenda-jump-prefer-future'. 2010-11-11 Noorul Islam @@ -1700,18 +1704,18 @@ 2010-11-11 Dan Davison - * org-exp.el (org-export-latex-minted-with-line-numbers): Ensure - that variable is declared. + * org-exp.el (org-export-latex-minted-with-line-numbers): + Ensure that variable is declared. 2010-11-11 Eric Schulte - * ob-python.el (org-src-preserve-indentation): Fixed compiler + * ob-python.el (org-src-preserve-indentation): Fix compiler warning. 2010-11-11 Dan Davison - * org-exp.el (org-export-format-source-code-or-example): Latex - formatting of source code blocks using the minted package + * org-exp.el (org-export-format-source-code-or-example): + Latex formatting of source code blocks using the minted package (org-export-plist-vars): Add :latex-minted property (org-export-latex-minted): Ensure variable is defined (org-export-latex-minted-langs): Ensure variable is defined. @@ -1741,8 +1745,8 @@ 2010-11-11 Carsten Dominik - * org-beamer.el (org-beamer-place-default-actions-for-lists): Fix - typo in regexp. + * org-beamer.el (org-beamer-place-default-actions-for-lists): + Fix typo in regexp. 2010-11-11 Nicolas Goaziou @@ -1751,8 +1755,8 @@ 2010-11-11 David Maus - * org-gnus.el (org-gnus-nnimap-query-article-no-from-file): Query - article number from file is nil by default. + * org-gnus.el (org-gnus-nnimap-query-article-no-from-file): + Query article number from file is nil by default. 2010-11-11 Stephen Eglen @@ -1779,8 +1783,8 @@ 2010-11-11 Carsten Dominik - * org-mobile.el (org-mobile-force-id-on-agenda-items): Fix - docstring. + * org-mobile.el (org-mobile-force-id-on-agenda-items): + Fix docstring. (org-mobile-write-agenda-for-mobile): Use outline path if we do not have an ID and are not allowed to make one. (org-mobile-get-outline-path-link): New function. @@ -1795,7 +1799,7 @@ 2010-11-11 Eric Schulte - * ob.el (org-babel-number-p): Fixed documentation string. + * ob.el (org-babel-number-p): Fix documentation string. 2010-11-11 Eric Schulte @@ -1805,7 +1809,7 @@ 2010-11-11 Eric Schulte - * ob-exp.el (org-babel-exp-src-blocks): Fixed export when headings + * ob-exp.el (org-babel-exp-src-blocks): Fix export when headings have links, with tests. 2010-11-11 Carsten Dominik @@ -1928,7 +1932,7 @@ 2010-11-11 Eric Schulte - * ob.el (org-babel-confirm-evaluate): Fixed bug causing extra + * ob.el (org-babel-confirm-evaluate): Fix bug causing extra prompt in ob-confirm-evaluate in some cases. 2010-11-11 Eric Schulte @@ -1956,8 +1960,8 @@ 2010-11-11 Carsten Dominik - * org-mobile.el (org-mobile-encryption-password): Improve - docstring. + * org-mobile.el (org-mobile-encryption-password): + Improve docstring. (org-mobile-encryption-password-session): New variable. (org-mobile-encryption-password): New function. (org-mobile-check-setup): @@ -1971,7 +1975,7 @@ 2010-11-11 Jambunathan K - * org.el (org-speed-command-hook): Added org-speed-command-hook + * org.el (org-speed-command-hook): Add org-speed-command-hook (org-babel-speed-command-hook): Hook for Babel's speed commands. 2010-11-11 Dan Davison @@ -2110,13 +2114,13 @@ 2010-11-11 Dan Davison - * org-src.el (org-src-strip-leading-and-trailing-blank-lines): New - variable allowing prevention of automatic stripping of leading and + * org-src.el (org-src-strip-leading-and-trailing-blank-lines): + New variable allowing prevention of automatic stripping of leading and trailing blank lines when exiting edit buffer. (org-edit-src-exit): Respect value of `org-src-strip-leading-and-trailing-blank-lines' - (org-src-native-tab-command-maybe): Bind - `org-src-strip-leading-and-trailing-blank-lines' to nil during + (org-src-native-tab-command-maybe): + Bind `org-src-strip-leading-and-trailing-blank-lines' to nil during this function. 2010-11-11 Dan Davison @@ -2235,8 +2239,8 @@ 2010-11-11 Carsten Dominik * org-latex.el (org-export-latex-tag-markup): New option. - (org-export-latex-keywords-maybe): Use - `org-export-latex-tag-markup'. + (org-export-latex-keywords-maybe): + Use `org-export-latex-tag-markup'. 2010-11-11 Rémi Vanicat @@ -2267,8 +2271,8 @@ 2010-11-11 aaa bbb - * org-archive.el (org-get-local-archive-location): Use - `org-carchive-location' as default. + * org-archive.el (org-get-local-archive-location): + Use `org-carchive-location' as default. 2010-11-11 Eric Schulte @@ -2305,8 +2309,8 @@ 2010-11-11 David Maus - * org-gnus.el (org-gnus-nnimap-query-article-no-from-file): New - customization variable. + * org-gnus.el (org-gnus-nnimap-query-article-no-from-file): + New customization variable. (org-gnus-nnimap-cached-article-number): New function. (org-gnus-follow-link): Try to fetch cached article number of message-id. @@ -2329,8 +2333,8 @@ 2010-11-11 Dan Davison - * ob.el (org-babel-do-in-edit-buffer): Use - `org-babel-where-is-src-block-head' to test for source block at + * ob.el (org-babel-do-in-edit-buffer): + Use `org-babel-where-is-src-block-head' to test for source block at point. 2010-11-11 Eric Schulte @@ -2418,8 +2422,8 @@ 2010-11-11 Eric Schulte - * ob-tangle.el (org-babel-tangle-comment-format-beg): Format - string specifying the link-comment preceding a code block + * ob-tangle.el (org-babel-tangle-comment-format-beg): + Format string specifying the link-comment preceding a code block (org-babel-tangle-comment-format-end): Format string specifying the link-comment following a code block (org-babel-tangle-collect-blocks): Storing more information in the @@ -2516,7 +2520,7 @@ 2010-11-11 Eric Schulte - * ob-ruby.el (org-babel-expand-body:ruby): Removed requirement of + * ob-ruby.el (org-babel-expand-body:ruby): Remove requirement of inf-ruby. 2010-11-11 Noorul Islam (tiny change) @@ -2615,7 +2619,7 @@ 2010-11-11 Nicolas Goaziou - * org-docbook.el (org-export-as-docbook): Removed check for + * org-docbook.el (org-export-as-docbook): Remove check for indentation on lines that do not start with a list bullet. * org-html.el (org-export-as-html): Same thing. @@ -2633,7 +2637,7 @@ 2010-11-11 Nicolas Goaziou - * org-list.el (org-list-struct-indent): Added code to replace + * org-list.el (org-list-struct-indent): Add code to replace bullets if needed when indenting. 2010-11-11 Nicolas Goaziou @@ -2683,7 +2687,7 @@ 2010-11-11 Nicolas Goaziou - * org-list.el (org-indent-item-tree): Removed region code. It was + * org-list.el (org-indent-item-tree): Remove region code. It was prone to errors and undocumented. * org-list.el (org-item-indent-positions): Better heuristics to @@ -2704,7 +2708,7 @@ 2010-11-11 Nicolas Goaziou - * org-list.el (org-indent-item-tree): Removed unnecessary bullets + * org-list.el (org-indent-item-tree): Remove unnecessary bullets fix, and improved heuristics to determine bullet when indenting. * org-list.el (org-item-indent-positions): Function now returns @@ -2763,8 +2767,8 @@ * org-list.el (org-list-insert-item-generic): Insert the right bullet, with help of `org-list-bullet-string'. - * org-list.el (org-indent-item-tree): Use - `org-list-bullet-string'. + * org-list.el (org-indent-item-tree): + Use `org-list-bullet-string'. * org-list.el (org-fix-bullet-type): Use `org-list-bullet-string'. @@ -2811,8 +2815,8 @@ 2010-11-11 Nicolas Goaziou - * org-list.el (org-cycle-list-bullet): Check - `org-plain-list-ordered-item-terminator' before allowing 1. or 1) + * org-list.el (org-cycle-list-bullet): + Check `org-plain-list-ordered-item-terminator' before allowing 1. or 1) as valid bullets when cycling. 2010-11-11 Nicolas Goaziou @@ -2839,7 +2843,7 @@ 2010-11-11 Nicolas Goaziou - * org-list.el (org-maybe-renumber-ordered-list): Removed call for + * org-list.el (org-maybe-renumber-ordered-list): Remove call for `org-fix-bullet-type' to prevent infinite loop, and some checks already done in `org-renumber-ordered-list'. @@ -2860,8 +2864,8 @@ 2010-11-11 Nicolas Goaziou - * org-capture.el (org-capture-place-item): Use - `org-search-forward-unenclosed' and + * org-capture.el (org-capture-place-item): + Use `org-search-forward-unenclosed' and `org-search-backward-unenclosed' and new variable `org-item-beginning-re'. @@ -2881,10 +2885,10 @@ * org-list.el (org-list-make-subtree): Add protection when used outside of list - * org-list.el (org-insert-item): Removed useless hack now + * org-list.el (org-insert-item): Remove useless hack now `org-in-item-p' is fixed. - * org-timer.el (org-timer-item): Removed useless hack now + * org-timer.el (org-timer-item): Remove useless hack now `org-in-item-p' is fixed. 2010-11-11 Nicolas Goaziou @@ -2938,8 +2942,8 @@ * org-list.el (org-search-forward-unenclosed): Can send errors now. Removed useless usage of COUNT. - * org-list.el (org-update-checkbox-count): Use - `org-search-forward-unenclosed' and + * org-list.el (org-update-checkbox-count): + Use `org-search-forward-unenclosed' and `org-search-backward-unenclosed' instead of `re-search-forward' and `re-search-backward'. @@ -2947,8 +2951,8 @@ and `org-search-backward-unenclosed' instead of `re-search-forward' and `re-search-backward'. - * org-list.el (org-list-make-subtree): Use - `org-search-forward-unenclosed' and + * org-list.el (org-list-make-subtree): + Use `org-search-forward-unenclosed' and `org-search-backward-unenclosed' instead of `re-search-forward' and `re-search-backward'. @@ -2962,7 +2966,7 @@ * org-timer.el (org-timer-item): Refactoring. Compute timer string before inserting it in the buffer - * org-timer.el (org-timer): Added an optional argument to return + * org-timer.el (org-timer): Add an optional argument to return timer string instead of inserting it. 2010-11-11 Nicolas Goaziou @@ -3171,8 +3175,8 @@ 2010-11-11 Nicolas Goaziou - * org-html.el (org-export-html-preprocess): Replace - `org-list-end-re' by a blank line during pre-process. + * org-html.el (org-export-html-preprocess): + Replace `org-list-end-re' by a blank line during pre-process. 2010-11-11 Nicolas Goaziou @@ -3271,8 +3275,8 @@ 2010-11-11 Carsten Dominik - * org-exp.el (org-export-concatenate-multiline-emphasis): Ignore - matches that start in a headline. + * org-exp.el (org-export-concatenate-multiline-emphasis): + Ignore matches that start in a headline. 2010-11-11 Eric Schulte @@ -3299,17 +3303,16 @@ 2010-11-11 Eric Schulte - * ob-R.el (ess-make-buffer-current): Declared - (ess-ask-for-ess-directory): Declared - (ess-local-process-name): Declared - - * ob-latex.el (org-babel-latex-tex-to-pdf): Capturing free + * ob-R.el (ess-make-buffer-current): + Declared (ess-ask-for-ess-directory): + Declared (ess-local-process-name): + Declared * ob-latex.el (org-babel-latex-tex-to-pdf): Capturing free variable * ob.el (org-edit-src-code): Fixing arguments - (org-edit-src-exit): Declared - (org-outline-overlay-data): Declared - (org-set-outline-overlay-data): Declared. + (org-edit-src-exit): + Declared (org-outline-overlay-data): + Declared (org-set-outline-overlay-data): Declared. 2010-11-11 Glenn Morris @@ -3337,7 +3340,7 @@ 2010-11-11 Eric Schulte - * ob.el (org-babel-remove-temporary-directory): Removed explicit + * ob.el (org-babel-remove-temporary-directory): Remove explicit second argument. 2010-11-11 Magnus Henoch (tiny change) @@ -3347,7 +3350,7 @@ 2010-11-11 Eric Schulte - * org-macs.el (org-save-outline-visibility): Moved from org.el. + * org-macs.el (org-save-outline-visibility): Move from org.el. 2010-11-11 Eric Schulte @@ -3450,11 +3453,11 @@ 2010-11-11 Carsten Dominik - * org-latex.el (org-export-latex-set-initial-vars): Bind - `case-fold-search' to t around the search for special LaTeX setup. + * org-latex.el (org-export-latex-set-initial-vars): + Bind `case-fold-search' to t around the search for special LaTeX setup. - * org-beamer.el (org-beamer-after-initial-vars): Bind - `case-fold-search' to t around the search for special BEAMER + * org-beamer.el (org-beamer-after-initial-vars): + Bind `case-fold-search' to t around the search for special BEAMER setup. 2010-11-11 David Maus @@ -3512,8 +3515,8 @@ * org-feed.el (xml-substitute-special): Declare function for byte compiler. (org-feed-unescape): Removed. - (org-feed-parse-rss-entry, org-feed-parse-atom-entry): Use - `xml-substitute-special' to unescape XML entities. + (org-feed-parse-rss-entry, org-feed-parse-atom-entry): + Use `xml-substitute-special' to unescape XML entities. 2010-11-11 Dan Davison @@ -3614,10 +3617,10 @@ 2010-11-11 Carsten Dominik - * org-agenda.el (org-agenda-before-sorting-filter-function): New - hook function. - (org-finalize-agenda-entries): Apply - `org-agenda-before-sorting-filter-function'. + * org-agenda.el (org-agenda-before-sorting-filter-function): + New hook function. + (org-finalize-agenda-entries): + Apply `org-agenda-before-sorting-filter-function'. 2010-11-11 Carsten Dominik @@ -3662,8 +3665,8 @@ * org.el (org-preview-latex-fragment): Call `org-format-latex' with the additional processing argument. (org-export-have-math): New variable, for dynamic scoping. - (org-format-latex): Implement specific ways of processing. New - function argument for processing type. + (org-format-latex): Implement specific ways of processing. + New function argument for processing type. (org-org-menu): Remove the entry to configure LaTeX snippet processing. @@ -3776,13 +3779,13 @@ 2010-11-11 Dan Davison - * ob-octave.el (org-babel-octave-evaluate-external-process): Allow - remote files. + * ob-octave.el (org-babel-octave-evaluate-external-process): + Allow remote files. 2010-11-11 Juan Pechiar - * ob-octave.el (org-babel-octave-evaluate-external-process): Use - `org-babel-octave-import-elisp-from-file' instead of + * ob-octave.el (org-babel-octave-evaluate-external-process): + Use `org-babel-octave-import-elisp-from-file' instead of `org-babel-eval-read-file'. (org-babel-octave-var-to-octave): Separate matrix rows with ';', and use '%s' as format specifier instead of '%S'. @@ -3810,12 +3813,12 @@ * org-latex.el (org-export-latex-tables): Add label if any - * org-latex.el (org-export-latex-convert-table.el-table): Fix - little mistake when inserting label. + * org-latex.el (org-export-latex-convert-table.el-table): + Fix little mistake when inserting label. 2010-11-11 Nicolas Goaziou - * org.el (org-cycle-internal-local): Removed an unnecessary call + * org.el (org-cycle-internal-local): Remove an unnecessary call to `org-back-to-heading' that was preventing point to stay at its column when cycling visibility. @@ -3874,7 +3877,7 @@ 2010-11-11 Eric Schulte - * ob-lob.el (org-babel-lob-one-liner-regexp): Fixed error in lob + * ob-lob.el (org-babel-lob-one-liner-regexp): Fix error in lob regexp -- it wasn't matching lob lines w/o indices. 2010-11-11 Eric Schulte @@ -3910,13 +3913,13 @@ 2010-11-11 Eric Schulte - * org-exp.el (org-export-format-source-code-or-example): Escape - underscores in code block names on latex listings export. + * org-exp.el (org-export-format-source-code-or-example): + Escape underscores in code block names on latex listings export. 2010-11-11 Eric Schulte - * ob-tangle.el (org-babel-with-temp-filebuffer): Use - find-file-noselect to avoid excess buffer movement. + * ob-tangle.el (org-babel-with-temp-filebuffer): + Use find-file-noselect to avoid excess buffer movement. 2010-11-11 Carsten Dominik @@ -4235,11 +4238,11 @@ 2010-07-19 Carsten Dominik - * org-capture.el (org-capture-set-target-location): Store - exact positions for file+regexp and file+function targets. + * org-capture.el (org-capture-set-target-location): + Store exact positions for file+regexp and file+function targets. (org-capture-place-entry, org-capture-place-item) - (org-capture-place-table-line, org-capture-place-plain-text): Respect - exact positions. + (org-capture-place-table-line, org-capture-place-plain-text): + Respect exact positions. (org-capture-finalize): Make sure we are at the beginning of a line when fixing the empty lines after the entry. @@ -4260,21 +4263,21 @@ 2010-07-19 Eric Schulte - * org-exp.el (org-export-attach-captions-and-attributes): Add - a shortname attribute to caption strings under the symbol name + * org-exp.el (org-export-attach-captions-and-attributes): + Add a shortname attribute to caption strings under the symbol name org-caption-shortn. 2010-07-19 Carsten Dominik - * org.el (org-switchb): Rename from `org-iswitchb'. Improve - docstring. + * org.el (org-switchb): Rename from `org-iswitchb'. + Improve docstring. (org-iswitchb): New alias. (org-ido-switchb): Make alias point to `org-switchb'. 2010-07-19 Carsten Dominik - * org-capture.el (org-capture-fill-template): Respect - time-of-day preference in template prompt. + * org-capture.el (org-capture-fill-template): + Respect time-of-day preference in template prompt. 2010-07-19 David Maus @@ -4289,8 +4292,8 @@ 2010-07-19 Carsten Dominik - * org-capture.el (org-capture-set-target-location): Fix - file+function interpretation. + * org-capture.el (org-capture-set-target-location): + Fix file+function interpretation. 2010-07-19 David Maus @@ -4304,8 +4307,8 @@ 2010-07-19 David Maus - * org-feed.el (org-feed-unescape): New function. Unescape - protected entities. + * org-feed.el (org-feed-unescape): New function. + Unescape protected entities. (org-feed-parse-atom-entry): Use function for atom:content type text and html. @@ -4326,8 +4329,8 @@ 2010-07-19 Carsten Dominik - * org-publish.el (org-publish-initialize-cache): Make - timestamp directory, the entire path to it. + * org-publish.el (org-publish-initialize-cache): + Make timestamp directory, the entire path to it. 2010-07-19 Carsten Dominik @@ -4382,15 +4385,15 @@ (org-capture-bookmark-last-stored-position): New functions. (org-capture-place-table-line): Better error catching. (org-capture-place-item, org-capture-place-entry) - (org-capture-place-plain-text): Call - `org-capture-position-for-last-stored'. + (org-capture-place-plain-text): + Call `org-capture-position-for-last-stored'. (org-capture-finalize): Just call `org-capture-bookmark-last-stored-position'. 2010-07-19 Eric Schulte - * org-exp.el (org-export-mark-blockquote-verse-center): Fix - small bug, now grabbing match data before overwritten by looking-at + * org-exp.el (org-export-mark-blockquote-verse-center): + Fix small bug, now grabbing match data before overwritten by looking-at this fixes a problem with remainders of #+end_quote lines appearing in exported output. @@ -4563,8 +4566,8 @@ 2010-07-19 Eric Schulte - * org-exp-blocks.el (org-export-blocks-postblock-hook): Add - documentation to and turn into a defcustom. + * org-exp-blocks.el (org-export-blocks-postblock-hook): + Add documentation to and turn into a defcustom. 2010-07-19 Eric Schulte @@ -4653,8 +4656,8 @@ 2010-07-19 John Wiegley - * org-clock.el (org-clock-clock-in, org-clock-in): Add - parameter `start-time'. + * org-clock.el (org-clock-clock-in, org-clock-in): + Add parameter `start-time'. (org-clock-resolve-clock): Add parameter `clock-out-time'. If set, and resolve-to is a past time, then the clock out event occurs at `clock-out-time' rather than at `resolve-to'. @@ -4699,8 +4702,8 @@ * org-docbook.el (org-export-docbook-xslt-stylesheet): New option. (org-export-docbook-xslt-proc-command): Fix docstring. (org-export-docbook-xsl-fo-proc-command): Fix docstring. - (org-export-as-docbook-pdf): Improve - formatting of the xslt command. + (org-export-as-docbook-pdf): + Improve formatting of the xslt command. * org-exp.el (org-infile-export-plist): Check for XSLT setting. @@ -4709,8 +4712,8 @@ 2010-07-19 Carsten Dominik - * org-docbook.el (org-export-as-docbook-pdf): Improve - formatting of the xslt command. + * org-docbook.el (org-export-as-docbook-pdf): + Improve formatting of the xslt command. 2010-07-19 Sebastian Rose @@ -4727,8 +4730,8 @@ 2010-07-19 Carsten Dominik - * org.el (org-beginning-of-defun, org-end-of-defun): New - functions. + * org.el (org-beginning-of-defun, org-end-of-defun): + New functions. (org-mode): Install the `org-beginning-of-defun' and `org-end-of-defun' functions. (org-pretty-entities): New option. @@ -4785,8 +4788,8 @@ * org.el (org-mode): Fix comment syntax settings. - * org-src.el (org-edit-src-allow-write-back-p): Define - variable. + * org-src.el (org-edit-src-allow-write-back-p): + Define variable. * org.el (org-inline-image-overlays): New variable. (org-toggle-inline-images, org-display-inline-images) @@ -4795,8 +4798,8 @@ 2010-07-19 David Maus - * org-wl.el (org-wl-message-field): New function. Return - content of header field in message entity. + * org-wl.el (org-wl-message-field): New function. + Return content of header field in message entity. (org-wl-store-link): Call `org-wl-store-link-folder' or `org-wl-store-link-message' depending on major-mode. (org-wl-store-link-folder): New function. Store link to @@ -4845,8 +4848,8 @@ 2010-07-19 Carsten Dominik - * org-latex.el (org-export-latex-treat-sub-super-char): Make - sure parenthesis matching is consistent. + * org-latex.el (org-export-latex-treat-sub-super-char): + Make sure parenthesis matching is consistent. * org-table.el (org-table-colgroup-line-p) (org-table-cookie-line-p): New functions. @@ -4866,8 +4869,8 @@ * org-list.el (org-end-of-item-text-before-children): Also do the right thing at the end of a file. - * org.el (org-set-packages-alist, org-get-packages-alist): New - function. + * org.el (org-set-packages-alist, org-get-packages-alist): + New function. (org-export-latex-default-packages-alist) (org-export-latex-packages-alist): Add extra flag to each package, indicating if it should be used for snippets. @@ -4906,8 +4909,8 @@ * org-clock.el (org-clock-cancel, org-clock-out): Make sure the modeline display is removed. - * org-exp.el (org-export-format-drawer-function): Fix - docstring. + * org-exp.el (org-export-format-drawer-function): + Fix docstring. * org-agenda.el (org-agenda-refile): New optional argument NO-UPDATE. @@ -4923,21 +4926,21 @@ * org-ascii.el (org-export-ascii-preprocess): Make table mapping quiet. - * org-html.el (org-export-as-html, org-html-level-start): Change - XHTML IDs to not use dots. - - * org-exp.el (org-export-define-heading-targets): Change - XHTML IDs to not use dots. - - * org-docbook.el (org-export-docbook-level-start): Change - XHTML IDs to not use dots. + * org-html.el (org-export-as-html, org-html-level-start): + Change XHTML IDs to not use dots. + + * org-exp.el (org-export-define-heading-targets): + Change XHTML IDs to not use dots. + + * org-docbook.el (org-export-docbook-level-start): + Change XHTML IDs to not use dots. * org-latex.el (org-export-as-latex): Make sure that the result buffer is in latex-mode. * org.el (org-shiftup-final-hook, org-shiftdown-final-hook) - (org-shiftleft-final-hook, org-shiftright-final-hook): New - hooks. + (org-shiftleft-final-hook, org-shiftright-final-hook): + New hooks. 2010-07-19 Carsten Dominik @@ -4990,8 +4993,8 @@ * org-publish.el (org-publish-project-alist): Update docstring. (org-publish-file-title-cache): New variable. - (org-publish-initialize-files-alist): Initialize - `org-publish-initialize-files-alist' to nil. + (org-publish-initialize-files-alist): + Initialize `org-publish-initialize-files-alist' to nil. (org-publish-sort-directory-files): New function. (org-publish-projects): Access the new properties. (org-publish-find-title): Use the file title cache. @@ -5076,8 +5079,8 @@ * org-compat.el (org-make-overlay, org-delete-overlay) (org-overlay-start, org-overlay-end, org-overlay-put) - (org-overlay-get, org-overlay-move, org-overlay-buffer): Functions - removed. + (org-overlay-get, org-overlay-move, org-overlay-buffer): + Functions removed. (org-add-to-invisibility-spec): Function removed. * org-html.el (org-export-as-html-and-open): Add argument to @@ -5152,8 +5155,8 @@ * org-freemind.el (org-freemind-from-org-mode-node) (org-freemind-from-org-mode) - (org-freemind-from-org-sparse-tree, org-freemind-to-org-mode): Use - interactive-p instead of called-interactively, because this is + (org-freemind-from-org-sparse-tree, org-freemind-to-org-mode): + Use interactive-p instead of called-interactively, because this is backward compatible with older Emacsen I still support.. 2010-07-19 Carsten Dominik @@ -5163,8 +5166,8 @@ 2010-07-19 Carsten Dominik - * org-footnote.el (org-footnote-goto-previous-reference): Rename - from `org-footnote-goto-next-reference'. + * org-footnote.el (org-footnote-goto-previous-reference): + Rename from `org-footnote-goto-next-reference'. * org.el (org-auto-repeat-maybe): Only record LAST_REPEAT if org-log-repeat is non-nil, or if there is clocking data in the @@ -5181,11 +5184,11 @@ * org-wl.el (org-wl-link-remove-filter): New customizable variable. If non-nil, filter conditions are stripped when storing link to message in filter folder. - (org-wl-shimbun-prefer-web-links): New customizable variable. If - non-nil, links to shimbun messages are created as web links to + (org-wl-shimbun-prefer-web-links): New customizable variable. + If non-nil, links to shimbun messages are created as web links to message source. - (org-wl-nntp-prefer-web-links): New customizable variable. If - non-nil, links to nntp message are created as web links to gmane + (org-wl-nntp-prefer-web-links): New customizable variable. + If non-nil, links to nntp message are created as web links to gmane or googlegroups. (org-wl-namazu-default-index): New customizable variable. Directory of namazu search index that should be used as default @@ -5216,13 +5219,13 @@ * org.el (org-file-apps-ex): New variable. (org-open-file): Before considering org-file-apps, first match the - regexps from org-file-apps-ex against the whole link. See - docstring of org-file-apps-ex. + regexps from org-file-apps-ex against the whole link. + See docstring of org-file-apps-ex. 2010-07-19 Carsten Dominik - * org.el (org-export-latex-default-packages-alist): Remove - microtype package. + * org.el (org-export-latex-default-packages-alist): + Remove microtype package. (org-todo-repeat-to-state): New variable. (org-auto-repeat-maybe): Allow user-selected target states. (org-default-properties): Add the new property REPEAT_TO_STATE. @@ -5348,8 +5351,8 @@ (org-mobile-copy-agenda-files, org-mobile-sumo-agenda-command) (org-mobile-create-sumo-agenda): Use encryption code. (org-mobile-encrypt-and-move): New function. - (org-mobile-encrypt-file, org-mobile-decrypt-file): New - functions. + (org-mobile-encrypt-file, org-mobile-decrypt-file): + New functions. (org-mobile-move-capture): Decrypt the capture file. * org.el (org-entities): Require the new file. @@ -5461,8 +5464,8 @@ 2010-04-10 Carsten Dominik - * org-exp.el (org-export-author-info, org-export-email-info): Fix - docstrings. + * org-exp.el (org-export-author-info, org-export-email-info): + Fix docstrings. * org-beamer.el (org-beamer-select-environment): Rename from `org-beamer-set-environment-tag'. Improve docstring. @@ -5571,8 +5574,8 @@ * org-crypt.el (org-reveal-start-hook): Add a decryption function to this hook. - (org-decrypt-entries, org-encrypt-entries, org-decrypt-entry): Add - docstrings. + (org-decrypt-entries, org-encrypt-entries, org-decrypt-entry): + Add docstrings. * org.el (org-point-at-end-of-empty-headline) (org-level-increment, org-get-previous-line-level): New function. @@ -5600,8 +5603,8 @@ 2010-04-10 Stephen Eglen - * org-agenda.el (org-agenda-insert-diary-extract-time): New - variable. + * org-agenda.el (org-agenda-insert-diary-extract-time): + New variable. (org-agenda-add-entry-to-org-agenda-diary-file): Use this new variable rather than `org-agenda-search-headline-for-time'. @@ -5704,8 +5707,8 @@ (org-export-as-docbook): Fix problem with double footnote reference in one place. - * org-exp.el (org-export-format-source-code-or-example): Remove - unnecessary newline. + * org-exp.el (org-export-format-source-code-or-example): + Remove unnecessary newline. * org.el (org-deadline, org-schedule): Allow rescheduling entries with repeaters. @@ -5727,8 +5730,8 @@ 2010-04-10 Carsten Dominik - * org-latex.el (org-export-latex-classes): Add - \usepackage{latexsym} to all classes. + * org-latex.el (org-export-latex-classes): + Add \usepackage{latexsym} to all classes. 2010-04-10 Carsten Dominik @@ -5747,8 +5750,8 @@ 2010-04-10 Carsten Dominik - * org-clock.el (org-clock-report-include-clocking-task): New - option. + * org-clock.el (org-clock-report-include-clocking-task): + New option. (org-clock-sum): Add the current clocking task. 2010-04-10 Carsten Dominik @@ -5784,8 +5787,8 @@ (org-get-todo-face, org-font-lock-add-priority-faces) (org-get-tag-face): Use `org-face-from-face-or-color'. - * org-faces.el (org-todo-keyword-faces, org-priority-faces): Allow - simple colors as values. + * org-faces.el (org-todo-keyword-faces, org-priority-faces): + Allow simple colors as values. (org-faces-easy-properties): New option. * org-agenda.el (org-agenda-set-mode-name): Show if the agenda is @@ -5807,8 +5810,8 @@ * org-html.el (org-export-html-style-default): Add a default style for textareas. - * org-exp.el (org-export-format-source-code-or-example): Fix - textarea tag. + * org-exp.el (org-export-format-source-code-or-example): + Fix textarea tag. 2010-04-10 Bastien Guerry @@ -5838,8 +5841,8 @@ * org-latex.el (org-export-as-pdf-and-open): Kill product buffer if the user wants that. - * org-exp.el (org-export-kill-product-buffer-when-displayed): New - option. + * org-exp.el (org-export-kill-product-buffer-when-displayed): + New option. * org-agenda.el (org-batch-agenda-csv): Use the time property instead of the `time-of-day' property. @@ -5894,8 +5897,8 @@ * org.el (org-get-location): Make sure the selection buffer is shown in the current frame. - * org-ascii.el (org-export-ascii-table-widen-columns): New - option. + * org-ascii.el (org-export-ascii-table-widen-columns): + New option. (org-export-ascii-preprocess): Realign tables to remove narrowing if `org-export-ascii-table-widen-columns' is set. @@ -5920,8 +5923,8 @@ 2010-04-10 Carsten Dominik - * org.el (org-fontify-meta-lines-and-blocks): Honor - `org-fontify-quote-and-verse-blocks'. + * org.el (org-fontify-meta-lines-and-blocks): + Honor `org-fontify-quote-and-verse-blocks'. * org-faces.el (org-fontify-quote-and-verse-blocks): New option. @@ -5969,11 +5972,11 @@ * org-latex.el (org-export-latex-make-header): Define the align macro if it is not yet defined. - * org-agenda.el (org-agenda-insert-diary-make-new-entry): Call - `org-insert-heading' with the INVISIBLE-OK argument. + * org-agenda.el (org-agenda-insert-diary-make-new-entry): + Call `org-insert-heading' with the INVISIBLE-OK argument. - * org-mac-message.el (org-mac-message-insert-flagged): Call - `org-insert-heading' with the INVISIBLE-OK argument. + * org-mac-message.el (org-mac-message-insert-flagged): + Call `org-insert-heading' with the INVISIBLE-OK argument. * org.el (org-insert-heading): New argument INVISIBLE-OK. @@ -5984,10 +5987,10 @@ `html-container-class' text property to set an additional class for an outline container. - * org-exp.el (org-export-remember-html-container-classes): New - function. - (org-export-preprocess-string): Call - `org-export-remember-html-container-classes'. + * org-exp.el (org-export-remember-html-container-classes): + New function. + (org-export-preprocess-string): + Call `org-export-remember-html-container-classes'. * org.el (org-cycle): Mention level cycling in the docstring. (org-default-properties): Add new property HTML_CONTAINER_CLASS. @@ -6033,8 +6036,8 @@ * org-clock.el (org-task-overrun-text): New option. (org-task-overrun, org-clock-update-period): New variables. - (org-clock-get-clock-string, org-clock-update-mode-line): Mark - overrun clock. + (org-clock-get-clock-string, org-clock-update-mode-line): + Mark overrun clock. (org-clock-notify-once-if-expired): Check if clock is overrun. * org-faces.el: New face `org-mode-line-clock-overrun'. @@ -6047,8 +6050,8 @@ 2010-04-10 Stephen Eglen - * org-agenda.el (org-get-time-of-day): Use - org-agenda-time-leading-zero to allow leading zero (rather than + * org-agenda.el (org-get-time-of-day): + Use org-agenda-time-leading-zero to allow leading zero (rather than space) for times. 2010-04-10 Carsten Dominik @@ -6095,8 +6098,8 @@ 2010-04-10 Carsten Dominik - * org-agenda.el (org-diary-class): Use - `org-order-calendar-date-args'. + * org-agenda.el (org-diary-class): + Use `org-order-calendar-date-args'. * org.el (org-order-calendar-date-args): New function. @@ -6108,8 +6111,8 @@ * org-agenda.el (org-agenda-schedule, org-agenda-deadline): Document that ARG is passed through to remove the date. - (org-agenda-bulk-action): Accept prefix arg and pass it on. Do - not read a date when the user has given a `C-u' prefix. + (org-agenda-bulk-action): Accept prefix arg and pass it on. + Do not read a date when the user has given a `C-u' prefix. 2010-04-10 Carsten Dominik @@ -6157,8 +6160,8 @@ have defined any. (org-beamer-fix-toc): Put a frame around the table of contents. - * org-exp.el (org-export-remove-comment-blocks-and-subtrees): Make - sure case-folding works well when processing comment stuff. + * org-exp.el (org-export-remove-comment-blocks-and-subtrees): + Make sure case-folding works well when processing comment stuff. * org-latex.el (org-export-latex-after-save-hook): New hook. (org-export-as-latex): Run the new hook. @@ -6344,8 +6347,8 @@ * org.el (org-inhibit-startup-visibility-stuff): New variable. (org-mode): Don't do startup visibility if inhibited. - (org-outline-overlay-data, org-set-outline-overlay-data): New - functions. + (org-outline-overlay-data, org-set-outline-overlay-data): + New functions. (org-save-outline-visibility): New macro. (org-log-note-headings): Document that one should not change the `state' note format. @@ -6374,42 +6377,42 @@ * org-beamer.el: New file. * org-latex.el (org-export-latex-after-initial-vars-hook): New hook. - (org-export-as-latex): Run - `org-export-latex-after-initial-vars-hook'. + (org-export-as-latex): + Run `org-export-latex-after-initial-vars-hook'. (org-export-latex-format-toc-function) - (org-export-latex-make-header): Call - `org-export-latex-format-toc-function'. + (org-export-latex-make-header): + Call `org-export-latex-format-toc-function'. * org.el (org-fill-template): Make template searches case sensitive. * org-exp.el (org-export): Use "1" as a sign to export only the subtree. - * org-colview-xemacs.el (org-columns-edit-value): Use - org-unrestricted property. + * org-colview-xemacs.el (org-columns-edit-value): + Use org-unrestricted property. - * org-colview.el (org-columns-edit-value): Use - org-unrestricted property. + * org-colview.el (org-columns-edit-value): + Use org-unrestricted property. * org.el (org-compute-property-at-point): Set org-unrestricted text property if the list contains ":ETC". - (org-insert-property-drawer): Use - org-unrestricted property. + (org-insert-property-drawer): + Use org-unrestricted property. * org-exp.el (org-export-preprocess-before-selecting-backend-code-hook): New hook. - (org-export-preprocess-string): Run - `org-export-preprocess-before-selecting-backend-code-hook'. + (org-export-preprocess-string): + Run `org-export-preprocess-before-selecting-backend-code-hook'. * org-xoxo.el (org-export-as-xoxo): Run `org-export-first-hook'. - * org-latex.el (org-export-region-as-latex): Run - `org-export-first-hook'. + * org-latex.el (org-export-region-as-latex): + Run `org-export-first-hook'. * org-html.el (org-export-as-html): Run `org-export-first-hook'. - * org-docbook.el (org-export-as-docbook): Run - `org-export-first-hook'. + * org-docbook.el (org-export-as-docbook): + Run `org-export-first-hook'. * org-ascii.el (org-export-as-ascii): Run `org-export-first-hook'. @@ -6447,8 +6450,8 @@ * org-macs.el (org-re): Interpret :punct: in regexps. - * org-exp.el (org-export-replace-src-segments-and-examples): Also - take the final newline after the END line. + * org-exp.el (org-export-replace-src-segments-and-examples): + Also take the final newline after the END line. * org.el (org-clean-visibility-after-subtree-move): Only fix entries that are not entirely invisible already. @@ -6457,8 +6460,8 @@ 2010-04-10 Carsten Dominik - * org-exp.el (org-export-format-source-code-or-example): Avoid - additional extra white lines in LaTeX. + * org-exp.el (org-export-format-source-code-or-example): + Avoid additional extra white lines in LaTeX. * org-list.el (org-list-parse-list): Leave empty lines after the list, don't consider them as part of the list. @@ -6476,14 +6479,14 @@ 2010-04-10 Tassilo Horn - * org.el (org-complete-tags-always-offer-all-agenda-tags): New - variable. + * org.el (org-complete-tags-always-offer-all-agenda-tags): + New variable. (org-set-tags): Use it. 2010-04-10 Carsten Dominik - * org-list.el (org-empty-line-terminates-plain-lists): Update - docstring. + * org-list.el (org-empty-line-terminates-plain-lists): + Update docstring. * org.el (org-format-latex): Fix link creation for processed latex snippets. @@ -6539,8 +6542,8 @@ * org-latex.el (org-export-latex-parse-global) (org-export-latex-parse-content) - (org-export-latex-parse-subcontent): Use - `org-re-search-forward-unprotected'. + (org-export-latex-parse-subcontent): + Use `org-re-search-forward-unprotected'. (org-export-as-pdf): Remove log files produced by XeTeX. * org-macs.el (org-re-search-forward-unprotected): New function. @@ -6573,8 +6576,8 @@ * org.el (org-cycle-level): Use `org-looking-back'. - * org-list.el (org-cycle-item-indentation): Use - `org-looking-back'. + * org-list.el (org-cycle-item-indentation): + Use `org-looking-back'. * org-compat.el (org-looking-back): New function. @@ -6627,8 +6630,8 @@ 2009-11-20 Carsten Dominik - * org-agenda.el (org-agenda-diary-entry-in-org-file): Rebuild - agenda after adding new entry. + * org-agenda.el (org-agenda-diary-entry-in-org-file): + Rebuild agenda after adding new entry. * org-datetree.el (org-datetree-find-day-create): Fix regular expression. @@ -6665,8 +6668,8 @@ * org-agenda.el (org-agenda-insert-diary-strategy): New variable. (org-agenda-insert-diary-as-top-level): New function. - (org-agenda-add-entry-to-org-agenda-diary-file): Call - `org-agenda-insert-diary-as-top-level'. + (org-agenda-add-entry-to-org-agenda-diary-file): + Call `org-agenda-insert-diary-as-top-level'. * org.el (org-occur-in-agenda-files): Make sure none of the buffers is narrowed. @@ -6733,8 +6736,8 @@ * org-agenda.el (org-agenda-show-outline-path): New option. (org-agenda-do-context-action): New function. - (org-agenda-next-line, org-agenda-previous-line): Use - `org-agenda-do-context-action'. + (org-agenda-next-line, org-agenda-previous-line): + Use `org-agenda-do-context-action'. * org.el (org-use-speed-commands): Allow function value. (org-speed-commands-default): Make headline motion safe, so that @@ -6811,8 +6814,8 @@ * org-latex.el (org-export-latex-links): Check for protectedness in the last matched character, not after the match. - * org-datetree.el (org-datetree-find-date-create): Respect - restriction when KEEP-RESTRICTION is set. + * org-datetree.el (org-datetree-find-date-create): + Respect restriction when KEEP-RESTRICTION is set. (org-datetree-file-entry-under): New function. (org-datetree-cleanup): New command. @@ -6850,8 +6853,8 @@ * org-agenda.el (org-agenda-diary-entry-in-org-file) (org-agenda-add-entry-to-org-agenda-diary-file) (org-agenda-insert-diary-make-new-entry): New functions. - (org-agenda-diary-entry): Call - `org-agenda-diary-entry-in-org-file' when appropriate. + (org-agenda-diary-entry): + Call `org-agenda-diary-entry-in-org-file' when appropriate. * org.el (org-calendar-insert-diary-entry-key): New option. (org-agenda-diary-file): New option. @@ -6902,8 +6905,8 @@ 2009-11-13 Dan Davison - * org-exp.el (org-export-format-source-code-or-example): Restrict - scope of preserve-indentp to the let binding. + * org-exp.el (org-export-format-source-code-or-example): + Restrict scope of preserve-indentp to the let binding. (org-src): Require org-src, since org-src-preserve-indentation is used. 2009-11-13 Carsten Dominik @@ -6923,14 +6926,14 @@ 2009-11-13 Carsten Dominik - * org-icalendar.el (org-print-icalendar-entries): Use - org-icalendar-verify-function only if non-nil. + * org-icalendar.el (org-print-icalendar-entries): + Use org-icalendar-verify-function only if non-nil. * org.el (org-refile): Refile to clock only if the prefix arg is 2. (org-sparse-tree): Fix docstring to be in line with prompt. - (org-update-parent-todo-statistics): Call - `org-after-todo-statistics-hook' on each level. + (org-update-parent-todo-statistics): + Call `org-after-todo-statistics-hook' on each level. 2009-11-13 Carsten Dominik @@ -6961,8 +6964,8 @@ * org-clock.el (org-clock-play-sound): Expand file in org-clock-sound, to allow ~ for home. - * org-remember.el (org-remember-handler): Set - text-before-node-creation even if this already looks like a node, + * org-remember.el (org-remember-handler): + Set text-before-node-creation even if this already looks like a node, because the string might be needed on non-org-mode target files. * org-agenda.el (org-agenda-open-link): Make this work in agenda @@ -6991,12 +6994,12 @@ * org-src.el (org-src-preserve-indentation): Document that this variable is also used during export. - * org-exp.el (org-export-format-source-code-or-example): Preserve - indentation if a block has a -i option, or if + * org-exp.el (org-export-format-source-code-or-example): + Preserve indentation if a block has a -i option, or if `org-src-preserve-indentation' is set. - * org-exp-blocks.el (org-export-blocks-preprocess): Preserve - indentation if a block has a -i option, or if + * org-exp-blocks.el (org-export-blocks-preprocess): + Preserve indentation if a block has a -i option, or if `org-src-preserve-indentation' is set. 2009-11-13 Carsten Dominik @@ -7013,8 +7016,8 @@ (org-agenda-menu): Add the new archiving commands to the menu. (org-agenda-archive-default) (org-agenda-archive-default-with-confirmation): New commands. - (org-agenda-archive, org-agenda-archive-to-archive-sibling): Just - call `org-agenda-archive-with'. + (org-agenda-archive, org-agenda-archive-to-archive-sibling): + Just call `org-agenda-archive-with'. (org-agenda-archive-with): New function. * org-table.el (org-table-convert-region): Inert spaces around "|" @@ -7034,8 +7037,8 @@ IF-EXISTS, which avoids creating the attachment directory if it does not yet exist. - * org-agenda.el (org-agenda, org-run-agenda-series): Evaluate - MATCH. + * org-agenda.el (org-agenda, org-run-agenda-series): + Evaluate MATCH. 2009-11-13 Carsten Dominik @@ -7148,8 +7151,8 @@ 2009-11-13 John Wiegley - * org-clock.el (org-clock-display, org-clock-put-overlay): Use - `org-time-clock-use-fractional'. + * org-clock.el (org-clock-display, org-clock-put-overlay): + Use `org-time-clock-use-fractional'. * org.el (org-time-clocksum-use-fractional) (org-time-clocksum-fractional-format): Two new customizable @@ -7246,8 +7249,8 @@ * org-agenda.el (org-agenda-next-line): New command. (org-agenda-previous-line): New commands. - (org-agenda-show-and-scroll-up, org-agenda-show-scroll-down): New - commands. + (org-agenda-show-and-scroll-up, org-agenda-show-scroll-down): + New commands. (org-agenda-follow-mode): Do the follow immediately if the mode is turned on here. (previous-line, next-line): Replace keys with the corresponding @@ -7278,8 +7281,8 @@ 2009-11-13 John Wiegley - * org-clock.el (org-clock-disable-clock-resolution): New - customization variable that disable automatic clock resolution on + * org-clock.el (org-clock-disable-clock-resolution): + New customization variable that disable automatic clock resolution on clock in. (org-clock-in): If `org-clock-disable-clock-resolution' is set, do not automatically resolve anything. This is does not affect @@ -7305,8 +7308,8 @@ 2009-11-13 John Wiegley - * org-agenda.el (org-agenda-auto-exclude-function): New - customization variable for allowing the user to create an "auto + * org-agenda.el (org-agenda-auto-exclude-function): + New customization variable for allowing the user to create an "auto exclusion" filter for doing context-aware auto tag filtering. (org-agenda-filter-by-tag): Changes to support the use of `org-agenda-auto-exclude-function'. See the new manual addition,. @@ -7373,8 +7376,8 @@ resolves a clock to a specific time, closing or resuming as need be, and possibly even starting a new clock. (org-clock-resolve): New function used by `org-resolve-clocks' - that sets up for the call to `org-clock-resolve-clock'. It - determines the time to resolve to based on a single-character + that sets up for the call to `org-clock-resolve-clock'. + It determines the time to resolve to based on a single-character selection from the user to either keep time, subtract away time or cancel the clock. (org-resolve-clocks): New user command which resolves dangling @@ -7483,8 +7486,8 @@ 2009-11-13 Carsten Dominik * org-src.el (org-edit-src-code) - (org-edit-src-find-region-and-lang, org-edit-src-exit): Handle - macro editing. + (org-edit-src-find-region-and-lang, org-edit-src-exit): + Handle macro editing. * org-agenda.el (org-prefix-category-max-length): New variable. (org-format-agenda-item): Use `org-prefix-category-max-length'. @@ -7637,12 +7640,12 @@ (org-agenda-show-new-time, org-agenda-date-prompt) (org-agenda-schedule, org-agenda-deadline, org-agenda-action) (org-agenda-clock-in, org-agenda-bulk-mark) - (org-agenda-bulk-unmark, org-agenda-show-the-flagging-note): Use - `org-get-at-bol'. + (org-agenda-bulk-unmark, org-agenda-show-the-flagging-note): + Use `org-get-at-bol'. * org-colview.el (org-columns-display-here) - (org-columns-edit-allowed, org-agenda-columns): Use - `org-get-at-bol'. + (org-columns-edit-allowed, org-agenda-columns): + Use `org-get-at-bol'. 2009-10-01 Carsten Dominik @@ -7677,13 +7680,13 @@ 2009-10-01 Carsten Dominik - * org-agenda.el (org-prepare-agenda): Reset - `org-drawers-for-agenda'. + * org-agenda.el (org-prepare-agenda): + Reset `org-drawers-for-agenda'. (org-prepare-agenda): Uniquify list of drawers. * org.el (org-complex-heading-regexp-format): New variable. - (org-set-regexps-and-options): Define - `org-complex-heading-regexp-format'. + (org-set-regexps-and-options): + Define `org-complex-heading-regexp-format'. (org-drawers-for-agenda): New variable. (org-map-entries): Bind `org-drawers-for-agenda'. (org-prepare-agenda-buffers): Add to `org-drawers-for-agenda'. @@ -7728,10 +7731,10 @@ * org-archive.el (org-archive-set-tag) (org-archive-subtree-default): New commands. - * org-clock.el (org-clock-clocktable-default-properties): New - option. - (org-clock-report): Use - `org-clock-clocktable-default-properties'. + * org-clock.el (org-clock-clocktable-default-properties): + New option. + (org-clock-report): + Use `org-clock-clocktable-default-properties'. 2009-10-01 Carsten Dominik @@ -7834,8 +7837,8 @@ 2009-10-01 Carsten Dominik - * org-agenda.el (org-agenda-entry-text-exclude-regexps): New - variable. + * org-agenda.el (org-agenda-entry-text-exclude-regexps): + New variable. (org-agenda-entry-text-cleanup-hook): New hook. (org-agenda-get-some-entry-text): Remove matches of `org-agenda-entry-text-exclude-regexps' and run the hook @@ -7985,8 +7988,8 @@ 2009-09-02 Carsten Dominik - * org.el (org-eval-in-calendar): Use - `org-select-frame-set-input-focus'. + * org.el (org-eval-in-calendar): + Use `org-select-frame-set-input-focus'. * org-compat.el (org-select-frame-set-input-focus): New function. @@ -8032,8 +8035,8 @@ (org-agenda-menu): Add effort setting commands to menu. (org-agenda-set-property, org-agenda-set-effort): New functions. - * org-latex.el (org-export-latex-tables): Fix - `org-table-last-alignment' and `org-table-last-column-widths' if + * org-latex.el (org-export-latex-tables): + Fix `org-table-last-alignment' and `org-table-last-column-widths' if the first column has been removed. 2009-09-02 Carsten Dominik @@ -8055,8 +8058,8 @@ (org-get-last-sibling): New function. (org-refile): Use `org-get-next-sibling' instead of the outline version of this function. - (org-clean-visibility-after-subtree-move): Use - `org-get-next-sibling' and `org-get-last-sibling' instead of the + (org-clean-visibility-after-subtree-move): + Use `org-get-next-sibling' and `org-get-last-sibling' instead of the outline versions of these functions. 2009-09-02 Carsten Dominik @@ -8084,8 +8087,8 @@ (org-table-get-specials, org-table-rotate-recalc-marks) (org-table-get-range, org-table-recalculate) (org-table-edit-formulas, org-table-fedit-convert-buffer) - (org-table-show-reference, org-table-highlight-rectangle): Don't - use `goto-line'. + (org-table-show-reference, org-table-highlight-rectangle): + Don't use `goto-line'. * org-src.el (org-edit-src-code, org-edit-fixed-width-region) (org-edit-src-exit): Don't use `goto-line'. @@ -8100,8 +8103,8 @@ * org-colview.el (org-columns, org-columns-redo) (org-agenda-columns): Don't use `goto-line'. - * org-colview-xemacs.el (org-columns, org-agenda-columns): Don't - use `goto-line'. + * org-colview-xemacs.el (org-columns, org-agenda-columns): + Don't use `goto-line'. * org-agenda.el (org-agenda-mode): Force visual line motion off. (org-agenda-add-entry-text-maxlines): Improve docstring. @@ -8143,8 +8146,8 @@ 2009-09-02 Carsten Dominik * org-agenda.el (org-agenda-get-some-entry-text): New function. - (org-agenda-add-entry-text): Use - `org-agenda-get-some-entry-text'. + (org-agenda-add-entry-text): + Use `org-agenda-get-some-entry-text'. * org.el (org-cycle-separator-lines): Update docstring. (org-cycle-show-empty-lines): Handle negative values for @@ -8172,8 +8175,8 @@ 2009-09-02 Carsten Dominik - * org-exp.el (org-export-format-source-code-or-example): Translate - language. + * org-exp.el (org-export-format-source-code-or-example): + Translate language. * org-src.el (org-src-lang-modes): New variable. (org-edit-src-code): Translate language. @@ -8199,8 +8202,8 @@ 2009-09-02 Carsten Dominik - * org-remember.el (org-remember-apply-template): Use - org-icompleting-read. + * org-remember.el (org-remember-apply-template): + Use org-icompleting-read. * org-publish.el (org-publish): Use org-icompleting-read. @@ -8208,11 +8211,11 @@ (org-insert-columns-dblock): Use org-icompleting-read. * org-colview-xemacs.el (org-columns-edit-value) - (org-columns-new, org-insert-columns-dblock): Use - org-icompleting-read. + (org-columns-new, org-insert-columns-dblock): + Use org-icompleting-read. - * org-attach.el (org-attach-delete-one, org-attach-open): Use - org-icompleting-read. + * org-attach.el (org-attach-delete-one, org-attach-open): + Use org-icompleting-read. 2009-09-02 Carsten Dominik @@ -8221,8 +8224,8 @@ (org-org-menu): Add a menu entry for the new bug reporter. (org-submit-bug-report): New command. - * org-list.el (org-hierarchical-checkbox-statistics): Improve - docstring. + * org-list.el (org-hierarchical-checkbox-statistics): + Improve docstring. * org.el (org-emphasis-regexp-components): Add "`" to set of pre-emphasis characters. @@ -8231,16 +8234,16 @@ package. (org-export-latex-emphasis-alist): Use \st for strikethough. - * org-exp-blocks.el (org-export-blocks-preprocess): Use - `indent-code-rigidly' to indent. + * org-exp-blocks.el (org-export-blocks-preprocess): + Use `indent-code-rigidly' to indent. - * org-agenda.el (org-agenda-get-restriction-and-command): Remove - properties only if MATCH really is a string. + * org-agenda.el (org-agenda-get-restriction-and-command): + Remove properties only if MATCH really is a string. 2009-09-02 Carsten Dominik - * org-latex.el (org-export-latex-packages-alist): Fix - customization type. + * org-latex.el (org-export-latex-packages-alist): + Fix customization type. * org.el (org-create-formula-image): Also use `org-export-latex-packages-alist'. @@ -8253,8 +8256,8 @@ * org.el (org-fast-tag-selection): Avoid text properties on tags in the alist. - * org-agenda.el (org-agenda-get-restriction-and-command): Avoid - text properties on the match element. + * org-agenda.el (org-agenda-get-restriction-and-command): + Avoid text properties on the match element. 2009-09-02 Carsten Dominik @@ -8278,8 +8281,8 @@ 2009-09-02 Carsten Dominik - * org.el (org-export-html-special-string-regexps): Definition - moved into org.el. + * org.el (org-export-html-special-string-regexps): + Definition moved into org.el. * org-exp.el (org-export-preprocess-apply-macros): Allow newlines in macro calls. @@ -8289,8 +8292,8 @@ * org-latex.el (org-export-latex-listings) (org-export-latex-listings-langs): New options. - * org-exp.el (org-export-format-source-code-or-example): Use - listing package if requested by the user. + * org-exp.el (org-export-format-source-code-or-example): + Use listing package if requested by the user. 2009-09-02 Bastien Guerry @@ -8313,8 +8316,8 @@ * org.el (org-insert-heading): When respecting content, do not convert current line to headline. - * org-clock.el (org-clock-save-markers-for-cut-and-paste): Also - cheeeeeck the hd marker. + * org-clock.el (org-clock-save-markers-for-cut-and-paste): + Also cheeeeeck the hd marker. (org-clock-in): Also set the hd marker. (org-clock-out): Also set the hd marker. (org-clock-cancel): Reset markers. @@ -8329,8 +8332,8 @@ * org.el (org-modules): Add org-track.el. * org-agenda.el (org-agenda-bulk-marked-p): New function. - (org-agenda-bulk-mark, org-agenda-bulk-unmark): Use - `org-agenda-bulk-marked-p'. + (org-agenda-bulk-mark, org-agenda-bulk-unmark): + Use `org-agenda-bulk-marked-p'. (org-agenda-bulk-toggle): New command. 2009-09-02 Carsten Dominik @@ -8396,8 +8399,8 @@ 2009-08-06 Carsten Dominik - * org-list.el (org-list-send-list): Call - `org-list-goto-true-beginning' instead of + * org-list.el (org-list-send-list): + Call `org-list-goto-true-beginning' instead of `org-list-find-true-beginning', which does not exist. * org-timer.el (org-timer-reset-timers): Use `mapc'. @@ -8415,8 +8418,8 @@ (org-startup-options): Add new options indent and noindent. (org-unfontify-region): Remove line-prefix and wrap-prefix properties. - (org-after-demote-entry-hook, org-after-promote-entry-hook): New - hooks. + (org-after-demote-entry-hook, org-after-promote-entry-hook): + New hooks. (org-promote, org-demote): Run the new hooks. * org-table.el (org-table-align): Replace leading \n as well. @@ -8459,8 +8462,8 @@ 2009-08-06 Carsten Dominik - * org-table.el (org-table-cut-region, org-table-copy-region): Work - on single field if no active region. + * org-table.el (org-table-cut-region, org-table-copy-region): + Work on single field if no active region. 2009-08-06 Carsten Dominik @@ -8502,8 +8505,8 @@ * org.el (org-store-link): Never store a link to an inline task. - * org-footnote.el (org-footnote-goto-local-insertion-point): Skip - inline tasks when positioning footnotes. + * org-footnote.el (org-footnote-goto-local-insertion-point): + Skip inline tasks when positioning footnotes. * org.el (org-refile): Remove the END line when archiving an inline task that does have an END line. @@ -8549,8 +8552,8 @@ 2009-08-06 Bastien Guerry - * org-protocol.el (org-protocol-default-template-key): New - option. + * org-protocol.el (org-protocol-default-template-key): + New option. * org.el (org-refile): Bugfix: save-excursion before reading the refile target, otherwise cursor moves might confuse `org-refile'. @@ -8578,8 +8581,8 @@ * org.el (org-mode-map): New key for org-timer-set-timer. * org-timer.el (org-timer-reset-timers) - (org-timer-show-remaining-time, org-timer-set-timer): New - functions. + (org-timer-show-remaining-time, org-timer-set-timer): + New functions. * org-clock.el (org-show-notification): Update the docstring. @@ -8648,8 +8651,8 @@ * org.el (org-get-refile-targets): Fix bug: don't ignore case when building the list of targets. - * org-remember.el (org-remember-delete-empty-lines-at-end): New - option. + * org-remember.el (org-remember-delete-empty-lines-at-end): + New option. (org-remember-handler): Use the new option. 2009-08-06 James TD Smith @@ -8676,8 +8679,8 @@ * org-latex.el (org-export-latex-first-lines): Fix problem with publishing the region. - * org-exp.el (org-export-format-source-code-or-example): Fix - bad line numbering when exporting examples in HTML. + * org-exp.el (org-export-format-source-code-or-example): + Fix bad line numbering when exporting examples in HTML. 2009-08-06 James TD Smith @@ -8723,8 +8726,8 @@ * org-exp.el (org-infile-export-plist): Read BIND lines. (org-install-letbind): New function. - (org-export-as-org, org-export-preprocess-string): Call - `org-install-letbind'. + (org-export-as-org, org-export-preprocess-string): + Call `org-install-letbind'. * org-list.el (org-list-demote-modify-bullet): New option. (org-first-list-item-p): Save point. @@ -8741,8 +8744,8 @@ * org-footnote.el (org-footnote-auto-adjust): New option. (org-footnote-auto-adjust-maybe): New function. - (org-footnote-new, org-footnote-delete): Call - `org-footnote-auto-adjust-maybe'. + (org-footnote-new, org-footnote-delete): + Call `org-footnote-auto-adjust-maybe'. * org.el (org-startup-options): Add new footnote-related keywords. @@ -8905,16 +8908,16 @@ in column values. (org-columns-capture-view): Exclude comment and archived trees. - * org-colview-xemacs.el (org-columns-capture-view): Protect - vertical bars in column values. + * org-colview-xemacs.el (org-columns-capture-view): + Protect vertical bars in column values. (org-columns-capture-view): Exclude comment and archived trees. * org.el (org-quote-vert): New function. * org-latex.el (org-export-latex-verbatim-wrap): New option. - * org-exp.el (org-export-format-source-code-or-example): Use - `org-export-latex-verbatim-wrap'. + * org-exp.el (org-export-format-source-code-or-example): + Use `org-export-latex-verbatim-wrap'. * org.el (org-clone-subtree-with-time-shift): Also shift inactive time stamps. @@ -8946,8 +8949,8 @@ 2009-08-06 Carsten Dominik - * org-icalendar.el (org-icalendar-include-bbdb-anniversaries): New - option. + * org-icalendar.el (org-icalendar-include-bbdb-anniversaries): + New option. (org-export-icalendar): Call `org-bbdb-anniv-export-ical'. * org-bbdb.el (org-bbdb-anniv-export-ical): New function. @@ -8969,8 +8972,8 @@ * org-remember.el (org-remember-handler): Abort remember if the buffer is empty. - * org-exp.el (org-export-format-source-code-or-example): Run - `org-src-mode-hook'. + * org-exp.el (org-export-format-source-code-or-example): + Run `org-src-mode-hook'. 2009-08-06 Carsten Dominik @@ -8987,8 +8990,8 @@ * org-macs.el (org-replace-match-keep-properties): New function. - * org-exp.el (org-export-mark-blockquote-verse-center): Better - preprocessing of center and quote and verse blocks. + * org-exp.el (org-export-mark-blockquote-verse-center): + Better preprocessing of center and quote and verse blocks. * org-list.el (org-list-end): Respect the stored "original" indentation when determining the end of the list. @@ -9011,8 +9014,8 @@ 2009-08-06 Carsten Dominik - * org-exp.el (org-export-format-source-code-or-example): Remember - the original indentation of source code snippets and examples. + * org-exp.el (org-export-format-source-code-or-example): + Remember the original indentation of source code snippets and examples. * org-latex.el (org-export-as-latex): Relocate the table of contents. @@ -9088,35 +9091,35 @@ (org-table-edit-formulas, orgtbl-ctrl-c-ctrl-c) (orgtbl-gather-send-defs): Allow indented #+TBLFM line. - * org.el (org-fontify-meta-lines, org-ctrl-c-ctrl-c): Allow - indented #+TBLFM line. + * org.el (org-fontify-meta-lines, org-ctrl-c-ctrl-c): + Allow indented #+TBLFM line. - * org-footnote.el (org-footnote-goto-local-insertion-point): Allow - indented #+TBLFM line. + * org-footnote.el (org-footnote-goto-local-insertion-point): + Allow indented #+TBLFM line. * org-colview.el (org-dblock-write:columnview): Allow indented #+TBLFM line. - * org-colview-xemacs.el (org-dblock-write:columnview): Allow - indented #+TBLFM line. + * org-colview-xemacs.el (org-dblock-write:columnview): + Allow indented #+TBLFM line. * org-clock.el (org-dblock-write:clocktable): Allow indented #+TBLFM line. 2009-08-06 Carsten Dominik - * org-exp.el (org-export-format-source-code-or-example): Make - editing indented blocks work correctly. + * org-exp.el (org-export-format-source-code-or-example): + Make editing indented blocks work correctly. * org.el (org-edit-src-nindent): New variable. (org-edit-src-code, org-edit-fixed-width-region) - (org-edit-src-find-region-and-lang, org-edit-src-exit): Make - editing indented blocks work correctly. + (org-edit-src-find-region-and-lang, org-edit-src-exit): + Make editing indented blocks work correctly. 2009-08-06 Carsten Dominik - * org-exp.el (org-export-replace-src-segments-and-examples): Find - indented blocks. + * org-exp.el (org-export-replace-src-segments-and-examples): + Find indented blocks. (org-export-format-source-code-or-example): Fix indentation of blocks. (org-export-remove-indentation): New function. @@ -9135,18 +9138,18 @@ 2009-08-06 Carsten Dominik * org.el (org-treat-insert-todo-heading-as-state-change) - (org-treat-S-cursor-todo-selection-as-state-change): New - variables. - (org-insert-todo-heading): Honor - `org-treat-insert-todo-heading-as-state-change'. - (org-shiftright, org-shiftleft): Honor - `org-treat-S-cursor-todo-selection-as-state-change'. + (org-treat-S-cursor-todo-selection-as-state-change): + New variables. + (org-insert-todo-heading): + Honor `org-treat-insert-todo-heading-as-state-change'. + (org-shiftright, org-shiftleft): + Honor `org-treat-S-cursor-todo-selection-as-state-change'. (org-inhibit-logging): New variable. 2009-08-06 Carsten Dominik - * org-agenda.el (org-remove-subtree-entries-from-agenda): Reduce - range for marker position checking. + * org-agenda.el (org-remove-subtree-entries-from-agenda): + Reduce range for marker position checking. * org-latex.el (org-export-latex-first-lines): Fix bug when exporting a region. @@ -9169,8 +9172,8 @@ * org-latex.el (org-export-latex-low-levels): Fix customization type. - * org.el (org-priority, org-shiftup, org-shiftdown): Disable - priority commands. + * org.el (org-priority, org-shiftup, org-shiftdown): + Disable priority commands. * org-agenda.el (org-agenda-priority): Disable priority commands. @@ -9185,17 +9188,17 @@ * org-exp.el (org-export-push-to-kill-ring): New function. (org-export-copy-to-kill-ring): New option. - * org-latex.el (org-export-as-latex): Call - `org-export-push-to-kill-ring'. - - * org-exp.el (org-export-show-temporary-export-buffer): New - option. - - * org-latex.el (org-export-as-latex): Use - `org-export-show-temporary-export-buffer'. - - * org-exp.el (org-export-show-temporary-export-buffer): New - option. + * org-latex.el (org-export-as-latex): + Call `org-export-push-to-kill-ring'. + + * org-exp.el (org-export-show-temporary-export-buffer): + New option. + + * org-latex.el (org-export-as-latex): + Use `org-export-show-temporary-export-buffer'. + + * org-exp.el (org-export-show-temporary-export-buffer): + New option. (org-export-push-to-kill-ring): New function. * org-colview.el (org-columns-compile-map): New variable. @@ -9258,8 +9261,8 @@ * org-latex.el (org-export-latex-complex-heading-re): New variable. (org-export-as-latex): Force the correct regexp in the preprocessor buffer. - (org-export-latex-set-initial-vars): Set - `org-export-latex-complex-heading-re'. + (org-export-latex-set-initial-vars): + Set `org-export-latex-complex-heading-re'. * org-agenda.el (org-agenda-start-with-log-mode): New option. (org-agenda-mode): Use `org-agenda-start-with-log-mode'. @@ -9342,8 +9345,8 @@ * org-clock.el (org-clock-insert-selection-line): Fix prefious patch. - * org.el (org-edit-src-code, org-edit-fixed-width-region): Use - separate buffer instead of indirect buffer to edit source code. + * org.el (org-edit-src-code, org-edit-fixed-width-region): + Use separate buffer instead of indirect buffer to edit source code. (org-edit-src-exit): Make this function work with the new setup. * org-clock.el (org-clock-insert-selection-line): Make sure tasks @@ -9365,8 +9368,8 @@ * org-list.el (org-reset-checkbox-state-subtree): Move here from org-checklist.el. - (org-reset-checkbox-state-subtree): Call - `org-reset-checkbox-state-subtree'. + (org-reset-checkbox-state-subtree): + Call `org-reset-checkbox-state-subtree'. * org-remember.el (org-select-remember-template): For the selection of a valid template. @@ -9434,11 +9437,11 @@ * org.el (org-prepare-agenda-buffers): Catch a throw to nextfile. * org-protocol.el: Remove dependency on url.el. - (org-protocol-unhex-compound, org-protocol-open-source): Remove - dependency on url.el. + (org-protocol-unhex-compound, org-protocol-open-source): + Remove dependency on url.el. - * org-latex.el (org-export-as-pdf): Use - `org-latex-to-pdf-process'. + * org-latex.el (org-export-as-pdf): + Use `org-latex-to-pdf-process'. 2009-08-06 Carsten Dominik @@ -9446,8 +9449,8 @@ * org-agenda.el (org-agenda-skip-additional-timestamps-same-entry): New option. - (org-agenda-get-timestamps): Honor - `org-agenda-skip-additional-timestamps-same-entry'. + (org-agenda-get-timestamps): + Honor `org-agenda-skip-additional-timestamps-same-entry'. * org-clock.el (org-clock-goto-may-find-recent-task): New option. (org-clock-goto): Find recent task only if @@ -9472,8 +9475,8 @@ * org.el (org-tab-first-hook) (org-tab-after-check-for-table-hook) (org-tab-after-check-for-cycling-hook): New hooks. - (org-cycle-internal-global, org-cycle-internal-local): New - functions, split out from `org-cycle'. + (org-cycle-internal-global, org-cycle-internal-local): + New functions, split out from `org-cycle'. (org-cycle): Call the new hooks. 2009-08-06 Carsten Dominik @@ -9481,13 +9484,13 @@ * org-exp.el (org-export-preprocess-string): Reset the list of preferred targets for each run of the preprocessor. - * org.el (org-refile-target-verify-function): Improve - documentation. + * org.el (org-refile-target-verify-function): + Improve documentation. (org-get-refile-targets): Respect point being moved by the verification function. - * org-latex.el (org-export-latex-timestamp-keyword-markup): New - option. + * org-latex.el (org-export-latex-timestamp-keyword-markup): + New option. (org-export-latex-keywords): Use new option. * org.el (org-rear-nonsticky-at): New defsubst. @@ -9500,8 +9503,8 @@ 2009-08-06 Carsten Dominik * org-protocol.el (server-edit): Declare `server-edit'. - (org-protocol-unhex-string, org-protocol-unhex-compound): New - functions. + (org-protocol-unhex-string, org-protocol-unhex-compound): + New functions. (org-protocol-check-filename-for-protocol): Call `server-edit'. * org.el (org-default-properties): New default properteis for @@ -9682,15 +9685,15 @@ * org-agenda.el (org-agenda-confirm-kill) (org-agenda-custom-commands-local-options) (org-timeline-show-empty-dates, org-agenda-ndays) - (org-agenda-start-on-weekday, org-scheduled-past-days): Fix - customization type from number to integer. + (org-agenda-start-on-weekday, org-scheduled-past-days): + Fix customization type from number to integer. 2009-08-06 Carsten Dominik * org-protocol.el: Declare some functions. - * org-agenda.el (org-agenda-compare-effort): Honor - `org-sort-agenda-noeffort-is-high'. + * org-agenda.el (org-agenda-compare-effort): + Honor `org-sort-agenda-noeffort-is-high'. (org-agenda-filter-by-tag, org-agenda-filter-make-matcher) (org-agenda-compare-effort): Implement the "?" operator for finding entries without effort setting. @@ -9793,8 +9796,8 @@ * org-mac-message.el (org-mac-flagged-mail): New group. (org-mac-mail-account): New variable. - (org-mac-create-flagged-mail, org-mac-insert-flagged-mail): New - commands. + (org-mac-create-flagged-mail, org-mac-insert-flagged-mail): + New commands. * org-remember.el (org-remember-backup-directory): New variable. (org-remember-apply-template): Write file to backup directory. @@ -9807,15 +9810,15 @@ * org-table.el (org-table-beginning-of-field) (org-table-end-of-field): New commands. - (org-table-previous-field, org-table-beginning-of-field): Better - error messages. + (org-table-previous-field, org-table-beginning-of-field): + Better error messages. (orgtbl-setup): Include `M-a' and `M-e'. - * org.el (org-backward-sentence, org-forward-sentence): New - commands. + * org.el (org-backward-sentence, org-forward-sentence): + New commands. - * org-colview.el (org-colview-initial-truncate-line-value): New - variable. + * org-colview.el (org-colview-initial-truncate-line-value): + New variable. (org-columns-remove-overlays): Restore the value of `truncate-lines'. (org-columns): Remember the value of `truncate-lines'. @@ -9871,11 +9874,11 @@ sub-projects. (org-agenda-skip-entry-when-regexp-matches) (org-agenda-skip-entry-when-regexp-matches-in-subtree): New functions. - (org-agenda-list-stuck-projects): Use - `org-agenda-skip-entry-when-regexp-matches-in-subtree'. + (org-agenda-list-stuck-projects): + Use `org-agenda-skip-entry-when-regexp-matches-in-subtree'. - * org-latex.el (org-export-latex-preprocess): Improve - export of verses. + * org-latex.el (org-export-latex-preprocess): + Improve export of verses. * org-exp.el (org-export-as-html): Implement centering as a div rather than a paragraph. Do a better job with line-end in verse @@ -9890,8 +9893,8 @@ * org-latex.el (org-export-latex-preprocess): Implement the centering markup. - * org-exp.el (org-export-mark-blockquote-verse-center): Rename - from `org-export-mark-blockquote-and-verse'. + * org-exp.el (org-export-mark-blockquote-verse-center): + Rename from `org-export-mark-blockquote-and-verse'. (org-export-as-html): Implement the centering markup. * org-latex.el (org-export-latex-tables): Fix vertical @@ -9917,16 +9920,16 @@ 2009-08-06 Carsten Dominik - * org-latex.el (org-export-latex-emphasis-alist): Better - defaults for verbose emphasis. + * org-latex.el (org-export-latex-emphasis-alist): + Better defaults for verbose emphasis. (org-export-latex-emph-format): New function. (org-export-latex-fontify): Call `org-export-latex-emph-format'. * org-agenda.el (org-agenda-menu): Add new commands to menu. (org-agenda-do-date-later, org-agenda-do-date-earlier) (org-agenda-date-later-minutes, org-agenda-date-earlier-minutes) - (org-agenda-date-later-hours, org-agenda-date-earlier-hours): New - commands. + (org-agenda-date-later-hours, org-agenda-date-earlier-hours): + New commands. * org.el (org-timestamp-change): Move end-time along with start time. @@ -9958,8 +9961,8 @@ (org-publish-projects, org-publish-org-index): Change default anme for the index of file names to "sitemap.org". - * org-latex.el (org-export-latex-tables): Use - `org-split-string', for Emacs 21 compatibility. + * org-latex.el (org-export-latex-tables): + Use `org-split-string', for Emacs 21 compatibility. 2009-08-06 Carsten Dominik @@ -9975,10 +9978,10 @@ (org-get-current-options): Add new keywords. (org-export-as-html): Publish description and keywords. - * org-agenda.el (org-agenda-add-entry-text-descriptive-links): New - option. - (org-agenda-add-entry-text): Honor - `org-agenda-add-entry-text-descriptive-links'. + * org-agenda.el (org-agenda-add-entry-text-descriptive-links): + New option. + (org-agenda-add-entry-text): + Honor `org-agenda-add-entry-text-descriptive-links'. * org-latex.el (org-export-latex-preprocess): Make all external preprocess functions use a PARAMETER arg. @@ -9997,8 +10000,8 @@ `org-export-html-style-include-scripts'. (org-export-as-html): Honor new option `org-export-html-style-include-scripts'. - (org-export-html-scripts, org-export-html-style-default): Fix - xml issues with the Safari browser. + (org-export-html-scripts, org-export-html-style-default): + Fix xml issues with the Safari browser. 2009-08-06 Carsten Dominik @@ -10015,8 +10018,8 @@ 2009-08-06 Carsten Dominik - * org-exp.el (org-export-format-source-code-or-example): Mark - temporary buffer unmodified, so that it will be killed even if + * org-exp.el (org-export-format-source-code-or-example): + Mark temporary buffer unmodified, so that it will be killed even if mode like message mode has decided to assign a file name. * org.el (org-scan-tags): Improve tag inheritance. @@ -10035,8 +10038,8 @@ * org.el (org-add-planning-info): Fix bug with looking for keyword only at column 0. - * org-agenda.el (org-agenda-custom-commands-local-options): Add - option for tags filter preset. + * org-agenda.el (org-agenda-custom-commands-local-options): + Add option for tags filter preset. (org-prepare-agenda): Store filter preset as a property on the filter variable. (org-finalize-agenda): Call the filter, if there is a preset. @@ -10055,8 +10058,8 @@ (org-agenda-fontify-priorities): Rename from org-fontify-priorities. - * org.el (org-set-font-lock-defaults): Call - `org-font-lock-add-priority-faces'. + * org.el (org-set-font-lock-defaults): + Call `org-font-lock-add-priority-faces'. (org-font-lock-add-priority-faces): New function. * org-faces.el (org-set-tag-faces): New option. @@ -10113,8 +10116,8 @@ * org.el (org-blank-before-new-entry): Mention the dependence on `org-empty-line-terminates-plain-lists' in the docstring. - * org-publish.el (org-publish-get-project-from-filename): New - optional argument UP. Only find the top project if UP is set. + * org-publish.el (org-publish-get-project-from-filename): + New optional argument UP. Only find the top project if UP is set. (org-publish-current-project): Find the top encloding project. * org-agenda.el (org-agenda-before-write-hook) @@ -10128,15 +10131,15 @@ * org-exp.el (org-export-ascii-links-to-notes): New option. (org-export-as-ascii): Handle links better. - (org-export-ascii-wrap, org-export-ascii-push-links): New - functions. + (org-export-ascii-wrap, org-export-ascii-push-links): + New functions. 2009-08-06 Carsten Dominik * org-agenda.el (org-agenda): Make prefix arg optional. (org-agenda-search-headline-for-time): New option. - (org-format-agenda-item): Honor - `org-agenda-search-headline-for-time'. + (org-format-agenda-item): + Honor `org-agenda-search-headline-for-time'. * org-table.el (orgtbl-self-insert-command): Cluster undo for 20 characters. @@ -10207,8 +10210,8 @@ 2009-02-19 Carsten Dominik - * org.el (org-block-todo-from-children-or-siblings): Use - `org-up-heading-all' so that this will work correctly with hidden + * org.el (org-block-todo-from-children-or-siblings): + Use `org-up-heading-all' so that this will work correctly with hidden property drawers and entries. (org-end-of-line, org-beginning-of-line): Make prefix arg work, by falling back to normal, default command. @@ -10289,8 +10292,8 @@ * org-exp.el (org-export-html-footnotes-section): Make the div id consistent. - * org-export-latex.el (org-export-latex-classes): Remove - paper size option from LaTeX classes. + * org-export-latex.el (org-export-latex-classes): + Remove paper size option from LaTeX classes. 2009-01-31 Carsten Dominik @@ -10373,8 +10376,8 @@ * org-agenda.el (org-agenda-todo): Call `org-todo' interactively, to get real errors from the blocker hook. - * org.el (org-shiftselect-error, org-call-for-shift-select): New - functions. + * org.el (org-shiftselect-error, org-call-for-shift-select): + New functions. (org-set-visibility-according-to-property): Turn off the setting of `org-show-entry-below', to avoid overruling a FOLDED visibility property. @@ -10391,13 +10394,13 @@ * org-footnote.el (org-footnote-normalize): Remove unnecessary variable. - (org-insert-footnote-reference-near-definition): Remove - unnecessary let form. + (org-insert-footnote-reference-near-definition): + Remove unnecessary let form. 2009-01-26 Carsten Dominik - * org-export-latex.el (org-export-as-latex): Call - `org-export-latex-first-lines' with OPT-PLIST as a parameter. + * org-export-latex.el (org-export-as-latex): + Call `org-export-latex-first-lines' with OPT-PLIST as a parameter. (org-export-latex-first-lines): New parameter OPT-PLIST. * org.el (org-yank): Tell `delete-selection-mode' about @@ -10405,8 +10408,8 @@ * org-faces.el (org-clock-overlay): Fix face definition. - * org-export-latex.el (org-export-latex-first-lines): Pass - timestamp and footnote parameters to the preprocessor. + * org-export-latex.el (org-export-latex-first-lines): + Pass timestamp and footnote parameters to the preprocessor. * org-exp.el (org-export-remove-timestamps): Do not remove time stamps inside tables. @@ -10415,8 +10418,8 @@ * org-exp.el (org-export-as-html): Turn \par into a paragraph. - * org.el (org-agenda-tags-todo-honor-ignore-options): Declare - variable. + * org.el (org-agenda-tags-todo-honor-ignore-options): + Declare variable. * org-table.el (org-table-insert-hline): Fix typo in fuction call to `backward-char'. @@ -10424,21 +10427,21 @@ * org-exp.el (org-export-as-html): Remove the initial space from colon examples. - * org.el (org-scan-tags): Call - `org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item'. + * org.el (org-scan-tags): + Call `org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item'. - * org-agenda.el (org-agenda-todo-list, org-agenda-match-view): New - customization groups. + * org-agenda.el (org-agenda-todo-list, org-agenda-match-view): + New customization groups. (org-agenda-tags-todo-honor-ignore-options): New option. (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item): New function. - (org-agenda-get-todos): Use - `org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item'. + (org-agenda-get-todos): + Use `org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item'. 2009-01-25 Carsten Dominik - * org-exp.el (org-export-format-source-code-or-example): Escape - HTML characters also in examples that anre not treated with + * org-exp.el (org-export-format-source-code-or-example): + Escape HTML characters also in examples that anre not treated with htmlize. Also, just switch to EXAMPLE processing if we do not have a good version of htmlize. @@ -10494,8 +10497,8 @@ 2009-01-25 Carsten Dominik - * org-export-latex.el (org-export-latex-quotation-marks): Use - `org-if-unprotected-1'. + * org-export-latex.el (org-export-latex-quotation-marks): + Use `org-if-unprotected-1'. (org-export-latex-set-initial-vars): Check for class definition in property. @@ -10505,8 +10508,8 @@ * org-compat.el (org-count-lines): New function. - * org-exp.el (org-export-format-source-code-or-example): Handle - switches related to text areas. + * org-exp.el (org-export-format-source-code-or-example): + Handle switches related to text areas. * org.el (org-activate-footnote-links): Don't allow match inside a link. @@ -10541,17 +10544,17 @@ * org.el (org-image-file-name-regexp, org-file-image-p): Allow the list of extensions to be a parameter. - * org-exp.el (org-export-html-inline-image-extensions): New - variable. + * org-exp.el (org-export-html-inline-image-extensions): + New variable. - * org-agenda.el (org-prepare-agenda): Use - `org-agenda-block-separator'. + * org-agenda.el (org-prepare-agenda): + Use `org-agenda-block-separator'. (org-agenda-block-separator): New option. 2009-01-25 Carsten Dominik - * org-export-latex.el (org-export-latex-tables): Call - `org-table-clean-before-export' with the new optional argument. + * org-export-latex.el (org-export-latex-tables): + Call `org-table-clean-before-export' with the new optional argument. * org-exp.el (org-table-clean-before-export): New optional parameter MAYBE-QUOTED, allows for quoted characters like \# in @@ -10562,8 +10565,8 @@ * org-plot.el (org-plot/gnuplot): Fix text-ind parameter for histograms. - * org-colview.el (org-colview-construct-allowed-dates): Better - error catching when a date/time property does not have allowed + * org-colview.el (org-colview-construct-allowed-dates): + Better error catching when a date/time property does not have allowed values defined. * org-colview-xemacs.el (org-colview-construct-allowed-dates): @@ -10592,8 +10595,8 @@ 2009-01-25 Carsten Dominik - * org-compat.el (org-fit-window-to-buffer): Use - `window-full-width-p'. + * org-compat.el (org-fit-window-to-buffer): + Use `window-full-width-p'. * org-export-latex.el (org-export-latex-fixed-width): Enforce the space after the colon in short examples. @@ -10649,8 +10652,8 @@ (org-timer-stop): New command. (org-timer-seconds): Return correct time when timer is paused. (org-timer-mode-line-timer): New variable. - (org-timer-set-mode-line, org-timer-update-mode-line): New - functions. + (org-timer-set-mode-line, org-timer-update-mode-line): + New functions. * org.el (org-insert-heading): Handle new value `auto' for `org-blank-before-new-entry'. @@ -10699,19 +10702,19 @@ * org-exp.el (org-export-preprocess-string): Remove clock lines and timestamps already in the preprocesor. - (org-export-remove-timestamps, org-export-remove-clock-lines): New - functions. + (org-export-remove-timestamps, org-export-remove-clock-lines): + New functions. (org-export-as-ascii, org-export-as-html): Add the timestamps parameter to the preprocessor parameter list. * org-list.el (org-list-parse-list): Parse for checkboxes. (org-list-to-generic): Introduce and handle new parameters :cbon and :cboff. - (org-list-to-latex, org-list-to-html, org-list-to-texinfo): Add - optional parameter PARAMS. + (org-list-to-latex, org-list-to-html, org-list-to-texinfo): + Add optional parameter PARAMS. - * org-export-latex.el (org-export-latex-special-chars): Fix - problems with interpreting dollar signs. + * org-export-latex.el (org-export-latex-special-chars): + Fix problems with interpreting dollar signs. (org-inside-latex-math-p): New function. (org-export-latex-preprocess): Protect all the math fragments. @@ -10723,8 +10726,8 @@ * org-agenda.el (org-run-agenda-series): Have series options set when finalizing the agenda. - * org-exp.el (org-export-format-source-code-or-example): Protect - the converted examples. + * org-exp.el (org-export-format-source-code-or-example): + Protect the converted examples. * org.el (org-set-regexps-and-options): Fix the regexp `org-complex-heading-regexp'. @@ -10768,8 +10771,8 @@ * org-macs.el (org-re): Handle the [:word:] class. - * org-exp.el (org-export-preprocess-string): Call - `org-export-protect-colon-examples'. + * org-exp.el (org-export-preprocess-string): + Call `org-export-protect-colon-examples'. (org-export-protect-colon-examples): Rename from `org-export-protect-examples', and scope limited to lines starting with a colon. @@ -10799,8 +10802,8 @@ (org-export-latex-preprocess): Treat multiple references to a footnote. - * org-exp.el (org-export-preprocess-string): Call - `org-footnote-normalize'. + * org-exp.el (org-export-preprocess-string): + Call `org-footnote-normalize'. (org-export-as-ascii, org-export-as-html): Pass footnote variable to preprocessor. (org-export-as-html): Treat multiple references to a footnote. @@ -10811,8 +10814,8 @@ links. * org.el (org-bracket-link-analytic-regexp++): New variable. - (org-make-link-regexps): Initialize - `org-bracket-link-analytic-regexp++'. + (org-make-link-regexps): + Initialize `org-bracket-link-analytic-regexp++'. (org-store-link): Implement special case in edit-src buffer. (org-insert-link): No use of ide to insert stored links. (org-link-search): Implement special case for coderefs. @@ -10840,8 +10843,8 @@ 2009-01-16 Glenn Morris - * org-mouse.el (org-mouse-show-context-menu): Use - mouse-menu-major-mode-map, if defined, rather than the obsolete + * org-mouse.el (org-mouse-show-context-menu): + Use mouse-menu-major-mode-map, if defined, rather than the obsolete mouse-major-mode-menu. 2008-12-23 Carsten Dominik @@ -10866,8 +10869,8 @@ 2008-12-20 Carsten Dominik - * org.el (org-get-refile-targets, org-refile-get-location): Use - expanded file name to improve comparison. + * org.el (org-get-refile-targets, org-refile-get-location): + Use expanded file name to improve comparison. 2008-12-20 Carsten Dominik @@ -10879,12 +10882,12 @@ * org-export-latex.el (org-export-latex-links): Fix bug with undefined label. - * org-table.el (org-table-get-specials): Set - `org-table-current-last-data-line'. + * org-table.el (org-table-get-specials): + Set `org-table-current-last-data-line'. (org-table-current-last-data-line): New variable. (org-table-insert-column, org-table-delete-column) - (org-table-move-column, org-table-fix-formulas): Call - `org-table-fix-formulas' a second time to fix the $LR references. + (org-table-move-column, org-table-fix-formulas): + Call `org-table-fix-formulas' a second time to fix the $LR references. (org-table-get-specials): Add the $LR references to the tables. (org-table-get-formula): Do not offer last-row names as LHS of formulas. @@ -10938,8 +10941,8 @@ * org.el (org-refile): Avoid refiling to within the region to be refiled. - * org-export-latex.el (org-export-latex-special-chars): Replace - special characters also in tables. + * org-export-latex.el (org-export-latex-special-chars): + Replace special characters also in tables. * org-agenda.el (org-agenda-change-all-lines): New argument FORCE-TAGS. @@ -10987,8 +10990,8 @@ (org-export-as-latex): Pass RBEG to `org-export-latex-first-lines'. (org-export-latex-make-header): Add some hard space after the table of contents. - (org-export-latex-first-lines): Accept RBEG argument. Mark - exported text so that it will be excuded in further steps. + (org-export-latex-first-lines): Accept RBEG argument. + Mark exported text so that it will be excuded in further steps. * org-table.el (org-table-get-specials): Make @0 reference the last line in a table. @@ -11008,8 +11011,8 @@ * org-exp.el (org-export-html-style-default): Add style definitions for the figure div. - (org-export-preprocess-string, org-export-as-html): Implement - attribute, label, and caption handling. + (org-export-preprocess-string, org-export-as-html): + Implement attribute, label, and caption handling. (org-export-attach-captions-and-attributes): New function. (org-export-html-format-image): New function. (org-format-org-table-html): Implement attribute, label, and @@ -11097,8 +11100,8 @@ * org-w3m.el (w3m-minor-mode-hook): Also add the special copy command to the `w3m-minor-mode-map'. - * org-archive.el (org-archive-to-archive-sibling): Protect - `this-command' to avoid appending kills during archiving. + * org-archive.el (org-archive-to-archive-sibling): + Protect `this-command' to avoid appending kills during archiving. * org-exp.el (org-export-with-priority): New variable. (org-export-add-options-to-plist): Use `org-export-plist-vars' @@ -11126,8 +11129,8 @@ 2008-12-07 Carsten Dominik * org.el (org-tags-exclude-from-inheritance): New option. - (org-tag-inherit-p, org-remove-uniherited-tags): Respect - `org-tags-exclude-from-inheritance'. + (org-tag-inherit-p, org-remove-uniherited-tags): + Respect `org-tags-exclude-from-inheritance'. * org-agenda.el (org-agenda-show-inherited-tags): New option. (org-format-agenda-item): Add inherited tags to the agenda line @@ -11185,8 +11188,8 @@ accidentially overwritten by last commit to Emacs. * org.el (org-outline-path-complete-in-steps): New option. - (org-refile-get-location): Honor - `org-outline-path-complete-in-steps'. + (org-refile-get-location): + Honor `org-outline-path-complete-in-steps'. (org-agenda-change-all-lines, org-tags-sparse-tree) (org-time-string-to-absolute, org-small-year-to-year) (org-link-escape): Re-apply changes accidentially overwritten @@ -11209,8 +11212,8 @@ line before the first headline to always be included. This is to not miss a commented target. - * org-mouse.el (org-mouse-insert-item): Call - `org-indent-to-column' instead of `indent-to', for XEmacs + * org-mouse.el (org-mouse-insert-item): + Call `org-indent-to-column' instead of `indent-to', for XEmacs compatibility. * org.el (org-refile-targets): Fix customize definition so @@ -11233,18 +11236,18 @@ 2008-11-23 Carsten Dominik - * org-remember.el (org-remember-apply-template): Use - `org-substring-no-properties'. + * org-remember.el (org-remember-apply-template): + Use `org-substring-no-properties'. * org-compat.el (org-substring-no-properties): New function. - * org-remember.el (org-remember-apply-template): Use - `org-substring-no-properties' for compatibility. + * org-remember.el (org-remember-apply-template): + Use `org-substring-no-properties' for compatibility. - * org-list.el (org-list-two-spaces-after-bullet-regexp): New - option. - (org-fix-bullet-type): Respect - `org-list-two-spaces-after-bullet-regexp'. + * org-list.el (org-list-two-spaces-after-bullet-regexp): + New option. + (org-fix-bullet-type): + Respect `org-list-two-spaces-after-bullet-regexp'. * org-clock.el (org-clock-load): Clean up the code. @@ -11309,8 +11312,8 @@ (org-set-property, org-delete-property) (org-delete-property-globally): Use `org-ido-completing-read'. - * org-remember.el (org-remember-apply-template): Use - `org-ido-completing-read'. + * org-remember.el (org-remember-apply-template): + Use `org-ido-completing-read'. * org-publish.el (org-publish): Use `org-ido-completing-read'. @@ -11318,14 +11321,14 @@ (org-insert-columns-dblock): Use `org-ido-completing-read'. * org-colview-xemacs.el (org-columns-edit-value) - (org-columns-new, org-insert-columns-dblock): Use - `org-ido-completing-read'. - - * org-attach.el (org-attach-delete-one, org-attach-open): Use - `org-ido-completing-read'. - - * org-agenda.el (org-todo-list, org-agenda-filter-by-tag): Use - `org-ido-completing-read'. + (org-columns-new, org-insert-columns-dblock): + Use `org-ido-completing-read'. + + * org-attach.el (org-attach-delete-one, org-attach-open): + Use `org-ido-completing-read'. + + * org-agenda.el (org-todo-list, org-agenda-filter-by-tag): + Use `org-ido-completing-read'. * org.el (org-time-today): New function. (org-matcher-time): Use `org-time-today'. Add special treatment @@ -11340,8 +11343,8 @@ 2008-11-23 Carsten Dominik - * org-export-latex.el (org-export-latex-subcontent): Interprete - target aliases as additonal labels. + * org-export-latex.el (org-export-latex-subcontent): + Interprete target aliases as additonal labels. * org-exp.el (org-export-target-aliases): New variable. (org-export-preprocess-string) @@ -11388,8 +11391,8 @@ * org-vm.el (org-vm-follow-link): Require `vm-search'. - * org.el (org-up-heading-safe, org-forward-same-level): Always - call `org-back-to-heading' instead of `outline-back-to-heading'. + * org.el (org-up-heading-safe, org-forward-same-level): + Always call `org-back-to-heading' instead of `outline-back-to-heading'. (org-back-to-heading): New wrapper around outline-back-to-heading, with a useful error message telling where the error happened. @@ -11495,8 +11498,8 @@ * org.el (org-link-abbrev-alist): Improve customization type. - * org-attach.el (org-attach-expand-link, org-attach-expand): New - functions. + * org-attach.el (org-attach-expand-link, org-attach-expand): + New functions. * org-agenda.el (org-agenda-get-progress): Rename from `org-get-closed'. Implement searching for state changes as well. @@ -11535,8 +11538,8 @@ * org-exp.el (org-export-as-html): Make sure that
is between paragraphs, not inside. - * org.el (org-todo): Quote - `org-agenda-headline-snapshot-before-repeat'. + * org.el (org-todo): + Quote `org-agenda-headline-snapshot-before-repeat'. * org-exp.el (org-export-as-html): Fully process link descriptions. (org-export-html-format-desc): New function. @@ -11551,14 +11554,14 @@ really, a preliminary and incomplete version was present earlier, but not used). - * org.el (org-fast-todo-selection, org-fast-tag-selection): Use - `org-fit-window-to-buffer'. + * org.el (org-fast-todo-selection, org-fast-tag-selection): + Use `org-fit-window-to-buffer'. * org-exp.el (org-export): Use `org-fit-window-to-buffer'. * org-agenda.el (org-agenda-get-restriction-and-command) - (org-fit-agenda-window, org-agenda-convert-date): Use - `org-fit-window-to-buffer'. + (org-fit-agenda-window, org-agenda-convert-date): + Use `org-fit-window-to-buffer'. * org-exp.el (org-export-as-html): Process href links through `org-export-html-format-href'. @@ -11581,8 +11584,8 @@ (org-export-html-style-default): Mark style definitions as unparsed CDATA. - * org-publish.el (org-publish-validate-link): Function - re-introduced. + * org-publish.el (org-publish-validate-link): + Function re-introduced. 2008-11-12 Charles Sebold @@ -11727,8 +11730,8 @@ 2008-10-26 Bastien Guerry - * org-export-latex.el (org-export-latex-classes): Add - \usepackage{graphicx} to the default list of packages. + * org-export-latex.el (org-export-latex-classes): + Add \usepackage{graphicx} to the default list of packages. 2008-10-26 Carsten Dominik @@ -11742,8 +11745,8 @@ (org-add-log-note): Mask prefix argument when immediately storing the note. - * org-agenda.el (org-agenda-filter-effort-default-operator): New - option. + * org-agenda.el (org-agenda-filter-effort-default-operator): + New option. 2008-10-26 James TD Smith @@ -11776,8 +11779,8 @@ 2008-10-26 Carsten Dominik - * org.el (org-add-log-setup): Respect - `org-log-state-notes-insert-after-drawers'. + * org.el (org-add-log-setup): + Respect `org-log-state-notes-insert-after-drawers'. (org-log-state-notes-insert-after-drawers): New option. (org-todo-trigger-tag-changes): New function. (org-todo): Call `org-todo-trigger-tag-changes'. @@ -11812,8 +11815,8 @@ 2008-10-26 Carsten Dominik - * org-export-latex.el (org-export-latex-preprocess): Improve - quoting of LaTeX environments. + * org-export-latex.el (org-export-latex-preprocess): + Improve quoting of LaTeX environments. 2008-10-19 Eli Zaretskii @@ -11868,8 +11871,8 @@ * org-attach.el (org-attach-auto-tag): New option. (org-attach-tag, org-attach-untag): New functions. - (org-attach-attach, org-attach-new, org-attach-sync): Call - `org-attach-tag'. + (org-attach-attach, org-attach-new, org-attach-sync): + Call `org-attach-tag'. (org-attach-delete): Call `org-attach-untag'. * org-table.el (orgtbl-self-insert-command): Make this work for @@ -11896,8 +11899,8 @@ * org-exp.el (org-infile-export-plist): Put the content of #+LATEX_HEADER: into the property :latex-header-extra. - * org-colview.el (org-columns-get-format-and-top-level): Remove - resetting the marker. + * org-colview.el (org-columns-get-format-and-top-level): + Remove resetting the marker. * org-colview-xemacs.el (org-columns-get-format-and-top-level): Remove resetting the marker. @@ -11909,8 +11912,8 @@ * org-exp.el (org-infile-export-plist): Allow multiple STYLE lines. * org.el (org-entry-get-multivalued-property) - (org-entry-protect-space, org-entry-restore-space): New - functions. + (org-entry-protect-space, org-entry-restore-space): + New functions. (org-file-apps-defaults-macosx): Let postscript files be opened by preview. (org-time-stamp-inactive): Call `org-time-stamp'. @@ -11945,8 +11948,8 @@ * org-bbdb.el (org-bbdb-anniversaries): Require bbdb in `org-bbdb-anniversaries'. - * org.el (org-get-next-sibling, org-forward-same-level): New - functions, similar to the outline versions, but invisible headings + * org.el (org-get-next-sibling, org-forward-same-level): + New functions, similar to the outline versions, but invisible headings are OK. 2008-10-12 Bastien Guerry @@ -12071,15 +12074,15 @@ (org-entries-lessp): Implement sorting by TODO state. (org-cmp-todo-state): New defsubst. - * org-colview.el (org-colview-construct-allowed-dates): New - function. - (org-columns-next-allowed-value): Use - `org-colview-construct-allowed-dates'. + * org-colview.el (org-colview-construct-allowed-dates): + New function. + (org-columns-next-allowed-value): + Use `org-colview-construct-allowed-dates'. - * org-colview-xemacs.el (org-colview-construct-allowed-dates): New - function. - (org-columns-next-allowed-value): Use - `org-colview-construct-allowed-dates'. + * org-colview-xemacs.el (org-colview-construct-allowed-dates): + New function. + (org-columns-next-allowed-value): + Use `org-colview-construct-allowed-dates'. * org.el (org-protect-slash): New function. (org-get-refile-targets): Use `org-protect-slash'. @@ -12087,8 +12090,8 @@ * org-agenda.el (org-global-tags-completion-table): New variable. * org-exp.el (org-export-handle-export-tags): New function. - (org-export-preprocess-string): Call - `org-export-handle-export-tags'. + (org-export-preprocess-string): + Call `org-export-handle-export-tags'. * org-publish.el (org-publish-expand-components): Function removed. (org-publish-expand-projects): Allow components to have components. @@ -12098,8 +12101,8 @@ (org-yank-and-fold-if-subtree): New function. * org-agenda.el (org-agenda-todayp): New function. - (org-agenda-get-deadlines, org-agenda-get-scheduled): Use - `org-agenda-todayp'. + (org-agenda-get-deadlines, org-agenda-get-scheduled): + Use `org-agenda-todayp'. * org.el (org-insert-heading-respect-content) (org-insert-todo-heading-respect-content): New commands. @@ -12207,11 +12210,11 @@ * org-agenda.el (org-agenda-align-tags): Fix bug with malformed face property. - * org-colview.el (org-columns-display-here): Use - `org-columns-modify-value-for-display-function'. + * org-colview.el (org-columns-display-here): + Use `org-columns-modify-value-for-display-function'. - * org-colview-xemacs.el (org-columns-display-here): Use - `org-columns-modify-value-for-display-function'. + * org-colview-xemacs.el (org-columns-display-here): + Use `org-columns-modify-value-for-display-function'. * org.el (org-columns-modify-value-for-display-function): New option. @@ -12268,14 +12271,14 @@ 2008-07-24 Carsten Dominik - * org-exp.el (org-export-region-as-html, org-export-as-html): Make - sure that calls from `org-export-region-as-html' do not do the + * org-exp.el (org-export-region-as-html, org-export-as-html): + Make sure that calls from `org-export-region-as-html' do not do the special check for a subtree. * org-agenda.el (org-batch-store-agenda-views): Fix parsing bug. - * org.el (org-open-file): Use - `org-open-directory-means-index-dot-org'. + * org.el (org-open-file): + Use `org-open-directory-means-index-dot-org'. (org-open-directory-means-index-dot-org): New option. * org.el (org-make-link-string): Remove link attributes from @@ -12291,8 +12294,8 @@ * org.el (org-narrow-to-subtree): Do not include the final newline into the narrowed region. - * org-agenda.el (org-agenda-custom-commands-local-options): Fix - bug with user-define skipping condition. + * org-agenda.el (org-agenda-custom-commands-local-options): + Fix bug with user-define skipping condition. * org-agenda.el (org-agenda-get-restriction-and-command): Fix typo. @@ -12311,8 +12314,8 @@ * org-publish.el (org-publish-find-title): Bug fix. (org-publish-org-index): Implement new :index-style option. - * org-publish.el (org-publish-timestamp-filename): Use - SHA1-encoded file names in the timestamp directory. + * org-publish.el (org-publish-timestamp-filename): + Use SHA1-encoded file names in the timestamp directory. * org-publish.el (org-publish-needed-p): Be verbose about files published and files skipped. @@ -12454,8 +12457,8 @@ `org-diary-to-ical-string' out of the loop, and kill the buffer afterwords. - * org-remember.el (org-remember-visit-immediately): Position - cursor after moving to the note. + * org-remember.el (org-remember-visit-immediately): + Position cursor after moving to the note. (org-remember-apply-template): Use a text property to record the cursor position. (org-remember-handler): Align tags after pasting the note. @@ -12498,8 +12501,8 @@ 2008-06-17 Carsten Dominik * org-remember.el (org-jump-to-target-location): New variable. - (org-remember-apply-template): Set - `org-remember-apply-template' if requested by template. + (org-remember-apply-template): + Set `org-remember-apply-template' if requested by template. (org-remember-handler): Start an idle timer to jump to remember location. @@ -12549,8 +12552,8 @@ 2008-06-17 Carsten Dominik - * org-agenda.el (org-agenda-columns-remove-prefix-from-item): New - option. + * org-agenda.el (org-agenda-columns-remove-prefix-from-item): + New option. * org-colview.el (org-agenda-columns-cleanup-item): New function. @@ -12671,11 +12674,11 @@ * org-clock.el (org-clock-display, org-clock-out) (org-update-mode-line): Use `org-time-clocksum-format'. - * org-colview-xemacs.el (org-columns-number-to-string): Use - `org-time-clocksum-format'. + * org-colview-xemacs.el (org-columns-number-to-string): + Use `org-time-clocksum-format'. - * org-colview.el (org-columns-number-to-string): Use - `org-time-clocksum-format'. + * org-colview.el (org-columns-number-to-string): + Use `org-time-clocksum-format'. 2008-06-17 Carsten Dominik @@ -12703,8 +12706,8 @@ (org-export-preprocess-string): Implement the COMMENT environment. - * org-export-latex.el (org-export-latex-preprocess): Implement - VERSE environment. + * org-export-latex.el (org-export-latex-preprocess): + Implement VERSE environment. 2008-06-17 Carsten Dominik @@ -12759,8 +12762,8 @@ 2008-06-17 Carsten Dominik - * org.el (org-remove-double-quotes, org-file-contents): New - functions. + * org.el (org-remove-double-quotes, org-file-contents): + New functions. * org-exp.el (org-infile-export-plist): Also parse the contents of #+SETUPFILE files, recursively. @@ -12769,8 +12772,8 @@ contents of #+SETUPFILE files, recursively. * org-exp.el (org-export-handle-include-files): New function. - (org-export-preprocess-string): Call - `org-export-handle-include-files'. + (org-export-preprocess-string): + Call `org-export-handle-include-files'. * org.el (org-delete-property-globally) (org-delete-property, org-set-property): Ignore case during @@ -12798,8 +12801,8 @@ * org.el (org-set-font-lock-defaults): Make the description tag bold. - * org-exp.el (org-export-as-html, org-close-li): Implement - description lists. + * org-exp.el (org-export-as-html, org-close-li): + Implement description lists. 2008-06-17 Jason Riedy @@ -12880,7 +12883,7 @@ ;; add-log-time-zone-rule: t ;; End: - Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. + Copyright (C) 2008, 2009, 2010, 2011 Free Software Foundation, Inc. This file is part of GNU Emacs. === modified file 'lisp/org/org-capture.el' --- lisp/org/org-capture.el 2010-12-11 16:42:53 +0000 +++ lisp/org/org-capture.el 2011-01-13 23:14:30 +0000 @@ -1,6 +1,6 @@ ;;; org-capture.el --- Fast note taking in Org-mode -;; Copyright (C) 2010 Free Software Foundation, Inc. +;; Copyright (C) 2010, 2011 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp @@ -359,8 +359,7 @@ nil " Rem" org-capture-mode-map (org-set-local 'header-line-format - "Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'.") - (run-hooks 'org-capture-mode-hook)) + "Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'.")) (define-key org-capture-mode-map "\C-c\C-c" 'org-capture-finalize) (define-key org-capture-mode-map "\C-c\C-k" 'org-capture-kill) (define-key org-capture-mode-map "\C-c\C-w" 'org-capture-refile) === modified file 'lisp/org/org-remember.el' --- lisp/org/org-remember.el 2010-12-11 16:42:53 +0000 +++ lisp/org/org-remember.el 2011-01-13 23:14:30 +0000 @@ -1,6 +1,6 @@ ;;; org-remember.el --- Fast note taking in Org-mode -;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 ;; Free Software Foundation, Inc. ;; Author: Carsten Dominik @@ -224,8 +224,7 @@ (define-minor-mode org-remember-mode "Minor mode for special key bindings in a remember buffer." - nil " Rem" org-remember-mode-map - (run-hooks 'org-remember-mode-hook)) + nil " Rem" org-remember-mode-map) (define-key org-remember-mode-map "\C-c\C-c" 'org-remember-finalize) (define-key org-remember-mode-map "\C-c\C-k" 'org-remember-kill) === modified file 'lisp/recentf.el' --- lisp/recentf.el 2010-01-13 08:35:10 +0000 +++ lisp/recentf.el 2011-01-13 23:14:30 +0000 @@ -1,7 +1,7 @@ ;;; recentf.el --- setup a menu of recently opened files ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. ;; Author: David Ponce ;; Created: July 19 1999 @@ -1355,11 +1355,7 @@ (recentf-auto-cleanup) (let ((hook-setup (if recentf-mode 'add-hook 'remove-hook))) (dolist (hook recentf-used-hooks) - (apply hook-setup hook))) - (run-hooks 'recentf-mode-hook) - (when (called-interactively-p 'interactive) - (message "Recentf mode %sabled" (if recentf-mode "en" "dis")))) - recentf-mode) + (apply hook-setup hook))))) (defun recentf-unload-function () "Unload the recentf library." === modified file 'lisp/speedbar.el' --- lisp/speedbar.el 2010-11-18 03:54:14 +0000 +++ lisp/speedbar.el 2011-01-13 23:14:30 +0000 @@ -1,7 +1,7 @@ ;;; speedbar --- quick access to files and tags in a frame ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 +;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 ;; Free Software Foundation, Inc. ;; Author: Eric M. Ludlam @@ -515,7 +515,7 @@ :type 'hook) (defcustom speedbar-mode-hook nil - "Hooks called after creating a speedbar buffer." + "Hook run after creating a speedbar buffer." :group 'speedbar :type 'hook) @@ -769,99 +769,95 @@ (defvar speedbar-update-flag-disable nil "Permanently disable changing of the update flag.") -(defvar speedbar-syntax-table nil +(defvar speedbar-mode-syntax-table + (let ((st (make-syntax-table))) + ;; Turn off paren matching around here. + (modify-syntax-entry ?\' " " st) + (modify-syntax-entry ?\" " " st) + (modify-syntax-entry ?\( " " st) + (modify-syntax-entry ?\) " " st) + (modify-syntax-entry ?\{ " " st) + (modify-syntax-entry ?\} " " st) + (modify-syntax-entry ?\[ " " st) + (modify-syntax-entry ?\] " " st) + st) "Syntax-table used on the speedbar.") - -(if speedbar-syntax-table - nil - (setq speedbar-syntax-table (make-syntax-table)) - ;; turn off paren matching around here. - (modify-syntax-entry ?\' " " speedbar-syntax-table) - (modify-syntax-entry ?\" " " speedbar-syntax-table) - (modify-syntax-entry ?( " " speedbar-syntax-table) - (modify-syntax-entry ?) " " speedbar-syntax-table) - (modify-syntax-entry ?{ " " speedbar-syntax-table) - (modify-syntax-entry ?} " " speedbar-syntax-table) - (modify-syntax-entry ?[ " " speedbar-syntax-table) - (modify-syntax-entry ?] " " speedbar-syntax-table)) - -(defvar speedbar-key-map nil +(define-obsolete-variable-alias + 'speedbar-syntax-table 'speedbar-mode-syntax-table "24.1") + + +(defvar speedbar-mode-map + (let ((map (make-keymap))) + (suppress-keymap map t) + + ;; Control. + (define-key map "t" 'speedbar-toggle-updates) + (define-key map "g" 'speedbar-refresh) + + ;; Navigation. + (define-key map "n" 'speedbar-next) + (define-key map "p" 'speedbar-prev) + (define-key map "\M-n" 'speedbar-restricted-next) + (define-key map "\M-p" 'speedbar-restricted-prev) + (define-key map "\C-\M-n" 'speedbar-forward-list) + (define-key map "\C-\M-p" 'speedbar-backward-list) + ;; These commands never seemed useful. + ;; (define-key map " " 'speedbar-scroll-up) + ;; (define-key map [delete] 'speedbar-scroll-down) + + ;; Short cuts I happen to find useful. + (define-key map "r" + (lambda () (interactive) + (speedbar-change-initial-expansion-list + speedbar-previously-used-expansion-list-name))) + (define-key map "b" + (lambda () (interactive) + (speedbar-change-initial-expansion-list "quick buffers"))) + (define-key map "f" + (lambda () (interactive) + (speedbar-change-initial-expansion-list "files"))) + + (dframe-update-keymap map) + map) "Keymap used in speedbar buffer.") - -(if speedbar-key-map - nil - (setq speedbar-key-map (make-keymap)) - (suppress-keymap speedbar-key-map t) - - ;; control - (define-key speedbar-key-map "t" 'speedbar-toggle-updates) - (define-key speedbar-key-map "g" 'speedbar-refresh) - - ;; navigation - (define-key speedbar-key-map "n" 'speedbar-next) - (define-key speedbar-key-map "p" 'speedbar-prev) - (define-key speedbar-key-map "\M-n" 'speedbar-restricted-next) - (define-key speedbar-key-map "\M-p" 'speedbar-restricted-prev) - (define-key speedbar-key-map "\C-\M-n" 'speedbar-forward-list) - (define-key speedbar-key-map "\C-\M-p" 'speedbar-backward-list) -;; These commands never seemed useful. -;; (define-key speedbar-key-map " " 'speedbar-scroll-up) -;; (define-key speedbar-key-map [delete] 'speedbar-scroll-down) - - ;; Short cuts I happen to find useful - (define-key speedbar-key-map "r" - (lambda () (interactive) - (speedbar-change-initial-expansion-list - speedbar-previously-used-expansion-list-name))) - (define-key speedbar-key-map "b" - (lambda () (interactive) - (speedbar-change-initial-expansion-list "quick buffers"))) - (define-key speedbar-key-map "f" - (lambda () (interactive) - (speedbar-change-initial-expansion-list "files"))) - - (dframe-update-keymap speedbar-key-map) -) +(define-obsolete-variable-alias 'speedbar-key-map 'speedbar-mode-map "24.1") (defun speedbar-make-specialized-keymap () "Create a keymap for use with a speedbar major or minor display mode. This basically creates a sparse keymap, and makes its parent be -`speedbar-key-map'." +`speedbar-mode-map'." (let ((k (make-sparse-keymap))) - (set-keymap-parent k speedbar-key-map) + (set-keymap-parent k speedbar-mode-map) k)) -(defvar speedbar-file-key-map nil +(defvar speedbar-file-key-map + (let ((map (speedbar-make-specialized-keymap))) + + ;; Basic tree features. + (define-key map "e" 'speedbar-edit-line) + (define-key map "\C-m" 'speedbar-edit-line) + (define-key map "+" 'speedbar-expand-line) + (define-key map "=" 'speedbar-expand-line) + (define-key map "-" 'speedbar-contract-line) + + (define-key map "[" 'speedbar-expand-line-descendants) + (define-key map "]" 'speedbar-contract-line-descendants) + + (define-key map " " 'speedbar-toggle-line-expansion) + + ;; File based commands. + (define-key map "U" 'speedbar-up-directory) + (define-key map "I" 'speedbar-item-info) + (define-key map "B" 'speedbar-item-byte-compile) + (define-key map "L" 'speedbar-item-load) + (define-key map "C" 'speedbar-item-copy) + (define-key map "D" 'speedbar-item-delete) + (define-key map "O" 'speedbar-item-object-delete) + (define-key map "R" 'speedbar-item-rename) + (define-key map "M" 'speedbar-create-directory) + map) "Keymap used in speedbar buffer while files are displayed.") -(if speedbar-file-key-map - nil - (setq speedbar-file-key-map (speedbar-make-specialized-keymap)) - - ;; Basic tree features - (define-key speedbar-file-key-map "e" 'speedbar-edit-line) - (define-key speedbar-file-key-map "\C-m" 'speedbar-edit-line) - (define-key speedbar-file-key-map "+" 'speedbar-expand-line) - (define-key speedbar-file-key-map "=" 'speedbar-expand-line) - (define-key speedbar-file-key-map "-" 'speedbar-contract-line) - - (define-key speedbar-file-key-map "[" 'speedbar-expand-line-descendants) - (define-key speedbar-file-key-map "]" 'speedbar-contract-line-descendants) - - (define-key speedbar-file-key-map " " 'speedbar-toggle-line-expansion) - - ;; file based commands - (define-key speedbar-file-key-map "U" 'speedbar-up-directory) - (define-key speedbar-file-key-map "I" 'speedbar-item-info) - (define-key speedbar-file-key-map "B" 'speedbar-item-byte-compile) - (define-key speedbar-file-key-map "L" 'speedbar-item-load) - (define-key speedbar-file-key-map "C" 'speedbar-item-copy) - (define-key speedbar-file-key-map "D" 'speedbar-item-delete) - (define-key speedbar-file-key-map "O" 'speedbar-item-object-delete) - (define-key speedbar-file-key-map "R" 'speedbar-item-rename) - (define-key speedbar-file-key-map "M" 'speedbar-create-directory) - ) - (defvar speedbar-easymenu-definition-base (append '("Speedbar" @@ -1080,7 +1076,7 @@ Return nil if it doesn't exist." (frame-width speedbar-frame)) -(defun speedbar-mode () +(define-derived-mode speedbar-mode fundamental-mode "Speedbar" "Major mode for managing a display of directories and tags. \\ The first line represents the default directory of the speedbar frame. @@ -1120,12 +1116,7 @@ in the selected file. \\{speedbar-key-map}" - ;; NOT interactive (save-excursion - (kill-all-local-variables) - (setq major-mode 'speedbar-mode) - (setq mode-name "Speedbar") - (set-syntax-table speedbar-syntax-table) (setq font-lock-keywords nil) ;; no font-locking please (setq truncate-lines t) (make-local-variable 'frame-title-format) @@ -1138,8 +1129,7 @@ (setq dframe-track-mouse-function #'speedbar-track-mouse)) (setq dframe-help-echo-function #'speedbar-item-info dframe-mouse-click-function #'speedbar-click - dframe-mouse-position-function #'speedbar-position-cursor-on-line) - (run-hooks 'speedbar-mode-hook)) + dframe-mouse-position-function #'speedbar-position-cursor-on-line)) speedbar-buffer) (defmacro speedbar-message (fmt &rest args) === modified file 'lisp/textmodes/reftex-index.el' --- lisp/textmodes/reftex-index.el 2010-11-03 03:49:04 +0000 +++ lisp/textmodes/reftex-index.el 2011-01-13 23:14:30 +0000 @@ -1,7 +1,7 @@ ;;; reftex-index.el --- index support with RefTeX ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Maintainer: auctex-devel@gnu.org @@ -275,8 +275,111 @@ (and newtag (cdr cell) (not (member newtag (cdr cell))) (push newtag (cdr cell))))) -(defvar reftex-index-map (make-sparse-keymap) +(defvar reftex-index-mode-map + (let ((map (make-sparse-keymap))) + ;; Index map + (define-key map (if (featurep 'xemacs) [(button2)] [(mouse-2)]) + 'reftex-index-mouse-goto-line-and-hide) + (define-key map [follow-link] 'mouse-face) + + (substitute-key-definition + 'next-line 'reftex-index-next map global-map) + (substitute-key-definition + 'previous-line 'reftex-index-previous map global-map) + + (loop for x in + '(("n" . reftex-index-next) + ("p" . reftex-index-previous) + ("?" . reftex-index-show-help) + (" " . reftex-index-view-entry) + ("\C-m" . reftex-index-goto-entry-and-hide) + ("\C-i" . reftex-index-goto-entry) + ("\C-k" . reftex-index-kill) + ("r" . reftex-index-rescan) + ("R" . reftex-index-Rescan) + ("g" . revert-buffer) + ("q" . reftex-index-quit) + ("k" . reftex-index-quit-and-kill) + ("f" . reftex-index-toggle-follow) + ("s" . reftex-index-switch-index-tag) + ("e" . reftex-index-edit) + ("^" . reftex-index-level-up) + ("_" . reftex-index-level-down) + ("}" . reftex-index-restrict-to-section) + ("{" . reftex-index-widen) + (">" . reftex-index-restriction-forward) + ("<" . reftex-index-restriction-backward) + ("(" . reftex-index-toggle-range-beginning) + (")" . reftex-index-toggle-range-end) + ("|" . reftex-index-edit-attribute) + ("@" . reftex-index-edit-visual) + ("*" . reftex-index-edit-key) + ("\C-c=". reftex-index-goto-toc) + ("c" . reftex-index-toggle-context)) + do (define-key map (car x) (cdr x))) + + (loop for key across "0123456789" do + (define-key map (vector (list key)) 'digit-argument)) + (define-key map "-" 'negative-argument) + + ;; The capital letters and the exclamation mark + (loop for key across (concat "!" reftex-index-section-letters) do + (define-key map (vector (list key)) + (list 'lambda '() '(interactive) + (list 'reftex-index-goto-letter key)))) + + (easy-menu-define reftex-index-menu map + "Menu for Index buffer" + '("Index" + ["Goto section A-Z" + (message "To go to a section, just press any of: !%s" + reftex-index-section-letters) t] + ["Show Entry" reftex-index-view-entry t] + ["Go To Entry" reftex-index-goto-entry t] + ["Exit & Go To Entry" reftex-index-goto-entry-and-hide t] + ["Table of Contents" reftex-index-goto-toc t] + ["Quit" reftex-index-quit t] + "--" + ("Update" + ["Rebuilt *Index* Buffer" revert-buffer t] + "--" + ["Rescan One File" reftex-index-rescan reftex-enable-partial-scans] + ["Rescan Entire Document" reftex-index-Rescan t]) + ("Restrict" + ["Restrict to section" reftex-index-restrict-to-section t] + ["Widen" reftex-index-widen reftex-index-restriction-indicator] + ["Next Section" reftex-index-restriction-forward + reftex-index-restriction-indicator] + ["Previous Section" reftex-index-restriction-backward + reftex-index-restriction-indicator]) + ("Edit" + ["Edit Entry" reftex-index-edit t] + ["Edit Key" reftex-index-edit-key t] + ["Edit Attribute" reftex-index-edit-attribute t] + ["Edit Visual" reftex-index-edit-visual t] + "--" + ["Add Parentkey" reftex-index-level-down t] + ["Remove Parentkey " reftex-index-level-up t] + "--" + ["Make Start-of-Range" reftex-index-toggle-range-beginning t] + ["Make End-of-Range" reftex-index-toggle-range-end t] + "--" + ["Kill Entry" reftex-index-kill nil] + "--" + ["Undo" reftex-index-undo nil]) + ("Options" + ["Context" reftex-index-toggle-context :style toggle + :selected reftex-index-include-context] + "--" + ["Follow Mode" reftex-index-toggle-follow :style toggle + :selected reftex-index-follow-mode]) + "--" + ["Help" reftex-index-show-help t])) + + map) "Keymap used for *Index* buffers.") +(define-obsolete-variable-alias + 'reftex-index-map 'reftex-index-mode-map "24.1") (defvar reftex-index-menu) @@ -291,19 +394,14 @@ (defvar reftex-index-restriction-indicator nil) (defvar reftex-index-restriction-data nil) -(defun reftex-index-mode () +(define-derived-mode reftex-index-mode fundamental-mode "RefTeX Index" "Major mode for managing Index buffers for LaTeX files. This buffer was created with RefTeX. Press `?' for a summary of important key bindings, or check the menu. Here are all local bindings. -\\{reftex-index-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'reftex-index-mode - mode-name "RefTeX Index") - (use-local-map reftex-index-map) +\\{reftex-index-mode-map}" (set (make-local-variable 'revert-buffer-function) 'reftex-index-revert) (set (make-local-variable 'reftex-index-restriction-data) nil) (set (make-local-variable 'reftex-index-restriction-indicator) nil) @@ -318,10 +416,9 @@ (make-local-hook 'post-command-hook) (make-local-hook 'pre-command-hook)) (make-local-variable 'reftex-last-follow-point) - (easy-menu-add reftex-index-menu reftex-index-map) + (easy-menu-add reftex-index-menu reftex-index-mode-map) (add-hook 'post-command-hook 'reftex-index-post-command-hook nil t) - (add-hook 'pre-command-hook 'reftex-index-pre-command-hook nil t) - (run-hooks 'reftex-index-mode-hook)) + (add-hook 'pre-command-hook 'reftex-index-pre-command-hook nil t)) (defconst reftex-index-help " AVAILABLE KEYS IN INDEX BUFFER @@ -1032,57 +1129,6 @@ (setq reftex-last-follow-point 1) (and message (message "%s" message)))) -;; Index map -(define-key reftex-index-map (if (featurep 'xemacs) [(button2)] [(mouse-2)]) - 'reftex-index-mouse-goto-line-and-hide) -(define-key reftex-index-map [follow-link] 'mouse-face) - -(substitute-key-definition - 'next-line 'reftex-index-next reftex-index-map global-map) -(substitute-key-definition - 'previous-line 'reftex-index-previous reftex-index-map global-map) - -(loop for x in - '(("n" . reftex-index-next) - ("p" . reftex-index-previous) - ("?" . reftex-index-show-help) - (" " . reftex-index-view-entry) - ("\C-m" . reftex-index-goto-entry-and-hide) - ("\C-i" . reftex-index-goto-entry) - ("\C-k" . reftex-index-kill) - ("r" . reftex-index-rescan) - ("R" . reftex-index-Rescan) - ("g" . revert-buffer) - ("q" . reftex-index-quit) - ("k" . reftex-index-quit-and-kill) - ("f" . reftex-index-toggle-follow) - ("s" . reftex-index-switch-index-tag) - ("e" . reftex-index-edit) - ("^" . reftex-index-level-up) - ("_" . reftex-index-level-down) - ("}" . reftex-index-restrict-to-section) - ("{" . reftex-index-widen) - (">" . reftex-index-restriction-forward) - ("<" . reftex-index-restriction-backward) - ("(" . reftex-index-toggle-range-beginning) - (")" . reftex-index-toggle-range-end) - ("|" . reftex-index-edit-attribute) - ("@" . reftex-index-edit-visual) - ("*" . reftex-index-edit-key) - ("\C-c=". reftex-index-goto-toc) - ("c" . reftex-index-toggle-context)) - do (define-key reftex-index-map (car x) (cdr x))) - -(loop for key across "0123456789" do - (define-key reftex-index-map (vector (list key)) 'digit-argument)) -(define-key reftex-index-map "-" 'negative-argument) - -;; The capital letters and the exclamation mark -(loop for key across (concat "!" reftex-index-section-letters) do - (define-key reftex-index-map (vector (list key)) - (list 'lambda '() '(interactive) - (list 'reftex-index-goto-letter key)))) - (defun reftex-index-goto-letter (char) "Go to the CHAR section in the index." (let ((pos (point)) @@ -1101,55 +1147,6 @@ (error "This <%s> index does not contain entries starting with `%c'" reftex-index-tag char))))) -(easy-menu-define - reftex-index-menu reftex-index-map - "Menu for Index buffer" - `("Index" - ["Goto section A-Z" - (message "To go to a section, just press any of: !%s" - reftex-index-section-letters) t] - ["Show Entry" reftex-index-view-entry t] - ["Go To Entry" reftex-index-goto-entry t] - ["Exit & Go To Entry" reftex-index-goto-entry-and-hide t] - ["Table of Contents" reftex-index-goto-toc t] - ["Quit" reftex-index-quit t] - "--" - ("Update" - ["Rebuilt *Index* Buffer" revert-buffer t] - "--" - ["Rescan One File" reftex-index-rescan reftex-enable-partial-scans] - ["Rescan Entire Document" reftex-index-Rescan t]) - ("Restrict" - ["Restrict to section" reftex-index-restrict-to-section t] - ["Widen" reftex-index-widen reftex-index-restriction-indicator] - ["Next Section" reftex-index-restriction-forward - reftex-index-restriction-indicator] - ["Previous Section" reftex-index-restriction-backward - reftex-index-restriction-indicator]) - ("Edit" - ["Edit Entry" reftex-index-edit t] - ["Edit Key" reftex-index-edit-key t] - ["Edit Attribute" reftex-index-edit-attribute t] - ["Edit Visual" reftex-index-edit-visual t] - "--" - ["Add Parentkey" reftex-index-level-down t] - ["Remove Parentkey " reftex-index-level-up t] - "--" - ["Make Start-of-Range" reftex-index-toggle-range-beginning t] - ["Make End-of-Range" reftex-index-toggle-range-end t] - "--" - ["Kill Entry" reftex-index-kill nil] - "--" - ["Undo" reftex-index-undo nil]) - ("Options" - ["Context" reftex-index-toggle-context :style toggle - :selected reftex-index-include-context] - "--" - ["Follow Mode" reftex-index-toggle-follow :style toggle - :selected reftex-index-follow-mode]) - "--" - ["Help" reftex-index-show-help t])) - ;;---------------------------------------------------------------------- ;; The Index Phrases File @@ -1183,8 +1180,73 @@ "Font lock keywords for reftex-index-phrases-mode.") (defvar reftex-index-phrases-font-lock-defaults nil "Font lock defaults for reftex-index-phrases-mode.") -(defvar reftex-index-phrases-map (make-sparse-keymap) +(defvar reftex-index-phrases-mode-map + (let ((map (make-sparse-keymap))) + ;; Keybindings and Menu for phrases buffer + (loop for x in + '(("\C-c\C-c" . reftex-index-phrases-save-and-return) + ("\C-c\C-x" . reftex-index-this-phrase) + ("\C-c\C-f" . reftex-index-next-phrase) + ("\C-c\C-r" . reftex-index-region-phrases) + ("\C-c\C-a" . reftex-index-all-phrases) + ("\C-c\C-d" . reftex-index-remaining-phrases) + ("\C-c\C-s" . reftex-index-sort-phrases) + ("\C-c\C-n" . reftex-index-new-phrase) + ("\C-c\C-m" . reftex-index-phrases-set-macro-key) + ("\C-c\C-i" . reftex-index-phrases-info) + ("\C-c\C-t" . reftex-index-find-next-conflict-phrase) + ("\C-i" . self-insert-command)) + do (define-key map (car x) (cdr x))) + + (easy-menu-define reftex-index-phrases-menu map + "Menu for Phrases buffer" + '("Phrases" + ["New Phrase" reftex-index-new-phrase t] + ["Set Phrase Macro" reftex-index-phrases-set-macro-key t] + ["Recreate File Header" reftex-index-initialize-phrases-buffer t] + "--" + ("Sort Phrases" + ["Sort" reftex-index-sort-phrases t] + "--" + "Sort Options" + ["by Search Phrase" (setq reftex-index-phrases-sort-prefers-entry nil) + :style radio :selected (not reftex-index-phrases-sort-prefers-entry)] + ["by Index Entry" (setq reftex-index-phrases-sort-prefers-entry t) + :style radio :selected reftex-index-phrases-sort-prefers-entry] + ["in Blocks" (setq reftex-index-phrases-sort-in-blocks + (not reftex-index-phrases-sort-in-blocks)) + :style toggle :selected reftex-index-phrases-sort-in-blocks]) + ["Describe Phrase" reftex-index-phrases-info t] + ["Next Phrase Conflict" reftex-index-find-next-conflict-phrase t] + "--" + ("Find and Index in Document" + ["Current Phrase" reftex-index-this-phrase t] + ["Next Phrase" reftex-index-next-phrase t] + ["Current and Following" reftex-index-remaining-phrases t] + ["Region Phrases" reftex-index-region-phrases t] + ["All Phrases" reftex-index-all-phrases t] + "--" + "Options" + ["Match Whole Words" (setq reftex-index-phrases-search-whole-words + (not reftex-index-phrases-search-whole-words)) + :style toggle :selected reftex-index-phrases-search-whole-words] + ["Case Sensitive Search" (setq reftex-index-phrases-case-fold-search + (not reftex-index-phrases-case-fold-search)) + :style toggle :selected (not + reftex-index-phrases-case-fold-search)] + ["Wrap Long Lines" (setq reftex-index-phrases-wrap-long-lines + (not reftex-index-phrases-wrap-long-lines)) + :style toggle :selected reftex-index-phrases-wrap-long-lines] + ["Skip Indexed Matches" (setq reftex-index-phrases-skip-indexed-matches + (not reftex-index-phrases-skip-indexed-matches)) + :style toggle :selected reftex-index-phrases-skip-indexed-matches]) + "--" + ["Save and Return" reftex-index-phrases-save-and-return t])) + + map) "Keymap used for *toc* buffer.") +(define-obsolete-variable-alias + 'reftex-index-phrases-map 'reftex-index-phrases-mode-map "24.1") (defun reftex-index-phrase-selection-or-word (arg) @@ -1288,7 +1350,7 @@ (defvar reftex-index-phrases-marker) (defvar reftex-index-phrases-restrict-file nil) ;;;###autoload -(defun reftex-index-phrases-mode () +(define-derived-mode reftex-index-phrases-mode fundamental-mode "Phrases" "Major mode for managing the Index phrases of a LaTeX document. This buffer was created with RefTeX. @@ -1311,18 +1373,12 @@ Here are all local bindings. -\\{reftex-index-phrases-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'reftex-index-phrases-mode - mode-name "Phrases") - (use-local-map reftex-index-phrases-map) +\\{reftex-index-phrases-mode-map}" (set (make-local-variable 'font-lock-defaults) reftex-index-phrases-font-lock-defaults) - (easy-menu-add reftex-index-phrases-menu reftex-index-phrases-map) - (set (make-local-variable 'reftex-index-phrases-marker) (make-marker)) - (run-hooks 'reftex-index-phrases-mode-hook)) -(add-hook 'reftex-index-phrases-mode-hook 'turn-on-font-lock) + (easy-menu-add reftex-index-phrases-menu reftex-index-phrases-mode-map) + (set (make-local-variable 'reftex-index-phrases-marker) (make-marker))) +;; (add-hook 'reftex-index-phrases-mode-hook 'turn-on-font-lock) ;; Font Locking stuff (let ((ss (if (featurep 'xemacs) 'secondary-selection ''secondary-selection))) @@ -2040,68 +2096,5 @@ reftex-index-phrases-macro-data "\n")))) (reftex-select-with-char prompt help delay))) -;; Keybindings and Menu for phrases buffer - -(loop for x in - '(("\C-c\C-c" . reftex-index-phrases-save-and-return) - ("\C-c\C-x" . reftex-index-this-phrase) - ("\C-c\C-f" . reftex-index-next-phrase) - ("\C-c\C-r" . reftex-index-region-phrases) - ("\C-c\C-a" . reftex-index-all-phrases) - ("\C-c\C-d" . reftex-index-remaining-phrases) - ("\C-c\C-s" . reftex-index-sort-phrases) - ("\C-c\C-n" . reftex-index-new-phrase) - ("\C-c\C-m" . reftex-index-phrases-set-macro-key) - ("\C-c\C-i" . reftex-index-phrases-info) - ("\C-c\C-t" . reftex-index-find-next-conflict-phrase) - ("\C-i" . self-insert-command)) - do (define-key reftex-index-phrases-map (car x) (cdr x))) - -(easy-menu-define - reftex-index-phrases-menu reftex-index-phrases-map - "Menu for Phrases buffer" - '("Phrases" - ["New Phrase" reftex-index-new-phrase t] - ["Set Phrase Macro" reftex-index-phrases-set-macro-key t] - ["Recreate File Header" reftex-index-initialize-phrases-buffer t] - "--" - ("Sort Phrases" - ["Sort" reftex-index-sort-phrases t] - "--" - "Sort Options" - ["by Search Phrase" (setq reftex-index-phrases-sort-prefers-entry nil) - :style radio :selected (not reftex-index-phrases-sort-prefers-entry)] - ["by Index Entry" (setq reftex-index-phrases-sort-prefers-entry t) - :style radio :selected reftex-index-phrases-sort-prefers-entry] - ["in Blocks" (setq reftex-index-phrases-sort-in-blocks - (not reftex-index-phrases-sort-in-blocks)) - :style toggle :selected reftex-index-phrases-sort-in-blocks]) - ["Describe Phrase" reftex-index-phrases-info t] - ["Next Phrase Conflict" reftex-index-find-next-conflict-phrase t] - "--" - ("Find and Index in Document" - ["Current Phrase" reftex-index-this-phrase t] - ["Next Phrase" reftex-index-next-phrase t] - ["Current and Following" reftex-index-remaining-phrases t] - ["Region Phrases" reftex-index-region-phrases t] - ["All Phrases" reftex-index-all-phrases t] - "--" - "Options" - ["Match Whole Words" (setq reftex-index-phrases-search-whole-words - (not reftex-index-phrases-search-whole-words)) - :style toggle :selected reftex-index-phrases-search-whole-words] - ["Case Sensitive Search" (setq reftex-index-phrases-case-fold-search - (not reftex-index-phrases-case-fold-search)) - :style toggle :selected (not - reftex-index-phrases-case-fold-search)] - ["Wrap Long Lines" (setq reftex-index-phrases-wrap-long-lines - (not reftex-index-phrases-wrap-long-lines)) - :style toggle :selected reftex-index-phrases-wrap-long-lines] - ["Skip Indexed Matches" (setq reftex-index-phrases-skip-indexed-matches - (not reftex-index-phrases-skip-indexed-matches)) - :style toggle :selected reftex-index-phrases-skip-indexed-matches]) - "--" - ["Save and Return" reftex-index-phrases-save-and-return t])) - ;;; reftex-index.el ends here === modified file 'lisp/textmodes/reftex-sel.el' --- lisp/textmodes/reftex-sel.el 2010-11-06 19:11:38 +0000 +++ lisp/textmodes/reftex-sel.el 2011-01-13 23:14:30 +0000 @@ -1,7 +1,7 @@ ;;; reftex-sel.el --- the selection modes for RefTeX ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Maintainer: auctex-devel@gnu.org @@ -32,12 +32,81 @@ (require 'reftex) ;;; -(defvar reftex-select-label-map nil +;; Common bindings in reftex-select-label-mode-map +;; and reftex-select-bib-mode-map. +(defvar reftex-select-shared-map + (let ((map (make-sparse-keymap))) + (substitute-key-definition + 'next-line 'reftex-select-next map global-map) + (substitute-key-definition + 'previous-line 'reftex-select-previous map global-map) + (substitute-key-definition + 'keyboard-quit 'reftex-select-keyboard-quit map global-map) + (substitute-key-definition + 'newline 'reftex-select-accept map global-map) + + (loop for x in + '((" " . reftex-select-callback) + ("n" . reftex-select-next) + ([(down)] . reftex-select-next) + ("p" . reftex-select-previous) + ([(up)] . reftex-select-previous) + ("f" . reftex-select-toggle-follow) + ("\C-m" . reftex-select-accept) + ([(return)] . reftex-select-accept) + ("q" . reftex-select-quit) + ("." . reftex-select-show-insertion-point) + ("?" . reftex-select-help)) + do (define-key map (car x) (cdr x))) + + ;; The mouse-2 binding + (if (featurep 'xemacs) + (define-key map [(button2)] 'reftex-select-mouse-accept) + (define-key map [(mouse-2)] 'reftex-select-mouse-accept) + (define-key map [follow-link] 'mouse-face)) + + + ;; Digit arguments + (loop for key across "0123456789" do + (define-key map (vector (list key)) 'digit-argument)) + (define-key map "-" 'negative-argument) + map)) + +(defvar reftex-select-label-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map reftex-select-shared-map) + + (loop for key across "aAcgFlrRstx#%" do + (define-key map (vector (list key)) + (list 'lambda '() + "Press `?' during selection to find out about this key." + '(interactive) (list 'throw '(quote myexit) key)))) + + (loop for x in + '(("b" . reftex-select-jump-to-previous) + ("z" . reftex-select-jump) + ("v" . reftex-select-toggle-varioref) + ("V" . reftex-select-toggle-fancyref) + ("m" . reftex-select-mark) + ("u" . reftex-select-unmark) + ("," . reftex-select-mark-comma) + ("-" . reftex-select-mark-to) + ("+" . reftex-select-mark-and) + ([(tab)] . reftex-select-read-label) + ("\C-i" . reftex-select-read-label) + ("\C-c\C-n" . reftex-select-next-heading) + ("\C-c\C-p" . reftex-select-previous-heading)) + do + (define-key map (car x) (cdr x))) + + map) "Keymap used for *RefTeX Select* buffer, when selecting a label. This keymap can be used to configure the label selection process which is started with the command \\[reftex-reference].") +(define-obsolete-variable-alias + 'reftex-select-label-map 'reftex-select-label-mode-map "24.1") -(defun reftex-select-label-mode () +(define-derived-mode reftex-select-label-mode fundamental-mode "LSelect" "Major mode for selecting a label in a LaTeX document. This buffer was created with RefTeX. It only has a meaningful keymap when you are in the middle of a @@ -47,28 +116,42 @@ During a selection process, these are the local bindings. -\\{reftex-select-label-map}" - - (interactive) - (kill-all-local-variables) +\\{reftex-select-label-mode-map}" (when (featurep 'xemacs) ;; XEmacs needs the call to make-local-hook (make-local-hook 'pre-command-hook) (make-local-hook 'post-command-hook)) - (setq major-mode 'reftex-select-label-mode - mode-name "LSelect") (set (make-local-variable 'reftex-select-marked) nil) (when (syntax-table-p reftex-latex-syntax-table) (set-syntax-table reftex-latex-syntax-table)) ;; We do not set a local map - reftex-select-item does this. - (run-hooks 'reftex-select-label-mode-hook)) - -(defvar reftex-select-bib-map nil + ) + +(defvar reftex-select-bib-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map reftex-select-shared-map) + + (loop for key across "grRaAeE" do + (define-key map (vector (list key)) + (list 'lambda '() + "Press `?' during selection to find out about this key." + '(interactive) (list 'throw '(quote myexit) key)))) + + (loop for x in + '(("\C-i" . reftex-select-read-cite) + ([(tab)] . reftex-select-read-cite) + ("m" . reftex-select-mark) + ("u" . reftex-select-unmark)) + do (define-key map (car x) (cdr x))) + + map) "Keymap used for *RefTeX Select* buffer, when selecting a BibTeX entry. This keymap can be used to configure the BibTeX selection process which is started with the command \\[reftex-citation].") +(define-obsolete-variable-alias + 'reftex-select-bib-map 'reftex-select-bib-mode-map "24.1") -(defun reftex-select-bib-mode () +(define-derived-mode reftex-select-bib-mode fundamental-mode "BSelect" "Major mode for selecting a citation key in a LaTeX document. This buffer was created with RefTeX. It only has a meaningful keymap when you are in the middle of a @@ -78,18 +161,14 @@ During a selection process, these are the local bindings. -\\{reftex-select-label-map}" - (interactive) - (kill-all-local-variables) +\\{reftex-select-label-mode-map}" (when (featurep 'xemacs) ;; XEmacs needs the call to make-local-hook (make-local-hook 'pre-command-hook) (make-local-hook 'post-command-hook)) - (setq major-mode 'reftex-select-bib-mode - mode-name "BSelect") (set (make-local-variable 'reftex-select-marked) nil) ;; We do not set a local map - reftex-select-item does this. - (run-hooks 'reftex-select-bib-mode-hook)) + ) ;; (defun reftex-get-offset (buf here-am-I &optional typekey toc index file) ;; ;; Find the correct offset data, like insert-docstruct would, but faster. @@ -657,84 +736,4 @@ (princ help-string)) (reftex-enlarge-to-fit "*RefTeX Help*" t)) -;; Common bindings in reftex-select-label-map and reftex-select-bib-map -(let ((map (make-sparse-keymap))) - (substitute-key-definition - 'next-line 'reftex-select-next map global-map) - (substitute-key-definition - 'previous-line 'reftex-select-previous map global-map) - (substitute-key-definition - 'keyboard-quit 'reftex-select-keyboard-quit map global-map) - (substitute-key-definition - 'newline 'reftex-select-accept map global-map) - - (loop for x in - '((" " . reftex-select-callback) - ("n" . reftex-select-next) - ([(down)] . reftex-select-next) - ("p" . reftex-select-previous) - ([(up)] . reftex-select-previous) - ("f" . reftex-select-toggle-follow) - ("\C-m" . reftex-select-accept) - ([(return)] . reftex-select-accept) - ("q" . reftex-select-quit) - ("." . reftex-select-show-insertion-point) - ("?" . reftex-select-help)) - do (define-key map (car x) (cdr x))) - - ;; The mouse-2 binding - (if (featurep 'xemacs) - (define-key map [(button2)] 'reftex-select-mouse-accept) - (define-key map [(mouse-2)] 'reftex-select-mouse-accept) - (define-key map [follow-link] 'mouse-face)) - - - ;; Digit arguments - (loop for key across "0123456789" do - (define-key map (vector (list key)) 'digit-argument)) - (define-key map "-" 'negative-argument) - - ;; Make two maps - (setq reftex-select-label-map map) - (setq reftex-select-bib-map (copy-keymap map))) - -;; Specific bindings in reftex-select-label-map -(loop for key across "aAcgFlrRstx#%" do - (define-key reftex-select-label-map (vector (list key)) - (list 'lambda '() - "Press `?' during selection to find out about this key." - '(interactive) (list 'throw '(quote myexit) key)))) - -(loop for x in - '(("b" . reftex-select-jump-to-previous) - ("z" . reftex-select-jump) - ("v" . reftex-select-toggle-varioref) - ("V" . reftex-select-toggle-fancyref) - ("m" . reftex-select-mark) - ("u" . reftex-select-unmark) - ("," . reftex-select-mark-comma) - ("-" . reftex-select-mark-to) - ("+" . reftex-select-mark-and) - ([(tab)] . reftex-select-read-label) - ("\C-i" . reftex-select-read-label) - ("\C-c\C-n" . reftex-select-next-heading) - ("\C-c\C-p" . reftex-select-previous-heading)) - do - (define-key reftex-select-label-map (car x) (cdr x))) - -;; Specific bindings in reftex-select-bib-map -(loop for key across "grRaAeE" do - (define-key reftex-select-bib-map (vector (list key)) - (list 'lambda '() - "Press `?' during selection to find out about this key." - '(interactive) (list 'throw '(quote myexit) key)))) - -(loop for x in - '(("\C-i" . reftex-select-read-cite) - ([(tab)] . reftex-select-read-cite) - ("m" . reftex-select-mark) - ("u" . reftex-select-unmark)) - do (define-key reftex-select-bib-map (car x) (cdr x))) - - ;;; reftex-sel.el ends here === modified file 'lisp/textmodes/reftex-toc.el' --- lisp/textmodes/reftex-toc.el 2010-11-06 19:11:38 +0000 +++ lisp/textmodes/reftex-toc.el 2011-01-13 23:14:30 +0000 @@ -1,7 +1,7 @@ ;;; reftex-toc.el --- RefTeX's table of contents mode ;; Copyright (C) 1997, 1998, 1999, 2000, 2003, 2004, 2005, 2006, 2007, -;; 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2008, 2009, 2010, 2011 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Maintainer: auctex-devel@gnu.org @@ -32,8 +32,98 @@ (require 'reftex) ;;; -(defvar reftex-toc-map (make-sparse-keymap) +(defvar reftex-toc-mode-map + (let ((map (make-sparse-keymap))) + + (define-key map (if (featurep 'xemacs) [(button2)] [(mouse-2)]) + 'reftex-toc-mouse-goto-line-and-hide) + (define-key map [follow-link] 'mouse-face) + + (substitute-key-definition + 'next-line 'reftex-toc-next map global-map) + (substitute-key-definition + 'previous-line 'reftex-toc-previous map global-map) + + (loop for x in + '(("n" . reftex-toc-next) + ("p" . reftex-toc-previous) + ("?" . reftex-toc-show-help) + (" " . reftex-toc-view-line) + ("\C-m" . reftex-toc-goto-line-and-hide) + ("\C-i" . reftex-toc-goto-line) + ("\C-c>" . reftex-toc-display-index) + ("r" . reftex-toc-rescan) + ("R" . reftex-toc-Rescan) + ("g" . revert-buffer) + ("q" . reftex-toc-quit) ; + ("k" . reftex-toc-quit-and-kill) + ("f" . reftex-toc-toggle-follow) ; + ("a" . reftex-toggle-auto-toc-recenter) + ("d" . reftex-toc-toggle-dedicated-frame) + ("F" . reftex-toc-toggle-file-boundary) + ("i" . reftex-toc-toggle-index) + ("l" . reftex-toc-toggle-labels) + ("t" . reftex-toc-max-level) + ("c" . reftex-toc-toggle-context) + ;; ("%" . reftex-toc-toggle-commented) + ("\M-%" . reftex-toc-rename-label) + ("x" . reftex-toc-external) + ("z" . reftex-toc-jump) + ("." . reftex-toc-show-calling-point) + ("\C-c\C-n" . reftex-toc-next-heading) + ("\C-c\C-p" . reftex-toc-previous-heading) + (">" . reftex-toc-demote) + ("<" . reftex-toc-promote)) + do (define-key map (car x) (cdr x))) + + (loop for key across "0123456789" do + (define-key map (vector (list key)) 'digit-argument)) + (define-key map "-" 'negative-argument) + + (easy-menu-define + reftex-toc-menu map + "Menu for Table of Contents buffer" + '("TOC" + ["Show Location" reftex-toc-view-line t] + ["Go To Location" reftex-toc-goto-line t] + ["Exit & Go To Location" reftex-toc-goto-line-and-hide t] + ["Show Calling Point" reftex-toc-show-calling-point t] + ["Quit" reftex-toc-quit t] + "--" + ("Edit" + ["Promote" reftex-toc-promote t] + ["Demote" reftex-toc-demote t] + ["Rename Label" reftex-toc-rename-label t]) + "--" + ["Index" reftex-toc-display-index t] + ["External Document TOC " reftex-toc-external t] + "--" + ("Update" + ["Rebuilt *toc* Buffer" revert-buffer t] + ["Rescan One File" reftex-toc-rescan reftex-enable-partial-scans] + ["Rescan Entire Document" reftex-toc-Rescan t]) + ("Options" + "TOC Items" + ["File Boundaries" reftex-toc-toggle-file-boundary :style toggle + :selected reftex-toc-include-file-boundaries] + ["Labels" reftex-toc-toggle-labels :style toggle + :selected reftex-toc-include-labels] + ["Index Entries" reftex-toc-toggle-index :style toggle + :selected reftex-toc-include-index-entries] + ["Context" reftex-toc-toggle-context :style toggle + :selected reftex-toc-include-context] + "--" + ["Follow Mode" reftex-toc-toggle-follow :style toggle + :selected reftex-toc-follow-mode] + ["Auto Recenter" reftex-toggle-auto-toc-recenter :style toggle + :selected reftex-toc-auto-recenter-timer] + ["Dedicated Frame" reftex-toc-toggle-dedicated-frame t]) + "--" + ["Help" reftex-toc-show-help t])) + + map) "Keymap used for *toc* buffer.") +(define-obsolete-variable-alias 'reftex-toc-map 'reftex-toc-mode-map "24.1") (defvar reftex-toc-menu) (defvar reftex-last-window-height nil) @@ -42,19 +132,14 @@ (defvar reftex-toc-include-index-indicator nil) (defvar reftex-toc-max-level-indicator nil) -(defun reftex-toc-mode () +(define-derived-mode reftex-toc-mode fundamental-mode "TOC" "Major mode for managing Table of Contents for LaTeX files. This buffer was created with RefTeX. Press `?' for a summary of important key bindings. Here are all local bindings. -\\{reftex-toc-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'reftex-toc-mode - mode-name "TOC") - (use-local-map reftex-toc-map) +\\{reftex-toc-mode-map}" (set (make-local-variable 'transient-mark-mode) t) (when (featurep 'xemacs) (set (make-local-variable 'zmacs-regions) t)) @@ -79,8 +164,7 @@ (make-local-variable 'reftex-last-follow-point) (add-hook 'post-command-hook 'reftex-toc-post-command-hook nil t) (add-hook 'pre-command-hook 'reftex-toc-pre-command-hook nil t) - (easy-menu-add reftex-toc-menu reftex-toc-map) - (run-hooks 'reftex-toc-mode-hook)) + (easy-menu-add reftex-toc-menu reftex-toc-mode-map)) (defvar reftex-last-toc-file nil "Stores the file name from which `reftex-toc' was called. For redo command.") @@ -1006,92 +1090,4 @@ (progn (reftex-toggle-auto-toc-recenter)))) -;; Table of Contents map -(define-key reftex-toc-map (if (featurep 'xemacs) [(button2)] [(mouse-2)]) - 'reftex-toc-mouse-goto-line-and-hide) -(define-key reftex-toc-map [follow-link] 'mouse-face) - -(substitute-key-definition - 'next-line 'reftex-toc-next reftex-toc-map global-map) -(substitute-key-definition - 'previous-line 'reftex-toc-previous reftex-toc-map global-map) - -(loop for x in - '(("n" . reftex-toc-next) - ("p" . reftex-toc-previous) - ("?" . reftex-toc-show-help) - (" " . reftex-toc-view-line) - ("\C-m" . reftex-toc-goto-line-and-hide) - ("\C-i" . reftex-toc-goto-line) - ("\C-c>" . reftex-toc-display-index) - ("r" . reftex-toc-rescan) - ("R" . reftex-toc-Rescan) - ("g" . revert-buffer) - ("q" . reftex-toc-quit); - ("k" . reftex-toc-quit-and-kill) - ("f" . reftex-toc-toggle-follow); - ("a" . reftex-toggle-auto-toc-recenter) - ("d" . reftex-toc-toggle-dedicated-frame) - ("F" . reftex-toc-toggle-file-boundary) - ("i" . reftex-toc-toggle-index) - ("l" . reftex-toc-toggle-labels) - ("t" . reftex-toc-max-level) - ("c" . reftex-toc-toggle-context) -; ("%" . reftex-toc-toggle-commented) - ("\M-%" . reftex-toc-rename-label) - ("x" . reftex-toc-external) - ("z" . reftex-toc-jump) - ("." . reftex-toc-show-calling-point) - ("\C-c\C-n" . reftex-toc-next-heading) - ("\C-c\C-p" . reftex-toc-previous-heading) - (">" . reftex-toc-demote) - ("<" . reftex-toc-promote)) - do (define-key reftex-toc-map (car x) (cdr x))) - -(loop for key across "0123456789" do - (define-key reftex-toc-map (vector (list key)) 'digit-argument)) -(define-key reftex-toc-map "-" 'negative-argument) - -(easy-menu-define - reftex-toc-menu reftex-toc-map - "Menu for Table of Contents buffer" - '("TOC" - ["Show Location" reftex-toc-view-line t] - ["Go To Location" reftex-toc-goto-line t] - ["Exit & Go To Location" reftex-toc-goto-line-and-hide t] - ["Show Calling Point" reftex-toc-show-calling-point t] - ["Quit" reftex-toc-quit t] - "--" - ("Edit" - ["Promote" reftex-toc-promote t] - ["Demote" reftex-toc-demote t] - ["Rename Label" reftex-toc-rename-label t]) - "--" - ["Index" reftex-toc-display-index t] - ["External Document TOC " reftex-toc-external t] - "--" - ("Update" - ["Rebuilt *toc* Buffer" revert-buffer t] - ["Rescan One File" reftex-toc-rescan reftex-enable-partial-scans] - ["Rescan Entire Document" reftex-toc-Rescan t]) - ("Options" - "TOC Items" - ["File Boundaries" reftex-toc-toggle-file-boundary :style toggle - :selected reftex-toc-include-file-boundaries] - ["Labels" reftex-toc-toggle-labels :style toggle - :selected reftex-toc-include-labels] - ["Index Entries" reftex-toc-toggle-index :style toggle - :selected reftex-toc-include-index-entries] - ["Context" reftex-toc-toggle-context :style toggle - :selected reftex-toc-include-context] - "--" - ["Follow Mode" reftex-toc-toggle-follow :style toggle - :selected reftex-toc-follow-mode] - ["Auto Recenter" reftex-toggle-auto-toc-recenter :style toggle - :selected reftex-toc-auto-recenter-timer] - ["Dedicated Frame" reftex-toc-toggle-dedicated-frame t]) - "--" - ["Help" reftex-toc-show-help t])) - - ;;; reftex-toc.el ends here === modified file 'lisp/vc/ediff-mult.el' --- lisp/vc/ediff-mult.el 2010-08-29 16:17:13 +0000 +++ lisp/vc/ediff-mult.el 2011-01-13 23:14:30 +0000 @@ -1,7 +1,7 @@ ;;; ediff-mult.el --- support for multi-file/multi-buffer processing in Ediff ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; Package: ediff @@ -458,6 +458,7 @@ Commands: \\{ediff-meta-buffer-map}" + ;; FIXME: Use define-derived-mode. (kill-all-local-variables) (setq major-mode 'ediff-meta-mode) (setq mode-name "MetaEdiff") === modified file 'lisp/vc/ediff-util.el' --- lisp/vc/ediff-util.el 2010-11-03 03:49:04 +0000 +++ lisp/vc/ediff-util.el 2011-01-13 23:14:30 +0000 @@ -1,7 +1,7 @@ ;;; ediff-util.el --- the core commands and utilities of ediff ;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 ;; Free Software Foundation, Inc. ;; Author: Michael Kifer @@ -94,6 +94,7 @@ Commands: \\{ediff-mode-map}" + ;; FIXME: Use define-derived-mode. (kill-all-local-variables) (setq major-mode 'ediff-mode) (setq mode-name "Ediff") ------------------------------------------------------------ revno: 102838 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2011-01-13 16:48:34 -0500 message: * lisp/mail/mail-utils.el (mail-strip-quoted-names): Make the regexp code work for nested comments. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-13 20:46:38 +0000 +++ lisp/ChangeLog 2011-01-13 21:48:34 +0000 @@ -1,5 +1,8 @@ 2011-01-13 Stefan Monnier + * mail/mail-utils.el (mail-strip-quoted-names): Make the regexp code + work for nested comments. + * progmodes/prolog.el: Use syntax-propertize. Further code cleanup. (prolog-use-prolog-tokenizer-flag): Change default when syntax-propertize can be used. === modified file 'lisp/mail/mail-utils.el' --- lisp/mail/mail-utils.el 2011-01-02 20:28:40 +0000 +++ lisp/mail/mail-utils.el 2011-01-13 21:48:34 +0000 @@ -182,56 +182,37 @@ (mapconcat 'identity (rfc822-addresses address) ", ")) (let (pos) - ;; Detect nested comments. - (if (string-match "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*(" address) - ;; Strip nested comments. - (with-temp-buffer - (insert address) - (set-syntax-table lisp-mode-syntax-table) - (goto-char 1) - (while (search-forward "(" nil t) - (forward-char -1) - (skip-chars-backward " \t") - (delete-region (point) - (save-excursion - (condition-case () - (forward-sexp 1) - (error (goto-char (point-max)))) - (point)))) - (setq address (buffer-string))) - ;; Strip non-nested comments an easier way. - (while (setq pos (string-match - ;; This doesn't hack rfc822 nested comments - ;; `(xyzzy (foo) whinge)' properly. Big deal. - "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*)" - address)) - (setq address (replace-match "" nil nil address 0)))) - - ;; strip surrounding whitespace - (string-match "\\`[ \t\n]*" address) - (setq address (substring address - (match-end 0) - (string-match "[ \t\n]*\\'" address - (match-end 0)))) - - ;; strip `quoted' names (This is supposed to hack `"Foo Bar" ') - (setq pos 0) - (while (setq pos (string-match + ;; Strip comments. + (while (setq pos (string-match + "[ \t]*(\\([^()\\]\\|\\\\.\\|\\\\\n\\)*)" + address)) + (setq address (replace-match "" nil nil address 0))) + + ;; strip surrounding whitespace + (string-match "\\`[ \t\n]*" address) + (setq address (substring address + (match-end 0) + (string-match "[ \t\n]*\\'" address + (match-end 0)))) + + ;; strip `quoted' names (This is supposed to hack `"Foo Bar" ') + (setq pos 0) + (while (setq pos (string-match "\\([ \t]?\\)\\([ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*\\)" address pos)) - ;; If the next thing is "@", we have "foo bar"@host. Leave it. - (if (and (> (length address) (match-end 0)) - (= (aref address (match-end 0)) ?@)) - (setq pos (match-end 0)) - ;; Otherwise discard the "..." part. - (setq address (replace-match "" nil nil address 2)))) - ;; If this address contains <...>, replace it with just - ;; the part between the <...>. - (while (setq pos (string-match "\\(,\\s-*\\|\\`\\)\\([^,]*<\\([^>,:]*\\)>[^,]*\\)\\(\\s-*,\\|\\'\\)" - address)) - (setq address (replace-match (match-string 3 address) - nil 'literal address 2))) - address)))) + ;; If the next thing is "@", we have "foo bar"@host. Leave it. + (if (and (> (length address) (match-end 0)) + (= (aref address (match-end 0)) ?@)) + (setq pos (match-end 0)) + ;; Otherwise discard the "..." part. + (setq address (replace-match "" nil nil address 2)))) + ;; If this address contains <...>, replace it with just + ;; the part between the <...>. + (while (setq pos (string-match "\\(,\\s-*\\|\\`\\)\\([^,]*<\\([^>,:]*\\)>[^,]*\\)\\(\\s-*,\\|\\'\\)" + address)) + (setq address (replace-match (match-string 3 address) + nil 'literal address 2))) + address)))) ;; The following piece of ugliness is legacy code. The name was an ;; unfortunate choice --- a flagrant violation of the Emacs Lisp ------------------------------------------------------------ revno: 102837 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2011-01-13 15:53:06 -0500 message: * test/indent/prolog.prolog: Add tokenizing tests. diff: === modified file 'test/ChangeLog' --- test/ChangeLog 2011-01-12 16:08:24 +0000 +++ test/ChangeLog 2011-01-13 20:53:06 +0000 @@ -1,3 +1,7 @@ +2011-01-13 Stefan Monnier + + * indent/prolog.prolog: Add tokenizing tests. + 2011-01-13 Christian Ohler * automated: New directory for automated tests. @@ -229,7 +233,7 @@ ;; add-log-time-zone-rule: t ;; End: - Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. + Copyright (C) 2008, 2009, 2010, 2011 Free Software Foundation, Inc. This file is part of GNU Emacs. === modified file 'test/indent/prolog.prolog' --- test/indent/prolog.prolog 2010-09-20 14:22:16 +0000 +++ test/indent/prolog.prolog 2011-01-13 20:53:06 +0000 @@ -1,11 +1,18 @@ -%% -*- mode: prolog; coding: utf-8 -*- +%% -*- mode: prolog; coding: utf-8; fill-column: 78 -*- + +%% Testing correct tokenizing. +foo(X) :- 0'= = X. +foo(X) :- 8'234 = X. +foo(X) :- '\x45\' = X. +foo(X) :- 'test 0'=X. +foo(X) :- 'test 8'=X. %% wf(+E) %% Vérifie que E est une expression syntaxiquement correcte. -wf(X) :- atom(X); integer(X); var(X). %Une variable ou un entier. -wf(lambda(X, T, B)) :- atom(X), wf(T), wf(B). %Une fonction. -wf(app(E1, E2)) :- wf(E1), wf(E2). %Un appel de fonction. -wf(pi(X, T, B)) :- atom(X), wf(T), wf(B). %Le type d'une fonction. +wf(X) :- atom(X); integer(X); var(X). %Une variable ou un entier. +wf(lambda(X, T, B)) :- atom(X), wf(T), wf(B). %Une fonction. +wf(app(E1, E2)) :- wf(E1), wf(E2). %Un appel de fonction. +wf(pi(X, T, B)) :- atom(X), wf(T), wf(B). %Le type d'une fonction. %% Éléments additionnels utilisés dans le langage source. wf(lambda(X, B)) :- atom(X), wf(B). ------------------------------------------------------------ revno: 102836 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2011-01-13 15:46:38 -0500 message: * lisp/progmodes/prolog.el: Use syntax-propertize. Further code cleanup. (prolog-use-prolog-tokenizer-flag): Change default when syntax-propertize can be used. (prolog-syntax-propertize-function): New var. (prolog-mode-variables): Move make-local-variable into `set'. Don't make comment-column local since we don't set it. Set comment-add (as it was in previous prolog.el). Use dolist. Set syntax-propertize-function. (prolog-mode, prolog-inferior-mode): Call prolog(-inferior)-menu directly, not through the mode-hook. (prolog-buffer-module, prolog-indent-level) (prolog-paren-is-the-first-on-line-p, prolog-paren-balance) (prolog-comment-limits, prolog-goto-comment-column): Use line-(end|beginning)-position. (prolog-build-prolog-command): Tighten up regexp. (prolog-consult-compile): Move make-local-variable into `set'. (prolog-consult-compile-filter, prolog-goto-next-paren) (prolog-help-on-predicate, prolog-clause-info) (prolog-mark-predicate): Don't let+setq. (prolog-indent-line): Use indent-line-to. Only call prolog-goto-comment-column if necessary. (prolog-indent-level): Use bobp. (prolog-first-pos-on-line): Remove, not used any more. (prolog-in-string-or-comment): Use syntax-ppss if available. (prolog-help-on-predicate): Use read-string. (prolog-goto-predicate-info): Simplify. (prolog-read-predicate): Use `default' rather than `initial'. (prolog-temporary-file): Use make-temp-file to close a security hole. (prolog-toggle-sicstus-sd): New command. (prolog-electric-underscore, prolog-variables-to-anonymous): Use dynamic-scoping as it was meant. (prolog-menu): Move menu definitions to top-level. Use a toggle-button for Sicstus's source debugger. Change "Code" to the more usual "Prolog", and hence change "Prolog" to "System". (prolog-inferior-menu): Reuse prolog-menu's help menu. Move other menu definition to top-level. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-13 20:17:15 +0000 +++ lisp/ChangeLog 2011-01-13 20:46:38 +0000 @@ -1,3 +1,43 @@ +2011-01-13 Stefan Monnier + + * progmodes/prolog.el: Use syntax-propertize. Further code cleanup. + (prolog-use-prolog-tokenizer-flag): Change default when + syntax-propertize can be used. + (prolog-syntax-propertize-function): New var. + (prolog-mode-variables): Move make-local-variable into `set'. + Don't make comment-column local since we don't set it. + Set comment-add (as it was in previous prolog.el). Use dolist. + Set syntax-propertize-function. + (prolog-mode, prolog-inferior-mode): + Call prolog(-inferior)-menu directly, not through the mode-hook. + (prolog-buffer-module, prolog-indent-level) + (prolog-paren-is-the-first-on-line-p, prolog-paren-balance) + (prolog-comment-limits, prolog-goto-comment-column): + Use line-(end|beginning)-position. + (prolog-build-prolog-command): Tighten up regexp. + (prolog-consult-compile): Move make-local-variable into `set'. + (prolog-consult-compile-filter, prolog-goto-next-paren) + (prolog-help-on-predicate, prolog-clause-info) + (prolog-mark-predicate): Don't let+setq. + (prolog-indent-line): Use indent-line-to. + Only call prolog-goto-comment-column if necessary. + (prolog-indent-level): Use bobp. + (prolog-first-pos-on-line): Remove, not used any more. + (prolog-in-string-or-comment): Use syntax-ppss if available. + (prolog-help-on-predicate): Use read-string. + (prolog-goto-predicate-info): Simplify. + (prolog-read-predicate): Use `default' rather than `initial'. + (prolog-temporary-file): Use make-temp-file to close a security hole. + (prolog-toggle-sicstus-sd): New command. + (prolog-electric-underscore, prolog-variables-to-anonymous): + Use dynamic-scoping as it was meant. + (prolog-menu): Move menu definitions to top-level. + Use a toggle-button for Sicstus's source debugger. + Change "Code" to the more usual "Prolog", and hence change "Prolog" + to "System". + (prolog-inferior-menu): Reuse prolog-menu's help menu. + Move other menu definition to top-level. + 2011-01-13 Tassilo Horn * doc-view.el (doc-view-open-text): Use meaningful text buffer === modified file 'lisp/progmodes/prolog.el' --- lisp/progmodes/prolog.el 2011-01-11 05:07:32 +0000 +++ lisp/progmodes/prolog.el 2011-01-13 20:46:38 +0000 @@ -72,7 +72,7 @@ ;; auto-mode-alist)) ;; ;; where the path in the first line is the file system path to this file. -;; MSDOS paths can be written like "d:/programs/emacs-19.34/site-lisp". +;; MSDOS paths can be written like "d:/programs/emacs-19.34/site-lisp". ;; Note: In XEmacs, either `/usr/lib/xemacs/site-lisp' (RPM default in ;; Red Hat-based distributions) or `/usr/local/lib/xemacs/site-lisp' ;; (default when compiling from sources) are automatically added to @@ -88,10 +88,10 @@ ;; ;; % -*- Mode: Prolog -*- ;; -;; and then the file will be open in Prolog mode no matter its +;; and then the file will be open in Prolog mode no matter its ;; extension, or ;; -;; o manually switch to prolog mode after opening a Prolog file, by typing +;; o manually switch to prolog mode after opening a Prolog file, by typing ;; M-x prolog-mode. ;; ;; If the command to start the prolog process ('sicstus', 'pl' or @@ -129,7 +129,7 @@ ;; Version 1.19: ;; o Minimal changes for Aquamacs inclusion and in general for ;; better coping with finding the Prolog executable. Patch -;; provided by David Reitter +;; provided by David Reitter ;; Version 1.18: ;; o Fixed syntax highlighting for clause heads that do not begin at ;; the beginning of the line. @@ -235,11 +235,11 @@ ;; o Fixed dots in the end of line comments causing indentation ;; problems. The following code is now correctly indented (note ;; the dot terminating the comment): -;; a(X) :- b(X), +;; a(X) :- b(X), ;; c(X). % comment here. ;; a(X). ;; and so is this (and variants): -;; a(X) :- b(X), +;; a(X) :- b(X), ;; c(X). /* comment here. */ ;; a(X). ;; Version 1.0: @@ -262,15 +262,18 @@ ;; anyway. ;; o Fixed prolog-pred-start, prolog-clause-start, prolog-clause-info. ;; o Fix for prolog-build-case-strings; now prolog-upper-case-string -;; and prolog-lower-case-string are correctly initialized, +;; and prolog-lower-case-string are correctly initialized, ;; o Various font-lock changes; most importantly, block comments (/* ;; ... */) are now correctly fontified in XEmacs even when they ;; extend on multiple lines. -;; Version 0.1.36: +;; Version 0.1.36: ;; o The debug prompt of SWI Prolog is now correctly recognized. -;; Version 0.1.35: +;; Version 0.1.35: ;; o Minor font-lock bug fixes. +;;; TODO: + +;; Replace ":type 'sexp" with more precise Custom types. ;;; Code: @@ -361,7 +364,7 @@ (defcustom prolog-indent-width 4 "*The indentation width used by the editing buffer." :group 'prolog-indentation - :type 'integer) + :type 'integer) (defcustom prolog-align-comments-flag t "*Non-nil means automatically align comments when indenting." @@ -436,6 +439,7 @@ "ensure_loaded" "foreign" "include" "initialization" "multifile" "op" "public" "set_prolog_flag")) (t + ;; FIXME: Shouldn't we just use the union of all the above here? ("dynamic" "module"))) "*Alist of Prolog keywords which is used for font locking of directives." :group 'prolog-font-lock @@ -494,15 +498,15 @@ precedes the point, it inserts a recursive call to the current predicate. If dot is pressed at the beginning of an empty line, it inserts the head of a new clause for the current predicate. It does not apply in strings -and comments. +and comments. It does not apply in strings and comments." :group 'prolog-keyboard :type 'boolean) (defcustom prolog-electric-dot-full-predicate-template nil - "*If nil, electric dot inserts only the current predicate's name and `(' -for recursive calls or new clause heads. Non-nil means to also -insert enough commata to cover the predicate's arity and `)', + "*If nil, electric dot inserts only the current predicate's name and `(' +for recursive calls or new clause heads. Non-nil means to also +insert enough commata to cover the predicate's arity and `)', and dot and newline for recursive calls." :group 'prolog-keyboard :type 'boolean) @@ -526,10 +530,10 @@ to automatically indent if-then-else constructs." :group 'prolog-keyboard :type 'boolean) - + (defcustom prolog-electric-colon-flag nil "*Makes `:' electric (inserts `:-' on a new line). -If non-nil, pressing `:' at the end of a line that starts in +If non-nil, pressing `:' at the end of a line that starts in the first column (i.e., clause heads) inserts ` :-' and newline." :group 'prolog-keyboard :type 'boolean) @@ -683,7 +687,8 @@ ;; Miscellaneous -(defcustom prolog-use-prolog-tokenizer-flag t +(defcustom prolog-use-prolog-tokenizer-flag + (not (fboundp 'syntax-propertize-rules)) "*Non-nil means use the internal prolog tokenizer for indentation etc. Otherwise use `parse-partial-sexp' which is faster but sometimes incorrect." :group 'prolog-other @@ -717,9 +722,8 @@ :type 'boolean) (defcustom prolog-char-quote-workaround nil - ;; FIXME: Use syntax-propertize-function to fix it right. - "*If non-nil, declare 0 as a quote character so that 0' does not break syntax highlighting. -This is really kludgy but I have not found any better way of handling it." + "*If non-nil, declare 0 as a quote character to handle 0'. +This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." :group 'prolog-other :type 'boolean) @@ -731,6 +735,13 @@ ;;(defvar prolog-temp-filename "") ; Later set by `prolog-temporary-file' (defvar prolog-mode-syntax-table + ;; The syntax accepted varies depending on the implementation used. + ;; Here are some of the differences: + ;; - SWI-Prolog accepts nested /*..*/ comments. + ;; - Edinburgh-style Prologs take ' for non-decimal number, + ;; whereas ISO-style Prologs use 0[obx] instead. + ;; - In atoms \x sometimes needs a terminating \ (ISO-style) + ;; and sometimes not. (let ((table (make-syntax-table))) (if prolog-underscore-wordchar-flag (modify-syntax-entry ?_ "w" table) @@ -767,14 +778,14 @@ (defvar prolog-lower-case-string "" "A string containing all lower case characters. Set by prolog-build-case-strings.") - + (defvar prolog-atom-char-regexp "" "Set by prolog-set-atom-regexps.") ;; "Regexp specifying characters which constitute atoms without quoting.") (defvar prolog-atom-regexp "" "Set by prolog-set-atom-regexps.") -(defconst prolog-left-paren "[[({]" +(defconst prolog-left-paren "[[({]" "The characters used as left parentheses for the indentation code.") (defconst prolog-right-paren "[])}]" "The characters used as right parentheses for the indentation code.") @@ -863,52 +874,58 @@ result) alist)) +(defconst prolog-syntax-propertize-function + (when (fboundp 'syntax-propertize-rules) + (syntax-propertize-rules + ;; GNU Prolog only accepts 0'\' rather than 0'', but the only + ;; possible meaning of 0'' is rather clear. + ("\\<0\\(''?\\)" + (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) + (string-to-syntax "_")))) + ;; We could check that we're not inside an atom, but I don't think + ;; that 'foo 8'z could be a valid syntax anyway, so why bother? + ("\\<[1-9][0-9]*\\('\\)[0-9a-zA-Z]" (1 "_")) + ;; Supposedly, ISO-Prolog wants \NNN\ for octal and \xNNN\ for hexadecimal + ;; escape sequences in atoms, so be careful not to let the terminating \ + ;; escape a subsequent quote. + ("\\\\[x0-7][0-9a-fA-F]*\\(\\\\\\)" (1 "_")) + ))) + (defun prolog-mode-variables () "Set some common variables to Prolog code specific values." (setq local-abbrev-table prolog-mode-abbrev-table) - (make-local-variable 'paragraph-start) - (setq paragraph-start (concat "[ \t]*$\\|" page-delimiter)) ;'%%..' - (make-local-variable 'paragraph-separate) - (setq paragraph-separate paragraph-start) - (make-local-variable 'paragraph-ignore-fill-prefix) - (setq paragraph-ignore-fill-prefix t) - (make-local-variable 'normal-auto-fill-function) - (setq normal-auto-fill-function 'prolog-do-auto-fill) - (make-local-variable 'indent-line-function) - (setq indent-line-function 'prolog-indent-line) - (make-local-variable 'comment-start) - (setq comment-start "%") - (make-local-variable 'comment-end) - (setq comment-end "") - (make-local-variable 'comment-start-skip) - ;; This complex regexp makes sure that comments cannot start - ;; inside quoted atoms or strings - (setq comment-start-skip - (format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)\\(/\\*+ *\\|%%+ *\\)" - prolog-quoted-atom-regexp prolog-string-regexp)) - (make-local-variable 'comment-column) - (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'prolog-comment-indent) - (make-local-variable 'parens-require-spaces) - (setq parens-require-spaces nil) + (set (make-local-variable 'paragraph-start) + (concat "[ \t]*$\\|" page-delimiter)) ;'%%..' + (set (make-local-variable 'paragraph-separate) paragraph-start) + (set (make-local-variable 'paragraph-ignore-fill-prefix) t) + (set (make-local-variable 'normal-auto-fill-function) 'prolog-do-auto-fill) + (set (make-local-variable 'indent-line-function) 'prolog-indent-line) + (set (make-local-variable 'comment-start) "%") + (set (make-local-variable 'comment-end) "") + (set (make-local-variable 'comment-add) 1) + (set (make-local-variable 'comment-start-skip) + ;; This complex regexp makes sure that comments cannot start + ;; inside quoted atoms or strings + (format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)\\(/\\*+ *\\|%%+ *\\)" + prolog-quoted-atom-regexp prolog-string-regexp)) + (set (make-local-variable 'comment-indent-function) 'prolog-comment-indent) + (set (make-local-variable 'parens-require-spaces) nil) ;; Initialize Prolog system specific variables - (let ((vars '(prolog-keywords prolog-types prolog-mode-specificators - prolog-determinism-specificators prolog-directives - prolog-program-name prolog-program-switches - prolog-consult-string prolog-compile-string prolog-eof-string - prolog-prompt-regexp prolog-continued-prompt-regexp - prolog-help-function))) - (while vars - (set (intern (concat (symbol-name (car vars)) "-i")) - (prolog-find-value-by-system (symbol-value (car vars)))) - (setq vars (cdr vars)))) + (dolist (var '(prolog-keywords prolog-types prolog-mode-specificators + prolog-determinism-specificators prolog-directives + prolog-program-name prolog-program-switches + prolog-consult-string prolog-compile-string prolog-eof-string + prolog-prompt-regexp prolog-continued-prompt-regexp + prolog-help-function)) + (set (intern (concat (symbol-name var) "-i")) + (prolog-find-value-by-system (symbol-value var)))) (when (null prolog-program-name-i) - (make-local-variable 'compile-command) - (setq compile-command prolog-compile-string-i)) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults - '(prolog-font-lock-keywords nil nil ((?_ . "w")))) -) + (set (make-local-variable 'compile-command) prolog-compile-string-i)) + (set (make-local-variable 'font-lock-defaults) + '(prolog-font-lock-keywords nil nil ((?_ . "w")))) + (set (make-local-variable 'syntax-propertize-function) + prolog-syntax-propertize-function) + ) (defun prolog-mode-keybindings-common (map) "Define keybindings common to both Prolog modes in MAP." @@ -947,7 +964,7 @@ (define-key map ">" 'prolog-electric-if-then-else) (define-key map ":" 'prolog-electric-colon) (define-key map "-" 'prolog-electric-dash) - (if prolog-electric-newline-flag + (if prolog-electric-newline-flag (define-key map "\r" 'newline-and-indent)) ;; If we're running SICStus, then map C-c C-c e/d to enabling @@ -975,7 +992,7 @@ (define-key map "\C-c\C-cr" 'prolog-compile-region) (define-key map "\C-c\C-cb" 'prolog-compile-buffer) (define-key map "\C-c\C-cf" 'prolog-compile-file)) - + ;; Inherited from the old prolog.el. (define-key map "\e\C-x" 'prolog-consult-region) (define-key map "\C-c\C-l" 'prolog-consult-file) @@ -991,7 +1008,7 @@ (prolog-mode-keybindings-common map) (prolog-mode-keybindings-edit map) map)) - + (defvar prolog-mode-hook nil "List of functions to call after the prolog mode has initialised.") @@ -1027,12 +1044,14 @@ (dolist (ar prolog-align-rules) (add-to-list 'align-rules-list ar)) ;; imenu entry moved to the appropriate hook for consistency - + ;; Load SICStus debugger if suitable (if (and (eq prolog-system 'sicstus) (prolog-atleast-version '(3 . 7)) prolog-use-sicstus-sd) - (prolog-enable-sicstus-sd))) + (prolog-enable-sicstus-sd)) + + (prolog-menu)) (defvar mercury-mode-map (let ((map (make-sparse-keymap))) @@ -1055,7 +1074,7 @@ (prolog-mode-keybindings-common map) (prolog-mode-keybindings-inferior map) map)) - + (defvar prolog-inferior-mode-hook nil "List of functions to call after the inferior prolog mode has initialised.") @@ -1092,7 +1111,8 @@ (setq mode-line-process '(": %s")) (prolog-mode-variables) (setq comint-prompt-regexp prolog-prompt-regexp-i) - (set (make-local-variable 'shell-dirstack-query) "pwd.")) + (set (make-local-variable 'shell-dirstack-query) "pwd.") + (prolog-inferior-menu)) (defun prolog-input-filter (str) (cond ((string-match "\\`\\s *\\'" str) nil) ;whitespace @@ -1169,8 +1189,8 @@ ;(let ((tmpfile prolog-temp-filename) (let ((tmpfile (prolog-bsts (prolog-temporary-file))) ;(process (get-process "prolog")) - (first-line (1+ (count-lines - (point-min) + (first-line (1+ (count-lines + (point-min) (save-excursion (goto-char start) (point)))))) @@ -1199,7 +1219,7 @@ (prolog-ensure-process) (let ((filename (prolog-bsts buffer-file-name))) (process-send-string - "prolog" (prolog-build-prolog-command + "prolog" (prolog-build-prolog-command compilep filename filename)) (prolog-goto-prolog-process-buffer))) @@ -1274,11 +1294,11 @@ (save-excursion (goto-char (point-min)) (skip-chars-forward " \t") - (and (search-forward "-*-" (save-excursion (end-of-line) (point)) t) + (and (search-forward "-*-" (line-end-position) t) (progn (skip-chars-forward " \t") (setq beg (point)) - (search-forward "-*-" (save-excursion (end-of-line) (point)) t)) + (search-forward "-*-" (line-end-position) t)) (progn (forward-char -3) (skip-chars-backward " \t") @@ -1295,7 +1315,7 @@ (skip-chars-backward " \t") (buffer-substring beg (point))))))))) -(defun prolog-build-prolog-command (compilep file buffername +(defun prolog-build-prolog-command (compilep file buffername &optional first-line) "Make Prolog command for FILE compilation/consulting. If COMPILEP is non-nil, consider compilation, otherwise consulting." @@ -1316,12 +1336,14 @@ (if (not buffername) (error "The buffer is not saved")) - (if (not (string-match "^'.*'$" buffername)) ; Add quotes + (if (not (string-match "\\`'.*'\\'" buffername)) ; Add quotes (setq buffername (concat "'" buffername "'"))) (while (string-match "%m" compile-string) (setq strbeg (substring compile-string 0 (match-beginning 0))) (setq strend (substring compile-string (match-end 0))) (setq compile-string (concat strbeg module-file strend))) + ;; FIXME: The code below will %-expand any %[fbl] that appears in + ;; module-file. (while (string-match "%f" compile-string) (setq strbeg (substring compile-string 0 (match-beginning 0))) (setq strend (substring compile-string (match-end 0))) @@ -1340,7 +1362,7 @@ ;; Global variables for process filter function (defvar prolog-process-flag nil - "Non-nil means that a prolog task (i.e. a consultation or compilation job) + "Non-nil means that a prolog task (i.e. a consultation or compilation job) is running.") (defvar prolog-consult-compile-output "" "Hold the unprocessed output from the current prolog task.") @@ -1366,7 +1388,7 @@ (prolog-ensure-process t) (let* ((buffer (get-buffer-create prolog-compilation-buffer)) (real-file buffer-file-name) - (command-string (prolog-build-prolog-command compilep file + (command-string (prolog-build-prolog-command compilep file real-file first-line)) (process (get-process "prolog")) (old-filter (process-filter process))) @@ -1374,14 +1396,12 @@ (delete-region (point-min) (point-max)) (compilation-mode) ;; Setting up font-locking for this buffer - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults - '(prolog-font-lock-keywords nil nil ((?_ . "w")))) + (set (make-local-variable 'font-lock-defaults) + '(prolog-font-lock-keywords nil nil ((?_ . "w")))) (if (eq prolog-system 'sicstus) (progn - (make-local-variable 'compilation-parse-errors-function) - (setq compilation-parse-errors-function - 'prolog-parse-sicstus-compilation-errors))) + (set (make-local-variable 'compilation-parse-errors-function) + 'prolog-parse-sicstus-compilation-errors))) (toggle-read-only 0) (insert command-string "\n")) (save-selected-window @@ -1390,7 +1410,7 @@ prolog-consult-compile-output "" prolog-consult-compile-first-line (if first-line (1- first-line) 0) prolog-consult-compile-file file - prolog-consult-compile-real-file (if (string= + prolog-consult-compile-real-file (if (string= file buffer-file-name) nil real-file)) @@ -1403,7 +1423,7 @@ (accept-process-output process 10)) ; 10 secs is ok? (sit-for 0.1) (unless (get-process "prolog") - (setq prolog-process-flag nil))) + (setq prolog-process-flag nil))) (insert (if compilep "\nCompilation finished.\n" "\nConsulted.\n")) @@ -1416,7 +1436,7 @@ (setq compilation-error-list nil) (message "Parsing SICStus error messages...") (let (filepath dir file errorline) - (while + (while (re-search-backward "{\\([a-zA-Z ]* ERROR\\|Warning\\):.* in line[s ]*\\([0-9]+\\)" limit t) @@ -1455,15 +1475,15 @@ (while (and prolog-process-flag (or ;; Trace question - (progn + (progn (setq outputtype 'trace) (and (eq prolog-system 'sicstus) (string-match "^[ \t]*[0-9]+[ \t]*[0-9]+[ \t]*Call:.*? " prolog-consult-compile-output))) - + ;; Match anything - (progn + (progn (setq outputtype 'normal) (string-match "^.*\n" prolog-consult-compile-output)) )) @@ -1474,17 +1494,16 @@ (setq prolog-consult-compile-output (substring prolog-consult-compile-output (length output))) ;;(message "pccf2: %s" prolog-consult-compile-output) - + ;; If temporary files were used, then we change the error ;; messages to point to the original source file. (cond ;; If the prolog process was in trace mode then it requires ;; user input - ((and (eq prolog-system 'sicstus) + ((and (eq prolog-system 'sicstus) (eq outputtype 'trace)) - (let (input) - (setq input (concat (read-string output) "\n")) + (let ((input (concat (read-string output) "\n"))) (process-send-string process input) (setq output (concat output input)))) @@ -1493,7 +1512,7 @@ (string-match "\\({.*:.* in line[s ]*\\)\\([0-9]+\\)-\\([0-9]+\\)" output)) (setq output (replace-match - ;; Adds a {processing ...} line so that + ;; Adds a {processing ...} line so that ;; `prolog-parse-sicstus-compilation-errors' ;; finds the real file instead of the temporary one. ;; Also fixes the line numbers. @@ -1508,7 +1527,7 @@ (match-string 3 output)))) t t output))) ) - + ((eq prolog-system 'swi) (if (and prolog-consult-compile-real-file (string-match (format @@ -1525,7 +1544,7 @@ (match-string 2 output)))) t t output))) ) - + (t ()) ) ;; Write the output in the *prolog-compilation* buffer @@ -1593,14 +1612,14 @@ "Find SICStus objects method name for font lock. Argument BOUND is a buffer position limiting searching." (let (point - (case-fold-search nil)) + (case-fold-search nil)) (while (and (not point) (re-search-forward "\\(::[ \t\n]*{\\|&\\)[ \t]*" bound t)) (while (or (re-search-forward "\\=\n[ \t]*" bound t) - (re-search-forward "\\=%.*" bound t) - (and (re-search-forward "\\=/\\*" bound t) - (re-search-forward "\\*/[ \t]*" bound t)))) + (re-search-forward "\\=%.*" bound t) + (and (re-search-forward "\\=/\\*" bound t) + (re-search-forward "\\*/[ \t]*" bound t)))) (setq point (re-search-forward (format "\\=\\(%s\\)" prolog-atom-regexp) bound t))) @@ -1620,7 +1639,7 @@ "Set up font lock keywords for the current Prolog system." ;(when window-system (require 'font-lock) - + ;; Define Prolog faces (defface prolog-redo-face '((((class grayscale)) (:italic t)) @@ -1656,12 +1675,12 @@ (t (:bold t))) "Face name to use for compiler warnings." :group 'prolog-faces) - (defvar prolog-warning-face + (defvar prolog-warning-face (if (prolog-face-name-p 'font-lock-warning-face) 'font-lock-warning-face 'prolog-warning-face) "Face name to use for built in predicates.") - (defvar prolog-builtin-face + (defvar prolog-builtin-face (if (prolog-face-name-p 'font-lock-builtin-face) 'font-lock-builtin-face 'prolog-builtin-face) @@ -1672,7 +1691,7 @@ "Face name to use for exit trace lines.") (defvar prolog-exception-face 'prolog-exception-face "Face name to use for exception trace lines.") - + ;; Font Lock Patterns (let ( ;; "Native" Prolog patterns @@ -1808,7 +1827,7 @@ (warning-messages (cond ((eq prolog-system 'sicstus) - '("\\({ ?\\(Warning\\|WARNING\\) ?:.*}\\)[ \t]*$" + '("\\({ ?\\(Warning\\|WARNING\\) ?:.*}\\)[ \t]*$" 2 prolog-warning-face prepend)) (t nil)))) @@ -1870,15 +1889,25 @@ (beginning-of-line) (setq beg (point)) (skip-chars-forward " \t") - (if (zerop (- indent (current-column))) - nil - (delete-region beg (point)) - (indent-to indent)) + (indent-line-to indent) (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos))) - + ;; Align comments - (if prolog-align-comments-flag + (if (and prolog-align-comments-flag + (save-excursion + (line-beginning-position) + ;; (let ((start (comment-search-forward (line-end-position) t))) + ;; (and start ;There's a comment to indent. + ;; ;; If it's first on the line, we've indented it already + ;; ;; and prolog-goto-comment-column would inf-loop. + ;; (progn (goto-char start) (skip-chars-backward " \t") + ;; (not (bolp))))))) + (and (looking-at comment-start-skip) + ;; The definition of comment-start-skip used in this + ;; mode is unusual in that it only matches at BOL. + (progn (skip-chars-forward " \t") + (not (eq (point) (match-end 1))))))) (save-excursion (prolog-goto-comment-column t))) @@ -1889,6 +1918,8 @@ (defun prolog-comment-indent () "Compute prolog comment indentation." + ;; FIXME: Only difference with default behavior is that %%% is not + ;; flushed to column 0 but just left where the user put it. (cond ((looking-at "%%%") (prolog-indentation-level-of-line)) ((looking-at "%%") (prolog-indent-level)) (t @@ -1909,13 +1940,13 @@ (skip-chars-forward " \t") (cond ((looking-at "%%%") (prolog-indentation-level-of-line)) - ;Large comment starts + ;Large comment starts ((looking-at "%[^%]") comment-column) ;Small comment starts - ((bobp) 0) ;Beginning of buffer + ((bobp) 0) ;Beginning of buffer ;; If we found '}' then we must check if it's the ;; end of an object declaration or something else. - ((and (looking-at "}") + ((and (looking-at "}") (save-excursion (forward-char 1) ;; Goto to matching { @@ -1928,10 +1959,10 @@ ;; It was an object (if prolog-object-end-to-0-flag 0 - prolog-indent-width)) + prolog-indent-width)) ;;End of /* */ comment - ((looking-at "\\*/") + ((looking-at "\\*/") (save-excursion (prolog-find-start-of-mline-comment) (skip-chars-backward " \t") @@ -1939,7 +1970,7 @@ ;; Here we check if the current line is within a /* */ pair ((and (looking-at "[^%/]") - (eq (prolog-in-string-or-comment) 'cmt)) + (eq (prolog-in-string-or-comment) 'cmt)) (if prolog-indent-mline-comments-flag (prolog-find-start-of-mline-comment) ;; Same as before @@ -1951,18 +1982,19 @@ (while empty (forward-line -1) (beginning-of-line) - (if (= (point) (point-min)) + (if (bobp) (setq empty nil) (skip-chars-forward " \t") - (if (not (or (not (member (prolog-in-string-or-comment) '(nil txt))) - (looking-at "%") + (if (not (or (not (member (prolog-in-string-or-comment) + '(nil txt))) + (looking-at "%") (looking-at "\n"))) (setq empty nil)))) ;; Store this line's indentation - (if (= (point) (point-min)) - (setq ind 0) ;Beginning of buffer - (setq ind (current-column))) ;Beginning of clause + (setq ind (if (bobp) + 0 ;Beginning of buffer. + (current-column))) ;Beginning of clause. ;; Compute the balance of the line (setq linebal (prolog-paren-balance)) @@ -1981,25 +2013,25 @@ (cond ;; If the last char of the line is a '&' then set the indent level ;; to prolog-indent-width (used in SICStus objects) - ((and (eq prolog-system 'sicstus) + ((and (eq prolog-system 'sicstus) (looking-at ".+&[ \t]*\\(%.*\\|\\)$")) (setq ind prolog-indent-width)) ;; Increase indentation if the previous line was the head of a rule ;; and does not contain a '.' - ((and (looking-at (format ".*%s[^\\.]*[ \t]*\\(%%.*\\|\\)$" + ((and (looking-at (format ".*%s[^\\.]*[ \t]*\\(%%.*\\|\\)$" prolog-head-delimiter)) ;; We must check that the match is at a paren balance of 0. (save-excursion (let ((p (point))) (re-search-forward prolog-head-delimiter) (>= 0 (prolog-region-paren-balance p (point)))))) - (let (headindent) - (if (< (prolog-paren-balance) 0) - (save-excursion - (end-of-line) - (setq headindent (prolog-find-indent-of-matching-paren))) - (setq headindent (prolog-indentation-level-of-line))) + (let ((headindent + (if (< (prolog-paren-balance) 0) + (save-excursion + (end-of-line) + (prolog-find-indent-of-matching-paren)) + (prolog-indentation-level-of-line)))) (setq ind (+ headindent prolog-indent-width)))) ;; The previous line was the head of an object @@ -2009,17 +2041,16 @@ ;; If a '.' is found at the end of the previous line, then ;; decrease the indentation. (The \\(%.*\\|\\) part of the ;; regexp is for comments at the end of the line) - ((and (looking-at "^.+\\.[ \t]*\\(%.*\\|\\)$") + ((and (looking-at "^.+\\.[ \t]*\\(%.*\\|\\)$") ;; Make sure that the '.' found is not in a comment or string (save-excursion (end-of-line) (re-search-backward "\\.[ \t]*\\(%.*\\|\\)$" (point-min)) ;; Guard against the real '.' being followed by a ;; commented '.'. - (if (eq (prolog-in-string-or-comment) 'cmt) ;; commented out '.' - (let ((here (save-excursion - (beginning-of-line) - (point)))) + (if (eq (prolog-in-string-or-comment) 'cmt) + ;; commented out '.' + (let ((here (line-beginning-position))) (end-of-line) (re-search-backward "\\.[ \t]*%.*$" here t)) (not (prolog-in-string-or-comment)) @@ -2031,17 +2062,16 @@ ;; decrease the indentation. (The /\\*.*\\*/ part of the ;; regexp is for C-like comments at the end of the ;; line--can we merge with the case above?). - ((and (looking-at "^.+\\.[ \t]*\\(/\\*.*\\|\\)$") + ((and (looking-at "^.+\\.[ \t]*\\(/\\*.*\\|\\)$") ;; Make sure that the '.' found is not in a comment or string (save-excursion (end-of-line) (re-search-backward "\\.[ \t]*\\(/\\*.*\\|\\)$" (point-min)) ;; Guard against the real '.' being followed by a ;; commented '.'. - (if (eq (prolog-in-string-or-comment) 'cmt) ;; commented out '.' - (let ((here (save-excursion - (beginning-of-line) - (point)))) + (if (eq (prolog-in-string-or-comment) 'cmt) + ;; commented out '.' + (let ((here (line-beginning-position))) (end-of-line) (re-search-backward "\\.[ \t]*/\\*.*$" here t)) (not (prolog-in-string-or-comment)) @@ -2062,20 +2092,21 @@ (= totbal 1) (prolog-in-object)))) (if (looking-at - (format "\\(%s\\|%s\\|0'.\\|[0-9]+'[0-9a-zA-Z]+\\|[^\n\'\"%%]\\)*\\(,\\|%s\\|%s\\)\[ \t]*\\(%%.*\\|\\)$" + (format "\\(%s\\|%s\\|0'.\\|[0-9]+'[0-9a-zA-Z]+\\|[^\n\'\"%%]\\)*\\(,\\|%s\\|%s\\)\[ \t]*\\(%%.*\\|\\)$" prolog-quoted-atom-regexp prolog-string-regexp prolog-left-paren prolog-left-indent-regexp)) (progn (goto-char oldpoint) - (setq ind (prolog-find-unmatched-paren (if prolog-paren-indent-p - 'termdependent - 'skipwhite))) + (setq ind (prolog-find-unmatched-paren + (if prolog-paren-indent-p + 'termdependent + 'skipwhite))) ;;(setq ind (prolog-find-unmatched-paren 'termdependent)) ) (goto-char oldpoint) (setq ind (prolog-find-unmatched-paren nil)) )) - + ;; Return the indentation level ind @@ -2117,18 +2148,12 @@ (skip-chars-forward " \t") (current-column))) -(defun prolog-first-pos-on-line () - "Return the first position on the current line." - (save-excursion - (beginning-of-line) - (point))) - (defun prolog-paren-is-the-first-on-line-p () "Return t if the parenthesis under the point is the first one on the line. Return nil otherwise. Note: does not check if the point is actually at a parenthesis!" (save-excursion - (let ((begofline (prolog-first-pos-on-line))) + (let ((begofline (line-beginning-position))) (if (= begofline (point)) t (if (prolog-goto-next-paren begofline) @@ -2151,14 +2176,14 @@ (let ((roundparen (looking-at "("))) (if (looking-at prolog-left-paren) - (let ((not-part-of-term + (let ((not-part-of-term (save-excursion (backward-char 1) (looking-at "[ \t]")))) (if (eq mode nil) (current-column) (if (and roundparen - (eq mode 'termdependent) + (eq mode 'termdependent) not-part-of-term) (+ (current-column) (if prolog-electric-tab-flag @@ -2191,7 +2216,7 @@ A return value of n means n more left parentheses than right ones." (save-excursion (end-of-line) - (prolog-region-paren-balance (prolog-first-pos-on-line) (point)))) + (prolog-region-paren-balance (line-beginning-position) (point)))) (defun prolog-region-paren-balance (beg end) "Return the summed parenthesis balance in the region. @@ -2205,10 +2230,9 @@ (defun prolog-goto-next-paren (limit-pos) "Move the point to the next parenthesis earlier in the buffer. Return t if a match was found before LIMIT-POS. Return nil otherwise." - (let (retval) - (setq retval (re-search-backward - (concat prolog-left-paren "\\|" prolog-right-paren) - limit-pos t)) + (let ((retval (re-search-backward + (concat prolog-left-paren "\\|" prolog-right-paren) + limit-pos t))) ;; If a match was found but it was in a string or comment, then recurse (if (and retval (prolog-in-string-or-comment)) @@ -2246,7 +2270,9 @@ (end (point)) (state (if prolog-use-prolog-tokenizer-flag (prolog-tokenize start end) - (parse-partial-sexp start end)))) + (if (fboundp 'syntax-ppss) + (syntax-ppss) + (parse-partial-sexp start end))))) (cond ((nth 3 state) 'txt) ; String ((nth 4 state) 'cmt) ; Comment @@ -2279,9 +2305,9 @@ (skip-chars-forward " \t") (when (looking-at regexp) ;; Treat "( If -> " lines specially. - ;;(if (looking-at "(.*->") - ;; (setq incr 2) - ;; (setq incr prolog-paren-indent)) + ;;(setq incr (if (looking-at "(.*->") + ;; 2 + ;; prolog-paren-indent)) ;; work on all subsequent "->", "(", ";" (while (looking-at regexp) @@ -2315,8 +2341,8 @@ (save-restriction ;; Widen to catch comment limits correctly. (widen) - (setq end (save-excursion (end-of-line) (point)) - beg (save-excursion (beginning-of-line) (point))) + (setq end (line-end-position) + beg (line-beginning-position)) (save-excursion (beginning-of-line) (setq lit-type (if (search-forward-regexp "%" end t) 'line 'block)) @@ -2334,14 +2360,14 @@ (progn (goto-char here) (when (looking-at "/\\*") (forward-char 2)) - (when (and (looking-at "\\*") (> (point) (point-min)) + (when (and (looking-at "\\*") (> (point) (point-min)) (forward-char -1) (looking-at "/")) (forward-char 1)) (when (save-excursion (search-backward "/*" nil t)) (list (save-excursion (search-backward "/*") (point)) (or (search-forward "*/" nil t) (point-max)) lit-type))) ;; line comment - (setq lit-limits-b (- (point) 1) + (setq lit-limits-b (- (point) 1) lit-limits-e end) (condition-case nil (if (progn (goto-char lit-limits-b) @@ -2353,14 +2379,15 @@ ;; Go backward now (beginning-of-line) (while (and (zerop (setq done (forward-line -1))) - (search-forward-regexp "^[ \t]*%" (save-excursion (end-of-line) (point)) t) + (search-forward-regexp "^[ \t]*%" + (line-end-position) t) (= (+ 1 col) (current-column))) (setq beg (- (point) 1))) (when (= done 0) (forward-line 1)) ;; We may have a line with code above... (when (and (zerop (setq done (forward-line -1))) - (search-forward "%" (save-excursion (end-of-line) (point)) t) + (search-forward "%" (line-end-position) t) (= (+ 1 col) (current-column))) (setq beg (- (point) 1))) (when (= done 0) @@ -2369,9 +2396,10 @@ (goto-char lit-limits-b) (beginning-of-line) (while (and (zerop (forward-line 1)) - (search-forward-regexp "^[ \t]*%" (save-excursion (end-of-line) (point)) t) + (search-forward-regexp "^[ \t]*%" + (line-end-position) t) (= (+ 1 col) (current-column))) - (setq end (save-excursion (end-of-line) (point)))) + (setq end (line-end-position))) (list beg end lit-type)) (list lit-limits-b lit-limits-e lit-type) ) @@ -2476,7 +2504,7 @@ the current entity (e.g. a list, a string, etc.) and nil. The function returns a list with the following information: - 0. parenthesis depth + 0. parenthesis depth 3. 'atm if END is inside an atom 'str if END is inside a string 'chr if END is in a character code expression (0'x) @@ -2517,7 +2545,7 @@ (setq endpos (point)) (setq oldp (point)))) ; Continue tokenizing (setq quoted 'atm))) - + ((looking-at "\"") ;; Find end of string (if (re-search-forward "[^\\]\"" end2 'limit) @@ -2539,7 +2567,7 @@ (setq depth (1- depth)) (if (and (or (eq stopcond 'zerodepth) - (and (eq stopcond 'skipover) + (and (eq stopcond 'skipover) (eq skiptype 'paren))) (= depth 0)) (progn @@ -2565,16 +2593,16 @@ ;; 0'char ((looking-at "0'") (setq oldp (1+ (match-end 0))) - (if (> oldp end) + (if (> oldp end) (setq quoted 'chr))) - + ;; base'number ((looking-at "[0-9]+'") (goto-char (match-end 0)) (skip-chars-forward "0-9a-zA-Z") (setq oldp (point))) - + ) (goto-char oldp) )) ; End of while @@ -2595,7 +2623,7 @@ (next-open (save-excursion (search-forward "/*" nil t))) (prev-open (save-excursion (search-backward "/*" nil t))) (prev-close (save-excursion (search-backward "*/" nil t))) - (unmatched-next-close (and next-close + (unmatched-next-close (and next-close (or (not next-open) (> next-open next-close)))) (unmatched-prev-open (and prev-open @@ -2631,18 +2659,15 @@ ;; Otherwise, ask for the predicate name and then call the function ;; in prolog-help-function-i (t - (let* (word - predicate - ;point - ) - (setq word (prolog-atom-under-point)) - (setq predicate (read-from-minibuffer + (let* ((word (prolog-atom-under-point)) + (predicate (read-string (format "Help on predicate%s: " (if word (concat " (default " word ")") - "")))) - (if (string= predicate "") - (setq predicate word)) + "")) + nil nil word)) + ;;point + ) (if prolog-help-function-i (funcall prolog-help-function-i predicate) (error "Sorry, no help method defined for this Prolog system.")))) @@ -2729,7 +2754,7 @@ (let ((pred (prolog-read-predicate))) (prolog-goto-predicate-info pred))) -(defvar prolog-info-alist nil +(defvar prolog-info-alist nil "Alist with all builtin predicates. Only for internal use by `prolog-find-documentation'") @@ -2745,14 +2770,13 @@ (string-match "\\(.*\\)/\\([0-9]+\\).*$" predicate) (let ((buffer (current-buffer)) (name (match-string 1 predicate)) - (arity (match-string 2 predicate)) + (arity (string-to-number (match-string 2 predicate))) ;oldp ;(str (regexp-quote predicate)) ) - (setq arity (string-to-number arity)) (pop-to-buffer nil) - (Info-goto-node + (Info-goto-node prolog-info-predicate-index) ;; We must be in the SICStus pages (Info-goto-node (car (cdr (assoc predicate prolog-info-alist)))) @@ -2766,25 +2790,23 @@ "Read a PredSpec from the user. Returned value is a string \"FUNCTOR/ARITY\". Interaction supports completion." - (let ((initial (prolog-atom-under-point)) - answer) - ;; If the predicate index is not yet built, do it now - (if (not prolog-info-alist) + (let ((default (prolog-atom-under-point))) + ;; If the predicate index is not yet built, do it now + (if (not prolog-info-alist) (prolog-build-info-alist)) - ;; Test if the initial string could be the base for completion. + ;; Test if the default string could be the base for completion. ;; Discard it if not. - (if (eq (try-completion initial prolog-info-alist) nil) - (setq initial "")) + (if (eq (try-completion default prolog-info-alist) nil) + (setq default nil)) ;; Read the PredSpec from the user - (setq answer (completing-read - "Help on predicate: " - prolog-info-alist nil t initial)) - (if (equal answer "") - initial - answer))) + (completing-read + (if (zerop (length default)) + "Help on predicate: " + (concat "Help on predicate (default " default "): ")) + prolog-info-alist nil t nil nil default))) (defun prolog-build-info-alist (&optional verbose) - "Build an alist of all builtins and library predicates. + "Build an alist of all builtins and library predicates. Each element is of the form (\"NAME/ARITY\" . (INFO-NODE1 INFO-NODE2 ...)). Typically there is just one Info node associated with each name If an optional argument VERBOSE is non-nil, print messages at the beginning @@ -2815,7 +2837,7 @@ info-node) (beginning-of-line) ;; Extract the info node name - (setq info-node (progn + (setq info-node (progn (re-search-forward ":[ \t]*\\([^:]+\\).$") (match-string 1) )) @@ -2848,18 +2870,18 @@ (setq i (1+ i))) str1)) -;(defun prolog-temporary-file () -; "Make temporary file name for compilation." -; (make-temp-name -; (concat -; (or -; (getenv "TMPDIR") -; (getenv "TEMP") -; (getenv "TMP") -; (getenv "SYSTEMP") -; "/tmp") -; "/prolcomp"))) -;(setq prolog-temp-filename (prolog-bsts (prolog-temporary-file))) +;;(defun prolog-temporary-file () +;; "Make temporary file name for compilation." +;; (make-temp-name +;; (concat +;; (or +;; (getenv "TMPDIR") +;; (getenv "TEMP") +;; (getenv "TMP") +;; (getenv "SYSTEMP") +;; "/tmp") +;; "/prolcomp"))) +;;(setq prolog-temp-filename (prolog-bsts (prolog-temporary-file))) (defun prolog-temporary-file () "Make temporary file name for compilation." @@ -2868,36 +2890,10 @@ (progn (write-region "" nil prolog-temporary-file-name nil 'silent) prolog-temporary-file-name) - ;; Actually create the file and set `prolog-temporary-file-name' accordingly - (let* ((umask (default-file-modes)) - (temporary-file-directory (or - (getenv "TMPDIR") - (getenv "TEMP") - (getenv "TMP") - (getenv "SYSTEMP") - "/tmp")) - (prefix (expand-file-name "prolcomp" temporary-file-directory)) - (suffix ".pl") - file) - (unwind-protect - (progn - ;; Create temp files with strict access rights. - (set-default-file-modes #o700) - (while (condition-case () - (progn - (setq file (concat (make-temp-name prefix) suffix)) - ;; (concat (make-temp-name "/tmp/prolcomp") ".pl") - (unless (file-exists-p file) - (write-region "" nil file nil 'silent)) - 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) - (setq prolog-temporary-file-name file)) - ;; Reset the umask. - (set-default-file-modes umask))) - )) + ;; Actually create the file and set `prolog-temporary-file-name' + ;; accordingly. + (setq prolog-temporary-file-name + (make-temp-file "prolcomp" nil ".pl")))) (defun prolog-goto-prolog-process-buffer () "Switch to the prolog process buffer and go to its end." @@ -2931,6 +2927,14 @@ ;; Avoid compile warnings by using eval (eval '(pltrace-off)))) +(defun prolog-toggle-sicstus-sd () + ;; FIXME: Use define-minor-mode. + "Toggle the source level debugging facilities of SICStus 3.7 and later." + (interactive) + (if prolog-use-sicstus-sd + (prolog-disable-sicstus-sd) + (prolog-enable-sicstus-sd))) + (defun prolog-debug-on (&optional arg) "Enable debugging. When called with prefix argument ARG, disable debugging instead." @@ -2985,7 +2989,7 @@ ;; (defun prolog-create-predicate-index () ;; "Create an index for all predicates in the buffer." ;; (let ((predlist '()) -;; clauseinfo +;; clauseinfo ;; object ;; pos ;; ) @@ -2997,15 +3001,15 @@ ;; (setq object (prolog-in-object)) ;; (setq predlist (append ;; predlist -;; (list (cons +;; (list (cons ;; (if (and (eq prolog-system 'sicstus) ;; (prolog-in-object)) -;; (format "%s::%s/%d" +;; (format "%s::%s/%d" ;; object -;; (nth 0 clauseinfo) +;; (nth 0 clauseinfo) ;; (nth 1 clauseinfo)) ;; (format "%s/%d" -;; (nth 0 clauseinfo) +;; (nth 0 clauseinfo) ;; (nth 1 clauseinfo))) ;; pos ;; )))) @@ -3020,12 +3024,12 @@ nil (if (and (eq prolog-system 'sicstus) object) - (format "%s::%s/%d" + (format "%s::%s/%d" object - (nth 0 state) + (nth 0 state) (nth 1 state)) (format "%s/%d" - (nth 0 state) + (nth 0 state) (nth 1 state))) )))) @@ -3050,14 +3054,14 @@ ;; Find first clause, unless it was a directive (if (and (not (looking-at "[:?]-")) (not (looking-at "[ \t]*[%/]")) ; Comment - + ) (let* ((pinfo (prolog-clause-info)) (predname (nth 0 pinfo)) (arity (nth 1 pinfo)) (op (point))) (while (and (re-search-backward - (format "^%s\\([(\\.]\\| *%s\\)" + (format "^%s\\([(\\.]\\| *%s\\)" predname prolog-head-delimiter) nil t) (= arity (nth 1 (prolog-clause-info))) ) @@ -3107,7 +3111,7 @@ ;; It was not a directive, find the last clause (while (and notdone (re-search-forward - (format "^%s\\([(\\.]\\| *%s\\)" + (format "^%s\\([(\\.]\\| *%s\\)" predname prolog-head-delimiter) nil t) (= arity (nth 1 (prolog-clause-info)))) (setq oldp (point)) @@ -3127,17 +3131,17 @@ (let ((notdone t) (retval (point-min))) (end-of-line) - + ;; SICStus object? (if (and (not not-allow-methods) (eq prolog-system 'sicstus) (prolog-in-object)) - (while (and - notdone + (while (and + notdone ;; Search for a head or a fact (re-search-backward ;; If in object, then find method start. - ;; "^[ \t]+[a-z$].*\\(:-\\|&\\|:: {\\|,\\)" + ;; "^[ \t]+[a-z$].*\\(:-\\|&\\|:: {\\|,\\)" "^[ \t]+[a-z$].*\\(:-\\|&\\|:: {\\)" ; The comma causes ; problems since we cannot assume ; that the line starts at column 0, @@ -3152,8 +3156,8 @@ ) ; End of while ;; Not in object - (while (and - notdone + (while (and + notdone ;; Search for a text at beginning of a line ;; ###### ;; (re-search-backward "^[a-z$']" nil t)) @@ -3172,7 +3176,7 @@ (setq notdone nil))) ((and (= bal 0) (looking-at - (format ".*\\(\\.\\|%s\\|!,\\)[ \t]*\\(%%.*\\|\\)$" + (format ".*\\(\\.\\|%s\\|!,\\)[ \t]*\\(%%.*\\|\\)$" prolog-head-delimiter))) ;; Start of clause found if the line ends with a '.' or ;; a prolog-head-delimiter @@ -3182,7 +3186,7 @@ ) (t nil) ; Do nothing )))) - + retval))) (defun prolog-clause-end (&optional not-allow-methods) @@ -3190,8 +3194,8 @@ If NOTALLOWMETHODS is non-nil then do not match on methods in objects (relevent only if 'prolog-system' is set to 'sicstus)." (save-excursion - (beginning-of-line) ; Necessary since we use "^...." for the search - (if (re-search-forward + (beginning-of-line) ; Necessary since we use "^...." for the search. + (if (re-search-forward (if (and (not not-allow-methods) (eq prolog-system 'sicstus) (prolog-in-object)) @@ -3212,43 +3216,43 @@ (defun prolog-clause-info () "Return a (name arity) list for the current clause." - (let (predname (arity 0)) - (save-excursion - (goto-char (prolog-clause-start)) - (let ((op (point))) - (if (looking-at prolog-atom-char-regexp) - (progn - (skip-chars-forward "^ (\\.") - (setq predname (buffer-substring op (point)))) - (setq predname "")) - ;; Retrieve the arity - (if (looking-at prolog-left-paren) - (let ((endp (save-excursion - (prolog-forward-list) (point)))) - (setq arity 1) - (forward-char 1) ; Skip the opening paren - (while (progn - (skip-chars-forward "^[({,'\"") - (< (point) endp)) - (if (looking-at ",") - (progn - (setq arity (1+ arity)) - (forward-char 1) ; Skip the comma - ) - ;; We found a string, list or something else we want - ;; to skip over. Always use prolog-tokenize, - ;; parse-partial-sexp does not have a 'skipover mode. - (goto-char (nth 5 (prolog-tokenize (point) endp 'skipover)))) - ))) - (list predname arity) - )))) + (save-excursion + (goto-char (prolog-clause-start)) + (let* ((op (point)) + (predname + (if (looking-at prolog-atom-char-regexp) + (progn + (skip-chars-forward "^ (\\.") + (buffer-substring op (point))) + "")) + (arity 0)) + ;; Retrieve the arity. + (if (looking-at prolog-left-paren) + (let ((endp (save-excursion + (prolog-forward-list) (point)))) + (setq arity 1) + (forward-char 1) ; Skip the opening paren. + (while (progn + (skip-chars-forward "^[({,'\"") + (< (point) endp)) + (if (looking-at ",") + (progn + (setq arity (1+ arity)) + (forward-char 1) ; Skip the comma. + ) + ;; We found a string, list or something else we want + ;; to skip over. Always use prolog-tokenize, + ;; parse-partial-sexp does not have a 'skipover mode. + (goto-char (nth 5 (prolog-tokenize (point) endp 'skipover)))) + ))) + (list predname arity)))) (defun prolog-in-object () "Return object name if the point is inside a SICStus object definition." ;; Return object name if the last line that starts with a character ;; that is neither white space nor a comment start (save-excursion - (if (save-excursion + (if (save-excursion (beginning-of-line) (looking-at "\\([^\n ]+\\)[ \t]*::[ \t]*{")) ;; We were in the head of the object @@ -3275,6 +3279,7 @@ (let ((bal 0) (paren-regexp (concat prolog-left-paren "\\|" prolog-right-paren)) (notdone t)) + ;; FIXME: Doesn't this incorrectly count 0'( and 0') ? (while (and notdone (re-search-backward paren-regexp nil t)) (cond ((looking-at prolog-left-paren) @@ -3426,10 +3431,10 @@ (beginning-of-line) (if (or (not nocreate) (and - (re-search-forward - (format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)%% *" + (re-search-forward + (format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)%% *" prolog-quoted-atom-regexp prolog-string-regexp) - (save-excursion (end-of-line) (point)) 'limit) + (line-end-position) 'limit) (progn (goto-char (match-beginning 0)) (not (eq (prolog-in-string-or-comment) 'txt))))) @@ -3459,9 +3464,8 @@ (defun prolog-mark-predicate () "Put mark at the end of this predicate and move point to the beginning." (interactive) - (let (pos) - (goto-char (prolog-pred-end)) - (setq pos (point)) + (goto-char (prolog-pred-end)) + (let ((pos (point))) (forward-line 1) (beginning-of-line) (set-mark (point)) @@ -3551,26 +3555,26 @@ arg (prolog-in-string-or-comment) ;; Do not be electric in a floating point number or an operator - (not + (not (or ;; (re-search-backward ;; ###### ;; "\\(^\\|[])}a-zA-Z_!'0-9]+\\)[ \t]*\\=" nil t))) - (save-excursion + (save-excursion (re-search-backward ;; "\\(^\\|[])}_!'0-9]+\\)[ \t]*\\=" nil t))) - "\\(^\\|[])}_!'0-9]+\\)[ \t]*\\=" + "\\(^\\|[])}_!'0-9]+\\)[ \t]*\\=" nil t)) - (save-excursion + (save-excursion (re-search-backward ;; "\\(^\\|[])}a-zA-Z]+\\)[ \t]*\\=" nil t))) - (format "\\(^\\|[])}%s]+\\)[ \t]*\\=" + (format "\\(^\\|[])}%s]+\\)[ \t]*\\=" prolog-lower-case-string) ;FIXME: [:lower:] nil t)) - (save-excursion + (save-excursion (re-search-backward ;; "\\(^\\|[])}a-zA-Z]+\\)[ \t]*\\=" nil t))) - (format "\\(^\\|[])}%s]+\\)[ \t]*\\=" + (format "\\(^\\|[])}%s]+\\)[ \t]*\\=" prolog-upper-case-string) ;FIXME: [:upper:] nil t)) ) @@ -3590,9 +3594,9 @@ (looking-at "[ \t]+$")) (prolog-insert-predicate-template) (when prolog-electric-dot-full-predicate-template - (save-excursion + (save-excursion (end-of-line) - (insert ".\n")))) + (insert ".\n")))) ;; Default (t (insert ".\n")) @@ -3607,22 +3611,21 @@ (interactive) (if prolog-electric-underscore-flag (let (;start - (oldcase case-fold-search) + (case-fold-search nil) (oldp (point))) - (setq case-fold-search nil) ;; ###### ;;(skip-chars-backward "a-zA-Z_") (skip-chars-backward (format "%s%s_" ;; FIXME: Why not "a-zA-Z"? - prolog-lower-case-string + prolog-lower-case-string prolog-upper-case-string)) ;(setq start (point)) (if (and (not (prolog-in-string-or-comment)) ;; ###### ;; (looking-at "\\<[_A-Z][a-zA-Z_0-9]*\\>")) - (looking-at (format "\\<[_%s][%s%s_0-9]*\\>" + (looking-at (format "\\<[_%s][%s%s_0-9]*\\>" ;; FIXME: Use [:upper:] and friends. prolog-upper-case-string prolog-lower-case-string @@ -3632,7 +3635,6 @@ (skip-chars-forward ", \t\n")) (goto-char oldp) (self-insert-command 1)) - (setq case-fold-search oldcase) ) (self-insert-command 1)) ) @@ -3648,7 +3650,7 @@ prefix)) (regexp (concat prefix functor)) (i 1)) - + ;; Build regexp for the search if the arity is > 0 (if (= arity 0) ;; Add that the functor must be at the end of a word. This @@ -3661,7 +3663,7 @@ (setq regexp (concat regexp ".+,")) (setq i (1+ i))) (setq regexp (concat regexp ".+)"))) - + ;; Search, and return position (if (re-search-forward regexp nil t) (goto-char (match-beginning 0)) @@ -3672,14 +3674,12 @@ "Replace all variables within a region BEG to END by anonymous variables." (interactive "r") (save-excursion - (let ((oldcase case-fold-search)) - (setq case-fold-search nil) + (let ((case-fold-search nil)) (goto-char end) (while (re-search-backward "\\<[A-Z_][a-zA-Z_0-9]*\\>" beg t) (progn (replace-match "_") (backward-char))) - (setq case-fold-search oldcase) ))) @@ -3687,13 +3687,13 @@ "Set the `prolog-atom-char-regexp' and `prolog-atom-regexp' variables. Must be called after `prolog-build-case-strings'." (setq prolog-atom-char-regexp - (format "[%s%s0-9_$]" + (format "[%s%s0-9_$]" ;; FIXME: why not a-zA-Z? - prolog-lower-case-string + prolog-lower-case-string prolog-upper-case-string)) (setq prolog-atom-regexp - (format "[%s$]%s*" - prolog-lower-case-string + (format "[%s$]%s*" + prolog-lower-case-string prolog-atom-char-regexp)) ) @@ -3705,15 +3705,15 @@ ;; Use `map-char-table' if it is defined. Otherwise enumerate all ;; numbers between 0 and 255. `map-char-table' is probably safer. ;; - ;; `map-char-table' causes problems under Emacs 23.0.0.1, the + ;; `map-char-table' causes problems under Emacs 23.0.0.1, the ;; while loop seems to do its job well (Ryszard Szopa) - ;; + ;; ;;(if (and (not (featurep 'xemacs)) ;; (fboundp 'map-char-table)) ;; (map-char-table ;; (lambda (key value) - ;; (cond - ;; ((and + ;; (cond + ;; ((and ;; (eq (prolog-int-to-char key) (downcase key)) ;; (eq (prolog-int-to-char key) (upcase key))) ;; ;; Do nothing if upper and lower case are the same @@ -3729,8 +3729,8 @@ ;; `map-char-table' was undefined. (let ((key 0)) (while (< key 256) - (cond - ((and + (cond + ((and (eq (prolog-int-to-char key) (downcase key)) (eq (prolog-int-to-char key) (upcase key))) ;; Do nothing if upper and lower case are the same @@ -3767,7 +3767,7 @@ ; (setq end (+ end 1))) ; (if (equal (substring chars end) "") ; (substring chars 0 beg) -; (concat (substring chars 0 beg) "-" +; (concat (substring chars 0 beg) "-" ; (prolog-regexp-dash-continuous-chars (substring chars end)))) ; ))) @@ -3830,211 +3830,184 @@ "Non-nil iff the mark is set. Lobotomized version for Emacsen that do not provide their own." (mark))) + +;; GNU Emacs ignores `easy-menu-add' so the order in which the menus +;; are defined _is_ important! + +(easy-menu-define + prolog-menu-help (list prolog-mode-map prolog-inferior-mode-map) + "Help menu for the Prolog mode." + ;; FIXME: Does it really deserve a whole menu to itself? + `(,(if (featurep 'xemacs) "Help" + ;; Not sure it's worth the trouble. --Stef + ;; (add-to-list 'menu-bar-final-items + ;; (easy-menu-intern "Prolog-Help")) + "Prolog-help") + ["On predicate" prolog-help-on-predicate prolog-help-function-i] + ["Apropos" prolog-help-apropos (eq prolog-system 'swi)] + "---" + ["Describe mode" describe-mode t])) + +(easy-menu-define + prolog-edit-menu-runtime prolog-mode-map + "Runtime Prolog commands available from the editing buffer" + ;; FIXME: Don't use a whole menu for just "Run Mercury". --Stef + `("System" + ;; Runtime menu name. + ,@(unless (featurep 'xemacs) + '(:label (cond ((eq prolog-system 'eclipse) "ECLiPSe") + ((eq prolog-system 'mercury) "Mercury") + (t "System")))) + + ;; Consult items, NIL for mercury. + ["Consult file" prolog-consult-file + :included (not (eq prolog-system 'mercury))] + ["Consult buffer" prolog-consult-buffer + :included (not (eq prolog-system 'mercury))] + ["Consult region" prolog-consult-region :active (region-exists-p) + :included (not (eq prolog-system 'mercury))] + ["Consult predicate" prolog-consult-predicate + :included (not (eq prolog-system 'mercury))] + + ;; Compile items, NIL for everything but SICSTUS. + ,(if (featurep 'xemacs) "---" + ["---" nil :included (eq prolog-system 'sicstus)]) + ["Compile file" prolog-compile-file + :included (eq prolog-system 'sicstus)] + ["Compile buffer" prolog-compile-buffer + :included (eq prolog-system 'sicstus)] + ["Compile region" prolog-compile-region :active (region-exists-p) + :included (eq prolog-system 'sicstus)] + ["Compile predicate" prolog-compile-predicate + :included (eq prolog-system 'sicstus)] + + ;; Debug items, NIL for Mercury. + ,(if (featurep 'xemacs) "---" + ["---" nil :included (not (eq prolog-system 'mercury))]) + ;; FIXME: Could we use toggle or radio buttons? --Stef + ["Debug" prolog-debug-on :included (not (eq prolog-system 'mercury))] + ["Debug off" prolog-debug-off + ;; In SICStus, these are pairwise disjunctive, + ;; so it's enough with a single "off"-command + :included (not (memq prolog-system '(mercury sicstus)))] + ["Trace" prolog-trace-on :included (not (eq prolog-system 'mercury))] + ["Trace off" prolog-trace-off + :included (not (memq prolog-system '(mercury sicstus)))] + ["Zip" prolog-zip-on :included (and (eq prolog-system 'sicstus) + (prolog-atleast-version '(3 . 7)))] + ["All debug off" prolog-debug-off + :included (eq prolog-system 'sicstus)] + ["Source level debugging" + prolog-toggle-sicstus-sd + :included (and (eq prolog-system 'sicstus) + (prolog-atleast-version '(3 . 7))) + :style toggle + :selected prolog-use-sicstus-sd] + + "---" + ["Run" run-prolog + :suffix (cond ((eq prolog-system 'eclipse) "ECLiPSe") + ((eq prolog-system 'mercury) "Mercury") + (t "Prolog"))])) + +(easy-menu-define + prolog-edit-menu-insert-move prolog-mode-map + "Commands for Prolog code manipulation." + '("Prolog" + ["Comment region" comment-region (region-exists-p)] + ["Uncomment region" prolog-uncomment-region (region-exists-p)] + ["Add comment/move to comment" indent-for-comment t] + ["Convert variables in region to '_'" prolog-variables-to-anonymous + :active (region-exists-p) :included (not (eq prolog-system 'mercury))] + "---" + ["Insert predicate template" prolog-insert-predicate-template t] + ["Insert next clause head" prolog-insert-next-clause t] + ["Insert predicate spec" prolog-insert-predspec t] + ["Insert module modeline" prolog-insert-module-modeline t] + "---" + ["Beginning of clause" prolog-beginning-of-clause t] + ["End of clause" prolog-end-of-clause t] + ["Beginning of predicate" prolog-beginning-of-predicate t] + ["End of predicate" prolog-end-of-predicate t] + "---" + ["Indent line" prolog-indent-line t] + ["Indent region" indent-region (region-exists-p)] + ["Indent predicate" prolog-indent-predicate t] + ["Indent buffer" prolog-indent-buffer t] + ["Align region" align (region-exists-p)] + "---" + ["Mark clause" prolog-mark-clause t] + ["Mark predicate" prolog-mark-predicate t] + ["Mark paragraph" mark-paragraph t] + ;;"---" + ;;["Fontify buffer" font-lock-fontify-buffer t] + )) + (defun prolog-menu () - "Create the menus for the Prolog editing buffers. -These menus are dynamically created because one may change systems -during the life of an Emacs session, and because GNU Emacs wants them -so by ignoring `easy-menu-add'." - - ;; GNU Emacs ignores `easy-menu-add' so the order in which the menus - ;; are defined _is_ important! - - (easy-menu-define - prolog-edit-menu-help (current-local-map) - "Help menu for the Prolog mode." - (append - (if (featurep 'xemacs) '("Help") '("Prolog-help")) - (cond - ((eq prolog-system 'sicstus) - '(["On predicate" prolog-help-on-predicate t] - "---")) - ((eq prolog-system 'swi) - '(["On predicate" prolog-help-on-predicate t] - ["Apropos" prolog-help-apropos t] - "---"))) - '(["Describe mode" describe-mode t]))) - - (easy-menu-define - prolog-edit-menu-runtime (current-local-map) - "Runtime Prolog commands available from the editing buffer" - (append - ;; runtime menu name - (list (cond ((eq prolog-system 'eclipse) - "ECLiPSe") - ((eq prolog-system 'mercury) - "Mercury") - (t - "Prolog"))) - ;; consult items, NIL for mercury - (unless (eq prolog-system 'mercury) - '("---" - ["Consult file" prolog-consult-file t] - ["Consult buffer" prolog-consult-buffer t] - ["Consult region" prolog-consult-region (region-exists-p)] - ["Consult predicate" prolog-consult-predicate t] - )) - ;; compile items, NIL for everything but SICSTUS - (when (eq prolog-system 'sicstus) - '("---" - ["Compile file" prolog-compile-file t] - ["Compile buffer" prolog-compile-buffer t] - ["Compile region" prolog-compile-region (region-exists-p)] - ["Compile predicate" prolog-compile-predicate t] - )) - ;; debug items, NIL for mercury - (cond - ((eq prolog-system 'sicstus) - ;; In SICStus, these are pairwise disjunctive, - ;; so it's enough with one "off"-command - (if (prolog-atleast-version '(3 . 7)) - (list "---" - ["Debug" prolog-debug-on t] - ["Trace" prolog-trace-on t] - ["Zip" prolog-zip-on t] - ["All debug off" prolog-debug-off t] - '("Source level debugging" - ["Enable" prolog-enable-sicstus-sd t] - ["Disable" prolog-disable-sicstus-sd t])) - (list "---" - ["Debug" prolog-debug-on t] - ["Trace" prolog-trace-on t] - ["All debug off" prolog-debug-off t]))) - ((not (eq prolog-system 'mercury)) - '("---" - ["Debug" prolog-debug-on t] - ["Debug off" prolog-debug-off t] - ["Trace" prolog-trace-on t] - ["Trace off" prolog-trace-off t])) - ;; default (mercury) nil - ) - (list "---" - (if (featurep 'xemacs) - [(concat "Run " (cond ((eq prolog-system 'eclipse) "ECLiPSe") - ((eq prolog-system 'mercury) "Mercury") - (t "Prolog"))) - run-prolog t] - ["Run Prolog" run-prolog t])))) - - (easy-menu-define - prolog-edit-menu-insert-move (current-local-map) - "Commands for Prolog code manipulation." - (append - (list "Code" - ["Comment region" comment-region (region-exists-p)] - ["Uncomment region" prolog-uncomment-region (region-exists-p)] - ["Add comment/move to comment" indent-for-comment t]) - (unless (eq prolog-system 'mercury) - (list ["Convert variables in region to '_'" prolog-variables-to-anonymous (region-exists-p)])) - (list "---" - ["Insert predicate template" prolog-insert-predicate-template t] - ["Insert next clause head" prolog-insert-next-clause t] - ["Insert predicate spec" prolog-insert-predspec t] - ["Insert module modeline" prolog-insert-module-modeline t] - "---" - ["Beginning of clause" prolog-beginning-of-clause t] - ["End of clause" prolog-end-of-clause t] - ["Beginning of predicate" prolog-beginning-of-predicate t] - ["End of predicate" prolog-end-of-predicate t] - "---" - ["Indent line" prolog-indent-line t] - ["Indent region" indent-region (region-exists-p)] - ["Indent predicate" prolog-indent-predicate t] - ["Indent buffer" prolog-indent-buffer t] - ["Align region" align (region-exists-p)] - "---" - ["Mark clause" prolog-mark-clause t] - ["Mark predicate" prolog-mark-predicate t] - ["Mark paragraph" mark-paragraph t] - ;"---" - ;["Fontify buffer" font-lock-fontify-buffer t] - ))) + "Add the menus for the Prolog editing buffers." (easy-menu-add prolog-edit-menu-insert-move) (easy-menu-add prolog-edit-menu-runtime) ;; Add predicate index menu - ;(make-variable-buffer-local 'imenu-create-index-function) - (make-local-variable 'imenu-create-index-function) - (setq imenu-create-index-function 'imenu-default-create-index-function) + (set (make-local-variable 'imenu-create-index-function) + 'imenu-default-create-index-function) ;;Milan (this has problems with object methods...) ###### Does it? (Stefan) (setq imenu-prev-index-position-function 'prolog-beginning-of-predicate) (setq imenu-extract-index-name-function 'prolog-get-predspec) - + (if (and prolog-imenu-flag (< (count-lines (point-min) (point-max)) prolog-imenu-max-lines)) (imenu-add-to-menubar "Predicates")) - - (easy-menu-add prolog-edit-menu-help)) + + (easy-menu-add prolog-menu-help)) + +(easy-menu-define + prolog-inferior-menu-all prolog-inferior-mode-map + "Menu for the inferior Prolog buffer." + `("Prolog" + ;; Runtime menu name. + ,@(unless (featurep 'xemacs) + '(:label (cond ((eq prolog-system 'eclipse) "ECLiPSe") + ((eq prolog-system 'mercury) "Mercury") + (t "Prolog")))) + + ;; Debug items, NIL for Mercury. + ,(if (featurep 'xemacs) "---" + ["---" nil :included (not (eq prolog-system 'mercury))]) + ;; FIXME: Could we use toggle or radio buttons? --Stef + ["Debug" prolog-debug-on :included (not (eq prolog-system 'mercury))] + ["Debug off" prolog-debug-off + ;; In SICStus, these are pairwise disjunctive, + ;; so it's enough with a single "off"-command + :included (not (memq prolog-system '(mercury sicstus)))] + ["Trace" prolog-trace-on :included (not (eq prolog-system 'mercury))] + ["Trace off" prolog-trace-off + :included (not (memq prolog-system '(mercury sicstus)))] + ["Zip" prolog-zip-on :included (and (eq prolog-system 'sicstus) + (prolog-atleast-version '(3 . 7)))] + ["All debug off" prolog-debug-off + :included (eq prolog-system 'sicstus)] + ["Source level debugging" + prolog-toggle-sicstus-sd + :included (and (eq prolog-system 'sicstus) + (prolog-atleast-version '(3 . 7))) + :style toggle + :selected prolog-use-sicstus-sd] + + ;; Runtime. + "---" + ["Interrupt Prolog" comint-interrupt-subjob t] + ["Quit Prolog" comint-quit-subjob t] + ["Kill Prolog" comint-kill-subjob t])) + (defun prolog-inferior-menu () "Create the menus for the Prolog inferior buffer. This menu is dynamically created because one may change systems during the life of an Emacs session." - - (easy-menu-define - prolog-inferior-menu-help (current-local-map) - "Help menu for the Prolog inferior mode." - (append - (if (featurep 'xemacs) '("Help") '("Prolog-help")) - (cond - ((eq prolog-system 'sicstus) - '(["On predicate" prolog-help-on-predicate t] - "---")) - ((eq prolog-system 'swi) - '(["On predicate" prolog-help-on-predicate t] - ["Apropos" prolog-help-apropos t] - "---"))) - '(["Describe mode" describe-mode t]))) - - (easy-menu-define - prolog-inferior-menu-all (current-local-map) - "Menu for the inferior Prolog buffer." - (append - ;; menu name - (list (cond ((eq prolog-system 'eclipse) - "ECLiPSe") - ((eq prolog-system 'mercury) - "Mercury") - (t - "Prolog"))) - ;; debug items, NIL for mercury - (cond - ((eq prolog-system 'sicstus) - ;; In SICStus, these are pairwise disjunctive, - ;; so it's enough with one "off"-command - (if (prolog-atleast-version '(3 . 7)) - (list "---" - ["Debug" prolog-debug-on t] - ["Trace" prolog-trace-on t] - ["Zip" prolog-zip-on t] - ["All debug off" prolog-debug-off t] - '("Source level debugging" - ["Enable" prolog-enable-sicstus-sd t] - ["Disable" prolog-disable-sicstus-sd t])) - (list "---" - ["Debug" prolog-debug-on t] - ["Trace" prolog-trace-on t] - ["All debug off" prolog-debug-off t]))) - ((not (eq prolog-system 'mercury)) - '("---" - ["Debug" prolog-debug-on t] - ["Debug off" prolog-debug-off t] - ["Trace" prolog-trace-on t] - ["Trace off" prolog-trace-off t])) - ;; default (mercury) nil - ) - ;; runtime - '("---" - ["Interrupt Prolog" comint-interrupt-subjob t] - ["Quit Prolog" comint-quit-subjob t] - ["Kill Prolog" comint-kill-subjob t]) - )) - (easy-menu-add prolog-inferior-menu-all) - (easy-menu-add prolog-inferior-menu-help)) - -(add-hook 'prolog-mode-hook 'prolog-menu) ;FIXME. -(add-hook 'prolog-inferior-mode-hook 'prolog-inferior-menu) ;FIXME. + (easy-menu-add prolog-menu-help)) (defun prolog-mode-version () "Echo the current version of Prolog mode in the minibuffer." ------------------------------------------------------------ revno: 102835 committer: Tassilo Horn branch nick: trunk timestamp: Thu 2011-01-13 21:17:15 +0100 message: (doc-view-initiate-display): Fall back to normal mode when doc-view-mode cannot be enabled, also when extracting the document text into a separate buffer (bug#6446). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-13 19:48:26 +0000 +++ lisp/ChangeLog 2011-01-13 20:17:15 +0000 @@ -3,6 +3,9 @@ * doc-view.el (doc-view-open-text): Use meaningful text buffer name. Keep original document's directory as default-directory (bug#6446). + (doc-view-initiate-display): Fall back to normal mode when + doc-view-mode cannot be enabled, also when extracting the document + text into a separate buffer (bug#6446). * simple.el (shell-command): Don't error out if shell command buffer contains text with non-nil read-only property when erasing === modified file 'lisp/doc-view.el' --- lisp/doc-view.el 2011-01-13 19:48:26 +0000 +++ lisp/doc-view.el 2011-01-13 20:17:15 +0000 @@ -1243,11 +1243,11 @@ (concat "No PNG support is available, or some conversion utility for " (file-name-extension doc-view-buffer-file-name) " files is missing.")) - (if (and (executable-find doc-view-pdftotext-program) - (y-or-n-p - "Unable to render file. View extracted text instead? ")) - (doc-view-open-text) - (doc-view-toggle-display)))) + (when (and (executable-find doc-view-pdftotext-program) + (y-or-n-p + "Unable to render file. View extracted text instead? ")) + (doc-view-open-text)) + (doc-view-toggle-display))) (defvar bookmark-make-record-function) ------------------------------------------------------------ revno: 102834 committer: Tassilo Horn branch nick: trunk timestamp: Thu 2011-01-13 20:48:26 +0100 message: * doc-view.el (doc-view-open-text): Use meaningful text buffer name. Keep original document's directory as default-directory (bug#6446). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-13 18:58:28 +0000 +++ lisp/ChangeLog 2011-01-13 19:48:26 +0000 @@ -1,5 +1,9 @@ 2011-01-13 Tassilo Horn + * doc-view.el (doc-view-open-text): Use meaningful text buffer + name. Keep original document's directory as default-directory + (bug#6446). + * simple.el (shell-command): Don't error out if shell command buffer contains text with non-nil read-only property when erasing the buffer. === modified file 'lisp/doc-view.el' --- lisp/doc-view.el 2011-01-08 22:57:07 +0000 +++ lisp/doc-view.el 2011-01-13 19:48:26 +0000 @@ -1061,7 +1061,12 @@ (message "DocView: please wait till conversion finished.") (let ((txt (expand-file-name "doc.txt" (doc-view-current-cache-dir)))) (if (file-readable-p txt) - (find-file txt) + (let ((name (concat "Text contents of " + (file-name-nondirectory buffer-file-name))) + (dir (file-name-directory buffer-file-name))) + (with-current-buffer (find-file txt) + (rename-buffer name) + (setq default-directory dir))) (doc-view-doc->txt txt 'doc-view-open-text))))) ;;;;; Toggle between editing and viewing ------------------------------------------------------------ revno: 102833 committer: Tassilo Horn branch nick: trunk timestamp: Thu 2011-01-13 19:58:28 +0100 message: * simple.el (shell-command): Don't error out if shell command buffer contains text with non-nil read-only property when erasing the buffer. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-13 16:26:40 +0000 +++ lisp/ChangeLog 2011-01-13 18:58:28 +0000 @@ -1,3 +1,9 @@ +2011-01-13 Tassilo Horn + + * simple.el (shell-command): Don't error out if shell command + buffer contains text with non-nil read-only property when erasing + the buffer. + 2011-01-13 Kim F. Storm * ido.el (ido-may-cache-directory): Move "too-big" check later. === modified file 'lisp/simple.el' --- lisp/simple.el 2011-01-13 04:23:41 +0000 +++ lisp/simple.el 2011-01-13 18:58:28 +0000 @@ -2341,7 +2341,11 @@ (error "Shell command in progress"))) (with-current-buffer buffer (setq buffer-read-only nil) - (erase-buffer) + ;; Setting buffer-read-only to nil doesn't suffice + ;; if some text has a non-nil read-only property, + ;; which comint sometimes adds for prompts. + (let ((inhibit-read-only t)) + (erase-buffer)) (display-buffer buffer) (setq default-directory directory) (setq proc (start-process "Shell" buffer shell-file-name ------------------------------------------------------------ revno: 102832 committer: Kim F. Storm branch nick: trunk timestamp: Thu 2011-01-13 17:26:40 +0100 message: * ido.el (ido-may-cache-directory): Move "too-big" check later. (ido-next-match, ido-prev-match): Fix stray reordering of matching items when cycling through the matches. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-13 15:44:41 +0000 +++ lisp/ChangeLog 2011-01-13 16:26:40 +0000 @@ -1,3 +1,9 @@ +2011-01-13 Kim F. Storm + + * ido.el (ido-may-cache-directory): Move "too-big" check later. + (ido-next-match, ido-prev-match): Fix stray reordering of matching + items when cycling through the matches. + 2011-01-13 Tassilo Horn * dired-x.el (dired-omit-verbose): New defcustom that allows === modified file 'lisp/ido.el' --- lisp/ido.el 2010-12-17 10:56:03 +0000 +++ lisp/ido.el 2011-01-13 16:26:40 +0000 @@ -1289,8 +1289,6 @@ (defun ido-may-cache-directory (&optional dir) (setq dir (or dir ido-current-directory)) (cond - ((ido-directory-too-big-p dir) - nil) ((and (ido-is-root-directory dir) (or ido-enable-tramp-completion (memq system-type '(windows-nt ms-dos)))) @@ -1299,6 +1297,8 @@ (ido-cache-unc-valid)) ((ido-is-ftp-directory dir) (ido-cache-ftp-valid)) + ((ido-directory-too-big-p dir) + nil) (t t))) (defun ido-pp (list &optional sep) @@ -3072,8 +3072,8 @@ (if ido-matches (let ((next (cadr ido-matches))) (setq ido-cur-list (ido-chop ido-cur-list next)) - (setq ido-rescan t) - (setq ido-rotate t)))) + (setq ido-matches (ido-chop ido-matches next)) + (setq ido-rescan nil)))) (defun ido-prev-match () "Put last element of `ido-matches' at the front of the list." @@ -3081,8 +3081,8 @@ (if ido-matches (let ((prev (car (last ido-matches)))) (setq ido-cur-list (ido-chop ido-cur-list prev)) - (setq ido-rescan t) - (setq ido-rotate t)))) + (setq ido-matches (ido-chop ido-matches prev)) + (setq ido-rescan nil)))) (defun ido-next-match-dir () "Find next directory in match list. ------------------------------------------------------------ revno: 102831 committer: Tassilo Horn branch nick: trunk timestamp: Thu 2011-01-13 16:44:41 +0100 message: * dired-x.el (dired-omit-verbose): New defcustom that allows disabling the omit messages. (dired-omit-expunge): Use it. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-13 08:08:58 +0000 +++ lisp/ChangeLog 2011-01-13 15:44:41 +0000 @@ -1,3 +1,9 @@ +2011-01-13 Tassilo Horn + + * dired-x.el (dired-omit-verbose): New defcustom that allows + disabling the omit messages. + (dired-omit-expunge): Use it. + 2011-01-13 Christian Ohler * emacs-lisp/ert.el, emacs-lisp/ert-x.el: New files. === modified file 'lisp/dired-x.el' --- lisp/dired-x.el 2010-08-29 16:17:13 +0000 +++ lisp/dired-x.el 2011-01-13 15:44:41 +0000 @@ -189,6 +189,12 @@ :type 'regexp :group 'dired-x) +(defcustom dired-omit-verbose t + "When non-nil, show messages when omitting files. +When nil, don't show messages." + :type 'boolean + :group 'dired-x) + (defcustom dired-find-subdir nil ; t is pretty near to DWIM... "If non-nil, Dired always finds a directory in a buffer of its own. If nil, Dired finds the directory as a subdirectory in some other buffer @@ -613,8 +619,9 @@ (not dired-omit-size-limit) (< (buffer-size) dired-omit-size-limit) (progn - (message "Not omitting: directory larger than %d characters." - dired-omit-size-limit) + (when dired-omit-verbose + (message "Not omitting: directory larger than %d characters." + dired-omit-size-limit)) (setq dired-omit-mode nil) nil))) (let ((omit-re (or regexp (dired-omit-regexp))) @@ -622,12 +629,14 @@ count) (or (string= omit-re "") (let ((dired-marker-char dired-omit-marker-char)) - (message "Omitting...") + (when dired-omit-verbose (message "Omitting...")) (if (dired-mark-unmarked-files omit-re nil nil dired-omit-localp) (progn - (setq count (dired-do-kill-lines nil "Omitted %d line%s.")) + (setq count (dired-do-kill-lines + nil + (if dired-omit-verbose "Omitted %d line%s." ""))) (force-mode-line-update)) - (message "(Nothing to omit)")))) + (when dired-omit-verbose (message "(Nothing to omit)"))))) ;; Try to preserve modified state of buffer. So `%*' doesn't appear ;; in mode-line of omitted buffers. (set-buffer-modified-p (and old-modified-p ------------------------------------------------------------ revno: 102830 [merge] committer: Christian Ohler branch nick: trunk timestamp: Thu 2011-01-13 22:12:10 +1100 message: Add ERT, a tool for automated testing in Emacs Lisp. * Makefile.in, configure.in, doc/misc/Makefile.in, doc/misc/makefile.w32-in: Add ERT. Make "make check" run tests in test/automated. * doc/misc/ert.texi, lisp/emacs-lisp/ert.el, lisp/emacs-lisp/ert-x.el: New files. * test/automated: New directory. diff: === modified file 'ChangeLog' --- ChangeLog 2011-01-07 20:42:11 +0000 +++ ChangeLog 2011-01-12 16:08:24 +0000 @@ -1,3 +1,12 @@ +2011-01-13 Christian Ohler + + * Makefile.in (INFO_FILES): Add ERT. + + * Makefile.in (check): Run tests in test/automated. + + * Makefile.in: + * configure.in: Add test/automated/Makefile. + 2011-01-07 Paul Eggert * install-sh, mkinstalldirs, move-if-change: Update from master === modified file 'Makefile.in' --- Makefile.in 2011-01-05 07:10:47 +0000 +++ Makefile.in 2011-01-12 16:08:24 +0000 @@ -134,7 +134,7 @@ infodir=@infodir@ INFO_FILES=ada-mode auth autotype calc ccmode cl dbus dired-x ebrowse \ ede ediff edt eieio efaq eintr elisp emacs emacs-mime epa erc \ - eshell eudc flymake forms gnus idlwave info mairix-el \ + ert eshell eudc flymake forms gnus idlwave info mairix-el \ message mh-e newsticker nxml-mode org pcl-cvs pgg rcirc \ reftex remember sasl sc semantic ses sieve smtpmail speedbar \ tramp url vip viper widget woman @@ -267,7 +267,7 @@ SUBDIR = lib-src src lisp # The subdir makefiles created by config.status. -SUBDIR_MAKEFILES = lib-src/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispref/Makefile doc/lispintro/Makefile src/Makefile oldXMenu/Makefile lwlib/Makefile leim/Makefile lisp/Makefile +SUBDIR_MAKEFILES = lib-src/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispref/Makefile doc/lispintro/Makefile src/Makefile oldXMenu/Makefile lwlib/Makefile leim/Makefile lisp/Makefile test/automated/Makefile # Subdirectories to install, and where they'll go. # lib-src's makefile knows how to install it, so we don't do that here. @@ -368,7 +368,8 @@ $(srcdir)/oldXMenu/Makefile.in \ $(srcdir)/lwlib/Makefile.in \ $(srcdir)/leim/Makefile.in \ - $(srcdir)/lisp/Makefile.in + $(srcdir)/lisp/Makefile.in \ + $(srcdir)/test/automated/Makefile.in ./config.status config.status: ${srcdir}/configure ${srcdir}/lisp/version.el @@ -810,7 +811,7 @@ cd src; $(MAKE) tags check: - @echo "We don't have any tests for GNU Emacs yet." + cd test/automated; $(MAKE) check dist: cd ${srcdir}; ./make-dist === modified file 'configure' --- configure 2011-01-05 13:09:07 +0000 +++ configure 2011-01-12 16:22:13 +0000 @@ -11442,6 +11442,8 @@ # ifdef _MSC_VER # include # define alloca _alloca +# elif defined(__NetBSD__) || defined(__FreeBSD__) || defined(__DragonFly__) || defined(__OpenBSD__) +# include # else # ifdef HAVE_ALLOCA_H # include @@ -15039,7 +15041,7 @@ test "${exec_prefix}" != NONE && exec_prefix=`echo "${exec_prefix}" | sed 's,\([^/]\)/*$,\1,'` -ac_config_files="$ac_config_files Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile" +ac_config_files="$ac_config_files Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile test/automated/Makefile" ac_config_commands="$ac_config_commands default" @@ -15767,6 +15769,7 @@ "lwlib/Makefile") CONFIG_FILES="$CONFIG_FILES lwlib/Makefile" ;; "lisp/Makefile") CONFIG_FILES="$CONFIG_FILES lisp/Makefile" ;; "leim/Makefile") CONFIG_FILES="$CONFIG_FILES leim/Makefile" ;; + "test/automated/Makefile") CONFIG_FILES="$CONFIG_FILES test/automated/Makefile" ;; "default") CONFIG_COMMANDS="$CONFIG_COMMANDS default" ;; *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; === modified file 'configure.in' --- configure.in 2011-01-05 13:09:07 +0000 +++ configure.in 2011-01-12 16:08:24 +0000 @@ -3750,7 +3750,7 @@ AC_OUTPUT(Makefile lib-src/Makefile oldXMenu/Makefile \ doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile \ doc/lispref/Makefile src/Makefile \ - lwlib/Makefile lisp/Makefile leim/Makefile, [ + lwlib/Makefile lisp/Makefile leim/Makefile test/automated/Makefile, [ ### Make the necessary directories, if they don't exist. for dir in etc lisp ; do === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2011-01-10 09:35:44 +0000 +++ doc/misc/ChangeLog 2011-01-12 16:08:24 +0000 @@ -1,3 +1,10 @@ +2011-01-13 Christian Ohler + + * ert.texi: New file. + + * Makefile.in: + * makefile.w32-in: Add ert.texi. + 2011-01-10 Jan Moringen * dbus.texi (Receiving Method Calls): New function === modified file 'doc/misc/Makefile.in' --- doc/misc/Makefile.in 2010-10-28 07:21:43 +0000 +++ doc/misc/Makefile.in 2011-01-12 16:08:24 +0000 @@ -62,6 +62,7 @@ $(infodir)/emacs-mime \ $(infodir)/epa \ $(infodir)/erc \ + $(infodir)/ert \ $(infodir)/eshell \ $(infodir)/eudc \ $(infodir)/efaq \ @@ -112,6 +113,7 @@ emacs-mime.dvi \ epa.dvi \ erc.dvi \ + ert.dvi \ eshell.dvi \ eudc.dvi \ faq.dvi \ @@ -162,6 +164,7 @@ emacs-mime.pdf \ epa.pdf \ erc.pdf \ + ert.pdf \ eshell.pdf \ eudc.pdf \ faq.pdf \ @@ -360,6 +363,14 @@ erc.pdf: ${srcdir}/erc.texi $(ENVADD) $(TEXI2PDF) $< +ert : $(infodir)/ert +$(infodir)/ert: ert.texi $(infodir) + cd $(srcdir); $(MAKEINFO) ert.texi +ert.dvi: ert.texi + $(ENVADD) $(TEXI2DVI) ${srcdir}/ert.texi +ert.pdf: ert.texi + $(ENVADD) $(TEXI2PDF) ${srcdir}/ert.texi + eshell : $(infodir)/eshell $(infodir)/eshell: eshell.texi $(mkinfodir) === added file 'doc/misc/ert.texi' --- doc/misc/ert.texi 1970-01-01 00:00:00 +0000 +++ doc/misc/ert.texi 2011-01-12 16:08:24 +0000 @@ -0,0 +1,830 @@ +\input texinfo +@c %**start of header +@setfilename ../../info/ert +@settitle Emacs Lisp Regression Testing +@c %**end of header + +@dircategory Emacs +@direntry +* ERT: (ert). Emacs Lisp Regression Testing. +@end direntry + +@copying +Copyright @copyright{} 2008, 2010, 2011 Free Software Foundation, Inc. + +@quotation +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.2 or +any later version published by the Free Software Foundation; with no +Invariant Sections, with no Front-Cover Texts, and with no Back-Cover +Texts. +@end quotation +@end copying + +@node Top, Introduction, (dir), (dir) +@top ERT: Emacs Lisp Regression Testing + +ERT is a tool for automated testing in Emacs Lisp. Its main features +are facilities for defining tests, running them and reporting the +results, and for debugging test failures interactively. + +ERT is similar to tools for other environments such as JUnit, but has +unique features that take advantage of the dynamic and interactive +nature of Emacs. Despite its name, it works well both for test-driven +development (see +@url{http://en.wikipedia.org/wiki/Test-driven_development}) and for +traditional software development methods. + +@menu +* Introduction:: A simple example of an ERT test. +* How to Run Tests:: Run tests in your Emacs or from the command line. +* How to Write Tests:: How to add tests to your Emacs Lisp code. +* How to Debug Tests:: What to do if a test fails. +* Extending ERT:: ERT is extensible in several ways. +* Other Testing Concepts:: Features not in ERT. + +@detailmenu + --- The Detailed Node Listing --- + +How to Run Tests + +* Running Tests Interactively:: Run tests in your current Emacs. +* Running Tests in Batch Mode:: Run tests in emacs -Q. +* Test Selectors:: Choose which tests to run. + +How to Write Tests + +* The @code{should} Macro:: A powerful way to express assertions. +* Expected Failures:: Tests for known bugs. +* Tests and Their Environment:: Don't depend on customizations; no side effects. +* Useful Techniques:: Some examples. + +How to Debug Tests + +* Understanding Explanations:: How ERT gives details on why an assertion failed. +* Interactive Debugging:: Tools available in the ERT results buffer. + +Extending ERT + +* Defining Explanation Functions:: Teach ERT about more predicates. +* Low-Level Functions for Working with Tests:: Use ERT's data for your purposes. + +Other Testing Concepts + +* Mocks and Stubs:: Stubbing out code that is irrelevant to the test. +* Fixtures and Test Suites:: How ERT differs from tools for other languages. + +@end detailmenu +@end menu + +@node Introduction, How to Run Tests, Top, Top +@chapter Introduction + +ERT allows you to define @emph{tests} in addition to functions, +macros, variables, and the other usual Lisp constructs. Tests are +simply Lisp code --- code that invokes other code and checks whether +it behaves as expected. + +ERT keeps track of the tests that are defined and provides convenient +commands to run them to verify whether the definitions that are +currently loaded in Emacs pass the tests. + +Some Lisp files have comments like the following (adapted from the +package @code{pp.el}): + +@lisp +;; (pp-to-string '(quote quote)) ; expected: "'quote" +;; (pp-to-string '((quote a) (quote b))) ; expected: "('a 'b)\n" +;; (pp-to-string '('a 'b)) ; same as above +@end lisp + +The code contained in these comments can be evaluated from time to +time to compare the output with the expected output. ERT formalizes +this and introduces a common convention, which simplifies Emacs +development, since programmers no longer have to manually find and +evaluate such comments. + +An ERT test definition equivalent to the above comments is this: + +@lisp +(ert-deftest pp-test-quote () + "Tests the rendering of `quote' symbols in `pp-to-string'." + (should (equal (pp-to-string '(quote quote)) "'quote")) + (should (equal (pp-to-string '((quote a) (quote b))) "('a 'b)\n")) + (should (equal (pp-to-string '('a 'b)) "('a 'b)\n"))) +@end lisp + +If you know @code{defun}, the syntax of @code{ert-deftest} should look +familiar: This example defines a test named @code{pp-test-quote} that +will pass if the three calls to @code{equal} all return true +(non-nil). + +@code{should} is a macro with the same meaning as @code{assert} but +better error reporting. @xref{The @code{should} Macro}. + +Each test should have a name that describes what functionality the +test tests. Test names can be chosen arbitrarily --- they are in a +namespace separate from functions and variables --- but should follow +the usual Emacs Lisp convention of having a prefix that indicates +which package they belong to. Test names are displayed by ERT when +reporting failures and can be used when selecting which tests to run. + +The empty parentheses @code{()} in the first line don't currently have +any meaning and are reserved for future extension. They also make +@code{ert-deftest}'s syntax more similar to @code{defun}. + +The docstring describes what feature this test tests. When running +tests interactively, the first line of the docstring is displayed for +tests that fail, so it is good if the first line makes sense on its +own. + +The body of a test can be arbitrary Lisp code. It should have as few +side effects as possible; each test should be written to clean up +after itself, leaving Emacs in the same state as it was before the +test. Tests should clean up even if they fail. @xref{Tests and Their +Environment}. + + +@node How to Run Tests, How to Write Tests, Introduction, Top +@chapter How to Run Tests + +You can run tests either in the Emacs you are working in, or on the +command line in a separate Emacs process in batch mode (i.e., with no +user interface). The former mode is convenient during interactive +development, the latter is useful to make sure that tests pass +independently of your customizations, allows tests to be invoked from +makefiles and scripts to be written that run tests in several +different Emacs versions. + +@menu +* Running Tests Interactively:: Run tests in your current Emacs. +* Running Tests in Batch Mode:: Run tests in emacs -Q. +* Test Selectors:: Choose which tests to run. +@end menu + + +@node Running Tests Interactively, Running Tests in Batch Mode, How to Run Tests, How to Run Tests +@section Running Tests Interactively + +You can run the tests that are currently defined in your Emacs with +the command @kbd{@kbd{M-x} ert @kbd{RET} t @kbd{RET}}. ERT will pop +up a new buffer, the ERT results buffer, showing the results of the +tests run. It looks like this: + +@example +Selector: t +Passed: 31 +Failed: 2 (2 unexpected) +Total: 33/33 + +Started at: 2008-09-11 08:39:25-0700 +Finished. +Finished at: 2008-09-11 08:39:27-0700 + +FF............................... + +F addition-test + (ert-test-failed + ((should + (= + (+ 1 2) + 4)) + :form + (= 3 4) + :value nil)) + +F list-test + (ert-test-failed + ((should + (equal + (list 'a 'b 'c) + '(a b d))) + :form + (equal + (a b c) + (a b d)) + :value nil :explanation + (list-elt 2 + (different-atoms c d)))) +@end example + +At the top, there is a summary of the results: We ran all tests in the +current Emacs (@code{Selector: t}), 31 of them passed, and 2 failed +unexpectedly. @xref{Expected Failures}, for an explanation of the +term @emph{unexpected} in this context. + +The line of dots and @code{F}s is a progress bar where each character +represents one test; it fills while the tests are running. A dot +means that the test passed, an @code{F} means that it failed. Below +the progress bar, ERT shows details about each test that had an +unexpected result. In the example above, there are two failures, both +due to failed @code{should} forms. @xref{Understanding Explanations}, +for more details. + +In the ERT results buffer, @kbd{TAB} and @kbd{S-TAB} cycle between +buttons. Each name of a function or macro in this buffer is a button; +moving point to it and typing @kbd{RET} jumps to its definition. + +Pressing @kbd{r} re-runs the test near point on its own. Pressing +@kbd{d} re-runs it with the debugger enabled. @kbd{.} jumps to the +definition of the test near point (@kbd{RET} has the same effect if +point is on the name of the test). On a failed test, @kbd{b} shows +the backtrace of the failure. + +@kbd{l} shows the list of @code{should} forms executed in the test. +If any messages were generated (with the Lisp function @code{message}) +in a test or any of the code that it invoked, @kbd{m} will show them. + +By default, long expressions in the failure details are abbreviated +using @code{print-length} and @code{print-level}. Pressing @kbd{L} +while point is on a test failure will increase the limits to show more +of the expression. + + +@node Running Tests in Batch Mode, Test Selectors, Running Tests Interactively, How to Run Tests +@section Running Tests in Batch Mode + +ERT supports automated invocations from the command line or from +scripts or makefiles. There are two functions for this purpose, +@code{ert-run-tests-batch} and @code{ert-run-tests-batch-and-exit}. +They can be used like this: + +@example +emacs -batch -L /path/to/ert -l ert.el -l my-tests.el -f ert-run-tests-batch-and-exit +@end example + +This command will start up Emacs in batch mode, load ERT, load +@code{my-tests.el}, and run all tests defined in it. It will exit +with a zero exit status if all tests passed, or nonzero if any tests +failed or if anything else went wrong. It will also print progress +messages and error diagnostics to standard output. + +You may need additional @code{-L} flags to ensure that +@code{my-tests.el} and all the files that it requires are on your +@code{load-path}. + + +@node Test Selectors, , Running Tests in Batch Mode, How to Run Tests +@section Test Selectors + +Functions like @code{ert} accept a @emph{test selector}, a Lisp +expression specifying a set of tests. Test selector syntax is similar +to Common Lisp's type specifier syntax: + +@itemize +@item @code{nil} selects no tests. +@item @code{t} selects all tests. +@item @code{:new} selects all tests that have not been run yet. +@item @code{:failed} and @code{:passed} select tests according to their most recent result. +@item @code{:expected}, @code{:unexpected} select tests according to their most recent result. +@item A string selects all tests that have a name that matches the string, a regexp. +@item A test selects that test. +@item A symbol selects the test that the symbol names. +@item @code{(member TESTS...)} selects TESTS, a list of tests or symbols naming tests. +@item @code{(eql TEST)} selects TEST, a test or a symbol naming a test. +@item @code{(and SELECTORS...)} selects the tests that match all SELECTORS. +@item @code{(or SELECTORS...)} selects the tests that match any SELECTOR. +@item @code{(not SELECTOR)} selects all tests that do not match SELECTOR. +@item @code{(tag TAG)} selects all tests that have TAG on their tags list. +@item @code{(satisfies PREDICATE)} Selects all tests that satisfy PREDICATE. +@end itemize + +Selectors that are frequently useful when selecting tests to run +include @code{t} to run all tests that are currently defined in Emacs, +@code{"^foo-"} to run all tests in package @code{foo} --- this assumes +that package @code{foo} uses the prefix @code{foo-} for its test names +---, result-based selectors such as @code{(or :new :unexpected)} to +run all tests that have either not run yet or that had an unexpected +result in the last run, and tag-based selectors such as @code{(not +(tag :causes-redisplay))} to run all tests that are not tagged +@code{:causes-redisplay}. + + +@node How to Write Tests, How to Debug Tests, How to Run Tests, Top +@chapter How to Write Tests + +ERT lets you define tests in the same way you define functions. You +can type @code{ert-deftest} forms in a buffer and evaluate them there +with @code{eval-defun} or @code{compile-defun}, or you can save the +file and load it, optionally byte-compiling it first. + +Just like @code{find-function} is only able to find where a function +was defined if the function was loaded from a file, ERT is only able +to find where a test was defined if the test was loaded from a file. + + +@menu +* The @code{should} Macro:: A powerful way to express assertions. +* Expected Failures:: Tests for known bugs. +* Tests and Their Environment:: Don't depend on customizations; no side effects. +* Useful Techniques:: Some examples. +@end menu + +@node The @code{should} Macro, Expected Failures, How to Write Tests, How to Write Tests +@section The @code{should} Macro + +Test bodies can include arbitrary code; but to be useful, they need to +have checks whether the code being tested (or @emph{code under test}) +does what it is supposed to do. The macro @code{should} is similar to +@code{assert} from the cl package, but analyzes its argument form and +records information that ERT can display to help debugging. + +This test definition + +@lisp +(ert-deftest addition-test () + (should (= (+ 1 2) 4))) +@end lisp + +will produce this output when run via @kbd{M-x ert}: + +@example +F addition-test + (ert-test-failed + ((should + (= + (+ 1 2) + 4)) + :form + (= 3 4) + :value nil)) +@end example + +In this example, @code{should} recorded the fact that (= (+ 1 2) 4) +reduced to (= 3 4) before it reduced to nil. When debugging why the +test failed, it helps to know that the function @code{+} returned 3 +here. ERT records the return value for any predicate called directly +within @code{should}. + +In addition to @code{should}, ERT provides @code{should-not}, which +checks that the predicate returns nil, and @code{should-error}, which +checks that the form called within it signals an error. An example +use of @code{should-error}: + +@lisp +(ert-deftest test-divide-by-zero () + (should-error (/ 1 0) + :type 'arith-error)) +@end lisp + +This checks that dividing one by zero signals an error of type +@code{arith-error}. The @code{:type} argument to @code{should-error} +is optional; if absent, any type of error is accepted. +@code{should-error} returns an error description of the error that was +signalled, to allow additional checks to be made. The error +description has the format @code{(ERROR-SYMBOL . DATA)}. + +There is no @code{should-not-error} macro since tests that signal an +error fail anyway, so @code{should-not-error} is effectively the +default. + +@xref{Understanding Explanations}, for more details on what +@code{should} reports. + + +@node Expected Failures, Tests and Their Environment, The @code{should} Macro, How to Write Tests +@section Expected Failures + +Some bugs are complicated to fix or not very important and are left as +@emph{known bugs}. If there is a test case that triggers the bug and +fails, ERT will alert you of this failure every time you run all +tests. For known bugs, this alert is a distraction. The way to +suppress it is to add @code{:expected-result :failed} to the test +definition: + +@lisp +(ert-deftest future-bug () + "Test `time-forward' with negative arguments. +Since this functionality isn't implemented yet, the test is known to fail." + :expected-result :failed + (time-forward -1)) +@end lisp + +ERT will still display a small @code{f} in the progress bar as a +reminder that there is a known bug, and will count the test as failed, +but it will be quiet about it otherwise. + +An alternative to marking the test as a known failure this way is to +delete the test. This is a good idea if there is no intent to fix it, +i.e., if the behavior that was formerly considered a bug has become an +accepted feature. + +In general, however, it can be useful to keep tests that are known to +fail. If someone wants to fix the bug, they will have a very good +starting point: an automated test case that reproduces the bug. This +makes it much easier to fix the bug, demonstrate that it is fixed, and +prevent future regressions. + +ERT displays the same kind of alerts for tests that pass unexpectedly +that it displays for unexpected failures. This way, if you make code +changes that happen to fix a bug that you weren't aware of, you will +know to remove the @code{:expected-result} clause of that test and +close the corresponding bug report, if any. + +Since @code{:expected-result} evaluates its argument when the test is +loaded, tests can be marked as known failures only on certain Emacs +versions, specific architectures, etc.: + +@lisp +(ert-deftest foo () + "A test that is expected to fail on Emacs 23 but succeed elsewhere." + :expected-result (if (string-match "GNU Emacs 23[.]" (emacs-version)) + :failed + :passed) + ...) +@end lisp + + +@node Tests and Their Environment, Useful Techniques, Expected Failures, How to Write Tests +@section Tests and Their Environment + +The outcome of running a test should not depend on the current state +of the environment, and each test should leave its environment in the +same state it found it in. In particular, a test should not depend on +any Emacs customization variables or hooks, and if it has to make any +changes to Emacs' state or state external to Emacs such as the file +system, it should undo these changes before it returns, regardless of +whether it passed or failed. + +Tests should not depend on the environment because any such +dependencies can make the test brittle or lead to failures that occur +only under certain circumstances and are hard to reproduce. Of +course, the code under test may have settings that affect its +behavior. In that case, it is best to make the test @code{let}-bind +all such settings variables to set up a specific configuration for the +duration of the test. The test can also set up a number of different +configurations and run the code under test with each. + +Tests that have side effects on their environment should restore it to +its original state because any side effects that persist after the +test can disrupt the workflow of the programmer running the tests. If +the code under test has side effects on Emacs' current state, such as +on the current buffer or window configuration, the test should create +a temporary buffer for the code to manipulate (using +@code{with-temp-buffer}), or save and restore the window configuration +(using @code{save-window-excursion}), respectively. For aspects of +the state that can not be preserved with such macros, cleanup should +be performed with @code{unwind-protect}, to ensure that the cleanup +occurs even if the test fails. + +An exception to this are messages that the code under test prints with +@code{message} and similar logging; tests should not bother restoring +the @code{*Message*} buffer to its original state. + +The above guidelines imply that tests should avoid calling highly +customizable commands such as @code{find-file}, except, of course, if +such commands are what they want to test. The exact behavior of +@code{find-file} depends on many settings such as +@code{find-file-wildcards}, @code{enable-local-variables}, and +@code{auto-mode-alist}. It is difficult to write a meaningful test if +its behavior can be affected by so many external factors. Also, +@code{find-file} has side effects that are hard to predict and thus +hard to undo: It may create a new buffer or may reuse an existing +buffer if one is already visiting the requested file; and it runs +@code{find-file-hook}, which can have arbitrary side effects. + +Instead, it is better to use lower-level mechanisms with simple and +predictable semantics like @code{with-temp-buffer}, @code{insert} or +@code{insert-file-contents-literally}, and activating the desired mode +by calling the corresponding function directly --- after binding the +hook variables to nil. This avoids the above problems. + + +@node Useful Techniques, , Tests and Their Environment, How to Write Tests +@section Useful Techniques when Writing Tests + +Testing simple functions that have no side effects and no dependencies +on their environment is easy. Such tests often look like this: + +@lisp +(ert-deftest ert-test-mismatch () + (should (eql (ert--mismatch "" "") nil)) + (should (eql (ert--mismatch "" "a") 0)) + (should (eql (ert--mismatch "a" "a") nil)) + (should (eql (ert--mismatch "ab" "a") 1)) + (should (eql (ert--mismatch "Aa" "aA") 0)) + (should (eql (ert--mismatch '(a b c) '(a b d)) 2))) +@end lisp + +This test calls the function @code{ert--mismatch} several times with +various combinations of arguments and compares the return value to the +expected return value. (Some programmers prefer @code{(should (eql +EXPECTED ACTUAL))} over the @code{(should (eql ACTUAL EXPECTED))} +shown here. ERT works either way.) + +Here's a more complicated test: + +@lisp +(ert-deftest ert-test-record-backtrace () + (let ((test (make-ert-test :body (lambda () (ert-fail "foo"))))) + (let ((result (ert-run-test test))) + (should (ert-test-failed-p result)) + (with-temp-buffer + (ert--print-backtrace (ert-test-failed-backtrace result)) + (goto-char (point-min)) + (end-of-line) + (let ((first-line (buffer-substring-no-properties (point-min) (point)))) + (should (equal first-line " signal(ert-test-failed (\"foo\"))"))))))) +@end lisp + +This test creates a test object using @code{make-ert-test} whose body +will immediately signal failure. It then runs that test and asserts +that it fails. Then, it creates a temporary buffer and invokes +@code{ert--print-backtrace} to print the backtrace of the failed test +to the current buffer. Finally, it extracts the first line from the +buffer and asserts that it matches what we expect. It uses +@code{buffer-substring-no-properties} and @code{equal} to ignore text +properties; for a test that takes properties into account, +@code{buffer-substring} and @code{ert-equal-including-properties} +could be used instead. + +The reason why this test only checks the first line of the backtrace +is that the remainder of the backtrace is dependent on ERT's internals +as well as whether the code is running interpreted or compiled. By +looking only at the first line, the test checks a useful property +--- that the backtrace correctly captures the call to @code{signal} that +results from the call to @code{ert-fail} --- without being brittle. + +This example also shows that writing tests is much easier if the code +under test was structured with testing in mind. + +For example, if @code{ert-run-test} accepted only symbols that name +tests rather than test objects, the test would need a name for the +failing test, which would have to be a temporary symbol generated with +@code{make-symbol}, to avoid side effects on Emacs' state. Choosing +the right interface for @code{ert-run-tests} allows the test to be +simpler. + +Similarly, if @code{ert--print-backtrace} printed the backtrace to a +buffer with a fixed name rather than the current buffer, it would be +much harder for the test to undo the side effect. Of course, some +code somewhere needs to pick the buffer name. But that logic is +independent of the logic that prints backtraces, and keeping them in +separate functions allows us to test them independently. + +A lot of code that you will encounter in Emacs was not written with +testing in mind. Sometimes, the easiest way to write tests for such +code is to restructure the code slightly to provide better interfaces +for testing. Usually, this makes the interfaces easier to use as +well. + + +@node How to Debug Tests, Extending ERT, How to Write Tests, Top +@chapter How to Debug Tests + +This section describes how to use ERT's features to understand why +a test failed. + + +@menu +* Understanding Explanations:: How ERT gives details on why an assertion failed. +* Interactive Debugging:: Tools available in the ERT results buffer. +@end menu + + +@node Understanding Explanations, Interactive Debugging, How to Debug Tests, How to Debug Tests +@section Understanding Explanations + +Failed @code{should} forms are reported like this: + +@example +F addition-test + (ert-test-failed + ((should + (= + (+ 1 2) + 4)) + :form + (= 3 4) + :value nil)) +@end example + +ERT shows what the @code{should} expression looked like and what +values its subexpressions had: The source code of the assertion was +@code{(should (= (+ 1 2) 4))}, which applied the function @code{=} to +the arguments @code{3} and @code{4}, resulting in the value +@code{nil}. In this case, the test is wrong; it should expect 3 +rather than 4. + +If a predicate like @code{equal} is used with @code{should}, ERT +provides a so-called @emph{explanation}: + +@example +F list-test + (ert-test-failed + ((should + (equal + (list 'a 'b 'c) + '(a b d))) + :form + (equal + (a b c) + (a b d)) + :value nil :explanation + (list-elt 2 + (different-atoms c d)))) +@end example + +In this case, the function @code{equal} was applied to the arguments +@code{(a b c)} and @code{(a b d)}. ERT's explanation shows that +the item at index 2 differs between the two lists; in one list, it is +the atom c, in the other, it is the atom d. + +In simple examples like the above, the explanation is unnecessary. +But in cases where the difference is not immediately apparent, it can +save time: + +@example +F test1 + (ert-test-failed + ((should + (equal x y)) + :form + (equal a a) + :value nil :explanation + (different-symbols-with-the-same-name a a))) +@end example + +ERT only provides explanations for predicates that have an explanation +function registered. @xref{Defining Explanation Functions}. + + +@node Interactive Debugging, , Understanding Explanations, How to Debug Tests +@section Interactive Debugging + +Debugging failed tests works essentially the same way as debugging any +other problems with Lisp code. Here are a few tricks specific to +tests: + +@itemize +@item Re-run the failed test a few times to see if it fails in the same way +each time. It's good to find out whether the behavior is +deterministic before spending any time looking for a cause. In the +ERT results buffer, @kbd{r} re-runs the selected test. + +@item Use @kbd{.} to jump to the source code of the test to find out what +exactly it does. Perhaps the test is broken rather than the code +under test. + +@item If the test contains a series of @code{should} forms and you can't +tell which one failed, use @kbd{l}, which shows you the list of all +@code{should} forms executed during the test before it failed. + +@item Use @kbd{b} to view the backtrace. You can also use @kbd{d} to re-run +the test with debugging enabled, this will enter the debugger and show +the backtrace as well; but the top few frames shown there will not be +relevant to you since they are ERT's own debugger hook. @kbd{b} +strips them out, so it is more convenient. + +@item If the test or the code under testing prints messages using +@code{message}, use @kbd{m} to see what messages it printed before it +failed. This can be useful to figure out how far it got. + +@item You can instrument tests for debugging the same way you instrument +@code{defun}s for debugging --- go to the source code of the test and +type @kbd{@kbd{C-u} @kbd{C-M-x}}. Then, go back to the ERT buffer and +re-run the test with @kbd{r} or @kbd{d}. + +@item If you have been editing and rearranging tests, it is possible that +ERT remembers an old test that you have since renamed or removed --- +renamings or removals of definitions in the source code leave around a +stray definition under the old name in the running process, this is a +common problem in Lisp. In such a situation, hit @kbd{D} to let ERT +forget about the obsolete test. +@end itemize + + +@node Extending ERT, Other Testing Concepts, How to Debug Tests, Top +@chapter Extending ERT + +There are several ways to add functionality to ERT. + +@menu +* Defining Explanation Functions:: Teach ERT about more predicates. +* Low-Level Functions for Working with Tests:: Use ERT's data for your purposes. +@end menu + + +@node Defining Explanation Functions, Low-Level Functions for Working with Tests, Extending ERT, Extending ERT +@section Defining Explanation Functions + +The explanation function for a predicate is a function that takes the +same arguments as the predicate and returns an @emph{explanation}. +The explanation should explain why the predicate, when invoked with +the arguments given to the explanation function, returns the value +that it returns. The explanation can be any object but should have a +comprehensible printed representation. If the return value of the +predicate needs no explanation for a given list of arguments, the +explanation function should return nil. + +To associate an explanation function with a predicate, add the +property @code{ert-explainer} to the symbol that names the predicate. +The value of the property should be the symbol that names the +explanation function. + + +@node Low-Level Functions for Working with Tests, , Defining Explanation Functions, Extending ERT +@section Low-Level Functions for Working with Tests + +Both @code{ert-run-tests-interactively} and @code{ert-run-tests-batch} +are implemented on top of the lower-level test handling code in the +sections named ``Facilities for running a single test'', ``Test +selectors'', and ``Facilities for running a whole set of tests''. + +If you want to write code that works with ERT tests, you should take a +look at this lower-level code. Symbols that start with @code{ert--} +are internal to ERT, those that start with @code{ert-} but not +@code{ert--} are meant to be usable by other code. But there is no +mature API yet. + +Contributions to ERT are welcome. + + +@node Other Testing Concepts, , Extending ERT, Top +@chapter Other Testing Concepts + +For information on mocks, stubs, fixtures, or test suites, see below. + + +@menu +* Mocks and Stubs:: Stubbing out code that is irrelevant to the test. +* Fixtures and Test Suites:: How ERT differs from tools for other languages. +@end menu + +@node Mocks and Stubs, Fixtures and Test Suites, Other Testing Concepts, Other Testing Concepts +@section Other Tools for Emacs Lisp + +Stubbing out functions or using so-called @emph{mocks} can make it +easier to write tests. See +@url{http://en.wikipedia.org/wiki/Mock_object} for an explanation of +the corresponding concepts in object-oriented languages. + +ERT does not have built-in support for mocks or stubs. The package +@code{el-mock} (see @url{http://www.emacswiki.org/emacs/el-mock.el}) +offers mocks for Emacs Lisp and can be used in conjunction with ERT. + + +@node Fixtures and Test Suites, , Mocks and Stubs, Other Testing Concepts +@section Fixtures and Test Suites + +In many ways, ERT is similar to frameworks for other languages like +SUnit or JUnit. However, two features commonly found in such +frameworks are notably absent from ERT: fixtures and test suites. + +Fixtures, as used e.g. in SUnit or JUnit, are mainly used to provide +an environment for a set of tests, and consist of set-up and tear-down +functions. + +While fixtures are a useful syntactic simplification in other +languages, this does not apply to Lisp, where higher-order functions +and `unwind-protect' are available. One way to implement and use a +fixture in ERT is + +@lisp +(defun my-fixture (body) + (unwind-protect + (progn [set up] + (funcall body)) + [tear down])) + +(ert-deftest my-test () + (my-fixture + (lambda () + [test code]))) +@end lisp + +(Another way would be a @code{with-my-fixture} macro.) This solves +the set-up and tear-down part, and additionally allows any test +to use any combination of fixtures, so it is more flexible than what +other tools typically allow. + +If the test needs access to the environment the fixture sets up, the +fixture can be modified to pass arguments to the body. + +These are well-known Lisp techniques. Special syntax for them could +be added but would provide only a minor simplification. + +(If you are interested in such syntax, note that splitting set-up and +tear-down into separate functions, like *Unit tools usually do, makes +it impossible to establish dynamic `let' bindings as part of the +fixture. So, blindly imitating the way fixtures are implemented in +other languages would be counter-productive in Lisp.) + +The purpose of test suites is to group related tests together. + +The most common use of this is to run just the tests for one +particular module. Since symbol prefixes are the usual way of +separating module namespaces in Emacs Lisp, test selectors already +solve this by allowing regexp matching on test names; e.g., the +selector "^ert-" selects ERT's self-tests. + +Other uses include grouping tests by their expected execution time to +run quick tests during interactive development and slow tests less +frequently. This can be achieved with the @code{:tag} argument to +@code{ert-deftest} and @code{tag} test selectors. + +@bye + +@c LocalWords: ERT Hagelberg Ohler JUnit namespace docstring ERT's +@c LocalWords: backtrace makefiles workflow backtraces API SUnit +@c LocalWords: subexpressions === modified file 'doc/misc/makefile.w32-in' --- doc/misc/makefile.w32-in 2010-10-29 10:49:27 +0000 +++ doc/misc/makefile.w32-in 2011-01-12 16:08:24 +0000 @@ -47,7 +47,8 @@ $(infodir)/org $(infodir)/url $(infodir)/speedbar \ $(infodir)/tramp $(infodir)/ses $(infodir)/smtpmail \ $(infodir)/flymake $(infodir)/newsticker $(infodir)/rcirc \ - $(infodir)/erc $(infodir)/remember $(infodir)/nxml-mode \ + $(infodir)/erc $(infodir)/ert \ + $(infodir)/remember $(infodir)/nxml-mode \ $(infodir)/epa $(infodir)/mairix-el $(infodir)/sasl \ $(infodir)/auth $(infodir)/eieio $(infodir)/ede \ $(infodir)/semantic $(infodir)/edt @@ -58,7 +59,8 @@ ada-mode.dvi autotype.dvi idlwave.dvi eudc.dvi ebrowse.dvi \ pcl-cvs.dvi woman.dvi eshell.dvi org.dvi url.dvi \ speedbar.dvi tramp.dvi ses.dvi smtpmail.dvi flymake.dvi \ - newsticker.dvi rcirc.dvi erc.dvi remember.dvi nxml-mode.dvi \ + newsticker.dvi rcirc.dvi erc.dvi ert.dvi \ + remember.dvi nxml-mode.dvi \ epa.dvi mairix-el.dvi sasl.dvi auth.dvi eieio.dvi ede.dvi \ semantic.dvi edt.dvi INFOSOURCES = info.texi @@ -305,6 +307,11 @@ erc.dvi: erc.texi $(ENVADD) $(TEXI2DVI) $(srcdir)/erc.texi +$(infodir)/ert: ert.texi + $(MAKEINFO) ert.texi +ert.dvi: ert.texi + $(ENVADD) $(TEXI2DVI) $(srcdir)/ert.texi + $(infodir)/epa: epa.texi $(MAKEINFO) epa.texi epa.dvi: epa.texi @@ -362,7 +369,7 @@ $(infodir)/url* $(infodir)/org* \ $(infodir)/flymake* $(infodir)/newsticker* \ $(infodir)/sieve* $(infodir)/pgg* \ - $(infodir)/erc* $(infodir)/rcirc* \ + $(infodir)/erc* $(infodir)/ert* $(infodir)/rcirc* \ $(infodir)/remember* $(infodir)/nxml-mode* \ $(infodir)/epa* $(infodir)/sasl* \ $(infodir)/mairix-el* $(infodir)/auth* \ === modified file 'etc/ChangeLog' --- etc/ChangeLog 2011-01-10 09:40:20 +0000 +++ etc/ChangeLog 2011-01-12 16:08:24 +0000 @@ -1,3 +1,7 @@ +2011-01-13 Christian Ohler + + * NEWS: Mention ERT. + 2011-01-10 Jan Moringen * NEWS: Add new function dbus-register-service. === modified file 'etc/NEWS' --- etc/NEWS 2011-01-13 04:23:41 +0000 +++ etc/NEWS 2011-01-13 08:08:58 +0000 @@ -210,6 +210,10 @@ `package-enable-at-startup' to nil. To change which packages are loaded, customize `package-load-list'. +** An Emacs Lisp testing tool is now included. +Emacs Lisp developers can use this tool to write automated tests for +their code. See the ERT info manual for details. + ** Custom Themes *** `M-x customize-themes' lists Custom themes which can be enabled. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-13 04:30:23 +0000 +++ lisp/ChangeLog 2011-01-13 08:08:58 +0000 @@ -1,3 +1,7 @@ +2011-01-13 Christian Ohler + + * emacs-lisp/ert.el, emacs-lisp/ert-x.el: New files. + 2011-01-13 Chong Yidong * font-lock.el (font-lock-verbose): Default to nil. === added file 'lisp/emacs-lisp/ert-x.el' --- lisp/emacs-lisp/ert-x.el 1970-01-01 00:00:00 +0000 +++ lisp/emacs-lisp/ert-x.el 2011-01-12 16:08:24 +0000 @@ -0,0 +1,290 @@ +;;; ert-x.el --- Staging area for experimental extensions to ERT + +;; Copyright (C) 2008, 2010, 2011 Free Software Foundation, Inc. + +;; Author: Lennart Borgman (lennart O borgman A gmail O com) +;; Author: Christian Ohler + +;; This file is part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see `http://www.gnu.org/licenses/'. + +;;; Commentary: + +;; This file includes some extra helper functions to use while writing +;; automated tests with ERT. These have been proposed as extensions +;; to ERT but are not mature yet and likely to change. + +;;; Code: + +(eval-when-compile + (require 'cl)) +(require 'ert) + + +;;; Test buffers. + +(defun ert--text-button (string &rest properties) + "Return a string containing STRING as a text button with PROPERTIES. + +See `make-text-button'." + (with-temp-buffer + (insert string) + (apply #'make-text-button (point-min) (point-max) properties) + (buffer-string))) + +(defun ert--format-test-buffer-name (base-name) + "Compute a test buffer name based on BASE-NAME. + +Helper function for `ert--test-buffers'." + (format "*Test buffer (%s)%s*" + (or (and (ert-running-test) + (ert-test-name (ert-running-test))) + "") + (if base-name + (format ": %s" base-name) + ""))) + +(defvar ert--test-buffers (make-hash-table :weakness t) + "Table of all test buffers. Keys are the buffer objects, values are t. + +The main use of this table is for `ert-kill-all-test-buffers'. +Not all buffers in this table are necessarily live, but all live +test buffers are in this table.") + +(define-button-type 'ert--test-buffer-button + 'action #'ert--test-buffer-button-action + 'help-echo "mouse-2, RET: Pop to test buffer") + +(defun ert--test-buffer-button-action (button) + "Pop to the test buffer that BUTTON is associated with." + (pop-to-buffer (button-get button 'ert--test-buffer))) + +(defun ert--call-with-test-buffer (ert--base-name ert--thunk) + "Helper function for `ert-with-test-buffer'. + +Create a test buffer with a name based on ERT--BASE-NAME and run +ERT--THUNK with that buffer as current." + (let* ((ert--buffer (generate-new-buffer + (ert--format-test-buffer-name ert--base-name))) + (ert--button (ert--text-button (buffer-name ert--buffer) + :type 'ert--test-buffer-button + 'ert--test-buffer ert--buffer))) + (puthash ert--buffer 't ert--test-buffers) + ;; We don't use `unwind-protect' here since we want to kill the + ;; buffer only on success. + (prog1 (with-current-buffer ert--buffer + (ert-info (ert--button :prefix "Buffer: ") + (funcall ert--thunk))) + (kill-buffer ert--buffer) + (remhash ert--buffer ert--test-buffers)))) + +(defmacro* ert-with-test-buffer ((&key ((:name name-form))) + &body body) + "Create a test buffer and run BODY in that buffer. + +To be used in ERT tests. If BODY finishes successfully, the test +buffer is killed; if there is an error, the test buffer is kept +around on error for further inspection. Its name is derived from +the name of the test and the result of NAME-FORM." + (declare (debug ((form) body)) + (indent 1)) + `(ert--call-with-test-buffer ,name-form (lambda () ,@body))) + +;; We use these `put' forms in addition to the (declare (indent)) in +;; the defmacro form since the `declare' alone does not lead to +;; correct indentation before the .el/.elc file is loaded. +;; Autoloading these `put' forms solves this. +;;;###autoload +(progn + ;; TODO(ohler): Figure out what these mean and make sure they are correct. + (put 'ert-with-test-buffer 'lisp-indent-function 1)) + +;;;###autoload +(defun ert-kill-all-test-buffers () + "Kill all test buffers that are still live." + (interactive) + (let ((count 0)) + (maphash (lambda (buffer dummy) + (when (or (not (buffer-live-p buffer)) + (kill-buffer buffer)) + (incf count))) + ert--test-buffers) + (message "%s out of %s test buffers killed" + count (hash-table-count ert--test-buffers))) + ;; It could be that some test buffers were actually kept alive + ;; (e.g., due to `kill-buffer-query-functions'). I'm not sure what + ;; to do about this. For now, let's just forget them. + (clrhash ert--test-buffers) + nil) + + +;;; Simulate commands. + +(defun ert-simulate-command (command) + ;; FIXME: add unread-events + "Simulate calling COMMAND the way the Emacs command loop would call it. + +This effectively executes + + \(apply (car COMMAND) (cdr COMMAND)\) + +and returns the same value, but additionally runs hooks like +`pre-command-hook' and `post-command-hook', and sets variables +like `this-command' and `last-command'. + +COMMAND should be a list where the car is the command symbol and +the rest are arguments to the command. + +NOTE: Since the command is not called by `call-interactively' +test for `called-interactively' in the command will fail." + (assert (listp command) t) + (assert (commandp (car command)) t) + (assert (not unread-command-events) t) + (let (return-value) + ;; For the order of things here see command_loop_1 in keyboard.c. + ;; + ;; The command loop will reset the command-related variables so + ;; there is no reason to let-bind them. They are set here, + ;; however, to be able to test several commands in a row and how + ;; they affect each other. + (setq deactivate-mark nil + this-original-command (car command) + ;; remap through active keymaps + this-command (or (command-remapping this-original-command) + this-original-command)) + (run-hooks 'pre-command-hook) + (setq return-value (apply (car command) (cdr command))) + (run-hooks 'post-command-hook) + (when deferred-action-list + (run-hooks 'deferred-action-function)) + (setq real-last-command (car command) + last-command this-command) + (when (boundp 'last-repeatable-command) + (setq last-repeatable-command real-last-command)) + (when (and deactivate-mark transient-mark-mode) (deactivate-mark)) + (assert (not unread-command-events) t) + return-value)) + +(defun ert-run-idle-timers () + "Run all idle timers (from `timer-idle-list')." + (dolist (timer (copy-sequence timer-idle-list)) + (timer-event-handler timer))) + + +;;; Miscellaneous utilities. + +(defun ert-filter-string (s &rest regexps) + "Return a copy of S with all matches of REGEXPS removed. + +Elements of REGEXPS may also be two-element lists \(REGEXP +SUBEXP\), where SUBEXP is the number of a subexpression in +REGEXP. In that case, only that subexpression will be removed +rather than the entire match." + ;; Use a temporary buffer since replace-match copies strings, which + ;; would lead to N^2 runtime. + (with-temp-buffer + (insert s) + (dolist (x regexps) + (destructuring-bind (regexp subexp) (if (listp x) x `(,x nil)) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (replace-match "" t t nil subexp)))) + (buffer-string))) + + +(defun ert-propertized-string (&rest args) + "Return a string with properties as specified by ARGS. + +ARGS is a list of strings and plists. The strings in ARGS are +concatenated to produce an output string. In the output string, +each string from ARGS will be have the preceding plist as its +property list, or no properties if there is no plist before it. + +As a simple example, + +\(ert-propertized-string \"foo \" '(face italic) \"bar\" \" baz\" nil \ +\" quux\"\) + +would return the string \"foo bar baz quux\" where the substring +\"bar baz\" has a `face' property with the value `italic'. + +None of the ARGS are modified, but the return value may share +structure with the plists in ARGS." + (with-temp-buffer + (loop with current-plist = nil + for x in args do + (etypecase x + (string (let ((begin (point))) + (insert x) + (set-text-properties begin (point) current-plist))) + (list (unless (zerop (mod (length x) 2)) + (error "Odd number of args in plist: %S" x)) + (setq current-plist x)))) + (buffer-string))) + + +(defun ert-call-with-buffer-renamed (buffer-name thunk) + "Protect the buffer named BUFFER-NAME from side-effects and run THUNK. + +Renames the buffer BUFFER-NAME to a new temporary name, creates a +new buffer named BUFFER-NAME, executes THUNK, kills the new +buffer, and renames the original buffer back to BUFFER-NAME. + +This is useful if THUNK has undesirable side-effects on an Emacs +buffer with a fixed name such as *Messages*." + (lexical-let ((new-buffer-name (generate-new-buffer-name + (format "%s orig buffer" buffer-name)))) + (with-current-buffer (get-buffer-create buffer-name) + (rename-buffer new-buffer-name)) + (unwind-protect + (progn + (get-buffer-create buffer-name) + (funcall thunk)) + (when (get-buffer buffer-name) + (kill-buffer buffer-name)) + (with-current-buffer new-buffer-name + (rename-buffer buffer-name))))) + +(defmacro* ert-with-buffer-renamed ((buffer-name-form) &body body) + "Protect the buffer named BUFFER-NAME from side-effects and run BODY. + +See `ert-call-with-buffer-renamed' for details." + (declare (indent 1)) + `(ert-call-with-buffer-renamed ,buffer-name-form (lambda () ,@body))) + + +(defun ert-buffer-string-reindented (&optional buffer) + "Return the contents of BUFFER after reindentation. + +BUFFER defaults to current buffer. Does not modify BUFFER." + (with-current-buffer (or buffer (current-buffer)) + (let ((clone nil)) + (unwind-protect + (progn + ;; `clone-buffer' doesn't work if `buffer-file-name' is non-nil. + (let ((buffer-file-name nil)) + (setq clone (clone-buffer))) + (with-current-buffer clone + (let ((inhibit-read-only t)) + (indent-region (point-min) (point-max))) + (buffer-string))) + (when clone + (let ((kill-buffer-query-functions nil)) + (kill-buffer clone))))))) + + +(provide 'ert-x) + +;;; ert-x.el ends here === added file 'lisp/emacs-lisp/ert.el' --- lisp/emacs-lisp/ert.el 1970-01-01 00:00:00 +0000 +++ lisp/emacs-lisp/ert.el 2011-01-12 16:08:24 +0000 @@ -0,0 +1,2544 @@ +;;; ert.el --- Emacs Lisp Regression Testing + +;; Copyright (C) 2007, 2008, 2010, 2011 Free Software Foundation, Inc. + +;; Author: Christian Ohler +;; Keywords: lisp, tools + +;; This file is part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see `http://www.gnu.org/licenses/'. + +;;; Commentary: + +;; ERT is a tool for automated testing in Emacs Lisp. Its main +;; features are facilities for defining and running test cases and +;; reporting the results as well as for debugging test failures +;; interactively. +;; +;; The main entry points are `ert-deftest', which is similar to +;; `defun' but defines a test, and `ert-run-tests-interactively', +;; which runs tests and offers an interactive interface for inspecting +;; results and debugging. There is also +;; `ert-run-tests-batch-and-exit' for non-interactive use. +;; +;; The body of `ert-deftest' forms resembles a function body, but the +;; additional operators `should', `should-not' and `should-error' are +;; available. `should' is similar to cl's `assert', but signals a +;; different error when its condition is violated that is caught and +;; processed by ERT. In addition, it analyzes its argument form and +;; records information that helps debugging (`assert' tries to do +;; something similar when its second argument SHOW-ARGS is true, but +;; `should' is more sophisticated). For information on `should-not' +;; and `should-error', see their docstrings. +;; +;; See ERT's info manual as well as the docstrings for more details. +;; To compile the manual, run `makeinfo ert.texinfo' in the ERT +;; directory, then C-u M-x info ert.info in Emacs to view it. +;; +;; To see some examples of tests written in ERT, see its self-tests in +;; ert-tests.el. Some of these are tricky due to the bootstrapping +;; problem of writing tests for a testing tool, others test simple +;; functions and are straightforward. + +;;; Code: + +(eval-when-compile + (require 'cl)) +(require 'button) +(require 'debug) +(require 'easymenu) +(require 'ewoc) +(require 'find-func) +(require 'help) + + +;;; UI customization options. + +(defgroup ert () + "ERT, the Emacs Lisp regression testing tool." + :prefix "ert-" + :group 'lisp) + +(defface ert-test-result-expected '((((class color) (background light)) + :background "green1") + (((class color) (background dark)) + :background "green3")) + "Face used for expected results in the ERT results buffer." + :group 'ert) + +(defface ert-test-result-unexpected '((((class color) (background light)) + :background "red1") + (((class color) (background dark)) + :background "red3")) + "Face used for unexpected results in the ERT results buffer." + :group 'ert) + + +;;; Copies/reimplementations of cl functions. + +(defun ert--cl-do-remf (plist tag) + "Copy of `cl-do-remf'. Modify PLIST by removing TAG." + (let ((p (cdr plist))) + (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p)))) + (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) + +(defun ert--remprop (sym tag) + "Copy of `cl-remprop'. Modify SYM's plist by removing TAG." + (let ((plist (symbol-plist sym))) + (if (and plist (eq tag (car plist))) + (progn (setplist sym (cdr (cdr plist))) t) + (ert--cl-do-remf plist tag)))) + +(defun ert--remove-if-not (ert-pred ert-list) + "A reimplementation of `remove-if-not'. + +ERT-PRED is a predicate, ERT-LIST is the input list." + (loop for ert-x in ert-list + if (funcall ert-pred ert-x) + collect ert-x)) + +(defun ert--intersection (a b) + "A reimplementation of `intersection'. Intersect the sets A and B. + +Elements are compared using `eql'." + (loop for x in a + if (memql x b) + collect x)) + +(defun ert--set-difference (a b) + "A reimplementation of `set-difference'. Subtract the set B from the set A. + +Elements are compared using `eql'." + (loop for x in a + unless (memql x b) + collect x)) + +(defun ert--set-difference-eq (a b) + "A reimplementation of `set-difference'. Subtract the set B from the set A. + +Elements are compared using `eq'." + (loop for x in a + unless (memq x b) + collect x)) + +(defun ert--union (a b) + "A reimplementation of `union'. Compute the union of the sets A and B. + +Elements are compared using `eql'." + (append a (ert--set-difference b a))) + +(eval-and-compile + (defvar ert--gensym-counter 0)) + +(eval-and-compile + (defun ert--gensym (&optional prefix) + "Only allows string PREFIX, not compatible with CL." + (unless prefix (setq prefix "G")) + (make-symbol (format "%s%s" + prefix + (prog1 ert--gensym-counter + (incf ert--gensym-counter)))))) + +(defun ert--coerce-to-vector (x) + "Coerce X to a vector." + (when (char-table-p x) (error "Not supported")) + (if (vectorp x) + x + (vconcat x))) + +(defun* ert--remove* (x list &key key test) + "Does not support all the keywords of remove*." + (unless key (setq key #'identity)) + (unless test (setq test #'eql)) + (loop for y in list + unless (funcall test x (funcall key y)) + collect y)) + +(defun ert--string-position (c s) + "Return the position of the first occurrence of C in S, or nil if none." + (loop for i from 0 + for x across s + when (eql x c) return i)) + +(defun ert--mismatch (a b) + "Return index of first element that differs between A and B. + +Like `mismatch'. Uses `equal' for comparison." + (cond ((or (listp a) (listp b)) + (ert--mismatch (ert--coerce-to-vector a) + (ert--coerce-to-vector b))) + ((> (length a) (length b)) + (ert--mismatch b a)) + (t + (let ((la (length a)) + (lb (length b))) + (assert (arrayp a) t) + (assert (arrayp b) t) + (assert (<= la lb) t) + (loop for i below la + when (not (equal (aref a i) (aref b i))) return i + finally (return (if (/= la lb) + la + (assert (equal a b) t) + nil))))))) + +(defun ert--subseq (seq start &optional end) + "Return a subsequence of SEQ from START to END." + (when (char-table-p seq) (error "Not supported")) + (let ((vector (substring (ert--coerce-to-vector seq) start end))) + (etypecase seq + (vector vector) + (string (concat vector)) + (list (append vector nil)) + (bool-vector (loop with result = (make-bool-vector (length vector) nil) + for i below (length vector) do + (setf (aref result i) (aref vector i)) + finally (return result))) + (char-table (assert nil))))) + +(defun ert-equal-including-properties (a b) + "Return t if A and B have similar structure and contents. + +This is like `equal-including-properties' except that it compares +the property values of text properties structurally (by +recursing) rather than with `eq'. Perhaps this is what +`equal-including-properties' should do in the first place; see +Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'." + ;; This implementation is inefficient. Rather than making it + ;; efficient, let's hope bug 6581 gets fixed so that we can delete + ;; it altogether. + (not (ert--explain-not-equal-including-properties a b))) + + +;;; Defining and locating tests. + +;; The data structure that represents a test case. +(defstruct ert-test + (name nil) + (documentation nil) + (body (assert nil)) + (most-recent-result nil) + (expected-result-type ':passed) + (tags '())) + +(defun ert-test-boundp (symbol) + "Return non-nil if SYMBOL names a test." + (and (get symbol 'ert--test) t)) + +(defun ert-get-test (symbol) + "If SYMBOL names a test, return that. Signal an error otherwise." + (unless (ert-test-boundp symbol) (error "No test named `%S'" symbol)) + (get symbol 'ert--test)) + +(defun ert-set-test (symbol definition) + "Make SYMBOL name the test DEFINITION, and return DEFINITION." + (when (eq symbol 'nil) + ;; We disallow nil since `ert-test-at-point' and related functions + ;; want to return a test name, but also need an out-of-band value + ;; on failure. Nil is the most natural out-of-band value; using 0 + ;; or "" or signalling an error would be too awkward. + ;; + ;; Note that nil is still a valid value for the `name' slot in + ;; ert-test objects. It designates an anonymous test. + (error "Attempt to define a test named nil")) + (put symbol 'ert--test definition) + definition) + +(defun ert-make-test-unbound (symbol) + "Make SYMBOL name no test. Return SYMBOL." + (ert--remprop symbol 'ert--test) + symbol) + +(defun ert--parse-keys-and-body (keys-and-body) + "Split KEYS-AND-BODY into keyword-and-value pairs and the remaining body. + +KEYS-AND-BODY should have the form of a property list, with the +exception that only keywords are permitted as keys and that the +tail -- the body -- is a list of forms that does not start with a +keyword. + +Returns a two-element list containing the keys-and-values plist +and the body." + (let ((extracted-key-accu '()) + (remaining keys-and-body)) + (while (and (consp remaining) (keywordp (first remaining))) + (let ((keyword (pop remaining))) + (unless (consp remaining) + (error "Value expected after keyword %S in %S" + keyword keys-and-body)) + (when (assoc keyword extracted-key-accu) + (warn "Keyword %S appears more than once in %S" keyword + keys-and-body)) + (push (cons keyword (pop remaining)) extracted-key-accu))) + (setq extracted-key-accu (nreverse extracted-key-accu)) + (list (loop for (key . value) in extracted-key-accu + collect key + collect value) + remaining))) + +;;;###autoload +(defmacro* ert-deftest (name () &body docstring-keys-and-body) + "Define NAME (a symbol) as a test. + +BODY is evaluated as a `progn' when the test is run. It should +signal a condition on failure or just return if the test passes. + +`should', `should-not' and `should-error' are useful for +assertions in BODY. + +Use `ert' to run tests interactively. + +Tests that are expected to fail can be marked as such +using :expected-result. See `ert-test-result-type-p' for a +description of valid values for RESULT-TYPE. + +\(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] \ +\[:tags '(TAG...)] BODY...)" + (declare (debug (&define :name test + name sexp [&optional stringp] + [&rest keywordp sexp] def-body)) + (doc-string 3) + (indent 2)) + (let ((documentation nil) + (documentation-supplied-p nil)) + (when (stringp (first docstring-keys-and-body)) + (setq documentation (pop docstring-keys-and-body) + documentation-supplied-p t)) + (destructuring-bind ((&key (expected-result nil expected-result-supplied-p) + (tags nil tags-supplied-p)) + body) + (ert--parse-keys-and-body docstring-keys-and-body) + `(progn + (ert-set-test ',name + (make-ert-test + :name ',name + ,@(when documentation-supplied-p + `(:documentation ,documentation)) + ,@(when expected-result-supplied-p + `(:expected-result-type ,expected-result)) + ,@(when tags-supplied-p + `(:tags ,tags)) + :body (lambda () ,@body))) + ;; This hack allows `symbol-file' to associate `ert-deftest' + ;; forms with files, and therefore enables `find-function' to + ;; work with tests. However, it leads to warnings in + ;; `unload-feature', which doesn't know how to undefine tests + ;; and has no mechanism for extension. + (push '(ert-deftest . ,name) current-load-list) + ',name)))) + +;; We use these `put' forms in addition to the (declare (indent)) in +;; the defmacro form since the `declare' alone does not lead to +;; correct indentation before the .el/.elc file is loaded. +;; Autoloading these `put' forms solves this. +;;;###autoload +(progn + ;; TODO(ohler): Figure out what these mean and make sure they are correct. + (put 'ert-deftest 'lisp-indent-function 2) + (put 'ert-info 'lisp-indent-function 1)) + +(defvar ert--find-test-regexp + (concat "^\\s-*(ert-deftest" + find-function-space-re + "%s\\(\\s-\\|$\\)") + "The regexp the `find-function' mechanisms use for finding test definitions.") + + +(put 'ert-test-failed 'error-conditions '(error ert-test-failed)) +(put 'ert-test-failed 'error-message "Test failed") + +(defun ert-pass () + "Terminate the current test and mark it passed. Does not return." + (throw 'ert--pass nil)) + +(defun ert-fail (data) + "Terminate the current test and mark it failed. Does not return. +DATA is displayed to the user and should state the reason of the failure." + (signal 'ert-test-failed (list data))) + + +;;; The `should' macros. + +(defvar ert--should-execution-observer nil) + +(defun ert--signal-should-execution (form-description) + "Tell the current `should' form observer (if any) about FORM-DESCRIPTION." + (when ert--should-execution-observer + (funcall ert--should-execution-observer form-description))) + +(defun ert--special-operator-p (thing) + "Return non-nil if THING is a symbol naming a special operator." + (and (symbolp thing) + (let ((definition (indirect-function thing t))) + (and (subrp definition) + (eql (cdr (subr-arity definition)) 'unevalled))))) + +(defun ert--expand-should-1 (whole form inner-expander) + "Helper function for the `should' macro and its variants." + (let ((form + ;; If `cl-macroexpand' isn't bound, the code that we're + ;; compiling doesn't depend on cl and thus doesn't need an + ;; environment arg for `macroexpand'. + (if (fboundp 'cl-macroexpand) + ;; Suppress warning about run-time call to cl funtion: we + ;; only call it if it's fboundp. + (with-no-warnings + (cl-macroexpand form (and (boundp 'cl-macro-environment) + cl-macro-environment))) + (macroexpand form)))) + (cond + ((or (atom form) (ert--special-operator-p (car form))) + (let ((value (ert--gensym "value-"))) + `(let ((,value (ert--gensym "ert-form-evaluation-aborted-"))) + ,(funcall inner-expander + `(setq ,value ,form) + `(list ',whole :form ',form :value ,value) + value) + ,value))) + (t + (let ((fn-name (car form)) + (arg-forms (cdr form))) + (assert (or (symbolp fn-name) + (and (consp fn-name) + (eql (car fn-name) 'lambda) + (listp (cdr fn-name))))) + (let ((fn (ert--gensym "fn-")) + (args (ert--gensym "args-")) + (value (ert--gensym "value-")) + (default-value (ert--gensym "ert-form-evaluation-aborted-"))) + `(let ((,fn (function ,fn-name)) + (,args (list ,@arg-forms))) + (let ((,value ',default-value)) + ,(funcall inner-expander + `(setq ,value (apply ,fn ,args)) + `(nconc (list ',whole) + (list :form `(,,fn ,@,args)) + (unless (eql ,value ',default-value) + (list :value ,value)) + (let ((-explainer- + (and (symbolp ',fn-name) + (get ',fn-name 'ert-explainer)))) + (when -explainer- + (list :explanation + (apply -explainer- ,args))))) + value) + ,value)))))))) + +(defun ert--expand-should (whole form inner-expander) + "Helper function for the `should' macro and its variants. + +Analyzes FORM and returns an expression that has the same +semantics under evaluation but records additional debugging +information. + +INNER-EXPANDER should be a function and is called with two +arguments: INNER-FORM and FORM-DESCRIPTION-FORM, where INNER-FORM +is an expression equivalent to FORM, and FORM-DESCRIPTION-FORM is +an expression that returns a description of FORM. INNER-EXPANDER +should return code that calls INNER-FORM and performs the checks +and error signalling specific to the particular variant of +`should'. The code that INNER-EXPANDER returns must not call +FORM-DESCRIPTION-FORM before it has called INNER-FORM." + (lexical-let ((inner-expander inner-expander)) + (ert--expand-should-1 + whole form + (lambda (inner-form form-description-form value-var) + (let ((form-description (ert--gensym "form-description-"))) + `(let (,form-description) + ,(funcall inner-expander + `(unwind-protect + ,inner-form + (setq ,form-description ,form-description-form) + (ert--signal-should-execution ,form-description)) + `,form-description + value-var))))))) + +(defmacro* should (form) + "Evaluate FORM. If it returns nil, abort the current test as failed. + +Returns the value of FORM." + (ert--expand-should `(should ,form) form + (lambda (inner-form form-description-form value-var) + `(unless ,inner-form + (ert-fail ,form-description-form))))) + +(defmacro* should-not (form) + "Evaluate FORM. If it returns non-nil, abort the current test as failed. + +Returns nil." + (ert--expand-should `(should-not ,form) form + (lambda (inner-form form-description-form value-var) + `(unless (not ,inner-form) + (ert-fail ,form-description-form))))) + +(defun ert--should-error-handle-error (form-description-fn + condition type exclude-subtypes) + "Helper function for `should-error'. + +Determines whether CONDITION matches TYPE and EXCLUDE-SUBTYPES, +and aborts the current test as failed if it doesn't." + (let ((signalled-conditions (get (car condition) 'error-conditions)) + (handled-conditions (etypecase type + (list type) + (symbol (list type))))) + (assert signalled-conditions) + (unless (ert--intersection signalled-conditions handled-conditions) + (ert-fail (append + (funcall form-description-fn) + (list + :condition condition + :fail-reason (concat "the error signalled did not" + " have the expected type"))))) + (when exclude-subtypes + (unless (member (car condition) handled-conditions) + (ert-fail (append + (funcall form-description-fn) + (list + :condition condition + :fail-reason (concat "the error signalled was a subtype" + " of the expected type")))))))) + +;; FIXME: The expansion will evaluate the keyword args (if any) in +;; nonstandard order. +(defmacro* should-error (form &rest keys &key type exclude-subtypes) + "Evaluate FORM and check that it signals an error. + +The error signalled needs to match TYPE. TYPE should be a list +of condition names. (It can also be a non-nil symbol, which is +equivalent to a singleton list containing that symbol.) If +EXCLUDE-SUBTYPES is nil, the error matches TYPE if one of its +condition names is an element of TYPE. If EXCLUDE-SUBTYPES is +non-nil, the error matches TYPE if it is an element of TYPE. + +If the error matches, returns (ERROR-SYMBOL . DATA) from the +error. If not, or if no error was signalled, abort the test as +failed." + (unless type (setq type ''error)) + (ert--expand-should + `(should-error ,form ,@keys) + form + (lambda (inner-form form-description-form value-var) + (let ((errorp (ert--gensym "errorp")) + (form-description-fn (ert--gensym "form-description-fn-"))) + `(let ((,errorp nil) + (,form-description-fn (lambda () ,form-description-form))) + (condition-case -condition- + ,inner-form + ;; We can't use ,type here because we want to evaluate it. + (error + (setq ,errorp t) + (ert--should-error-handle-error ,form-description-fn + -condition- + ,type ,exclude-subtypes) + (setq ,value-var -condition-))) + (unless ,errorp + (ert-fail (append + (funcall ,form-description-fn) + (list + :fail-reason "did not signal an error"))))))))) + + +;;; Explanation of `should' failures. + +;; TODO(ohler): Rework explanations so that they are displayed in a +;; similar way to `ert-info' messages; in particular, allow text +;; buttons in explanations that give more detail or open an ediff +;; buffer. Perhaps explanations should be reported through `ert-info' +;; rather than as part of the condition. + +(defun ert--proper-list-p (x) + "Return non-nil if X is a proper list, nil otherwise." + (loop + for firstp = t then nil + for fast = x then (cddr fast) + for slow = x then (cdr slow) do + (when (null fast) (return t)) + (when (not (consp fast)) (return nil)) + (when (null (cdr fast)) (return t)) + (when (not (consp (cdr fast))) (return nil)) + (when (and (not firstp) (eq fast slow)) (return nil)))) + +(defun ert--explain-format-atom (x) + "Format the atom X for `ert--explain-not-equal'." + (typecase x + (fixnum (list x (format "#x%x" x) (format "?%c" x))) + (t x))) + +(defun ert--explain-not-equal (a b) + "Explainer function for `equal'. + +Returns a programmer-readable explanation of why A and B are not +`equal', or nil if they are." + (if (not (equal (type-of a) (type-of b))) + `(different-types ,a ,b) + (etypecase a + (cons + (let ((a-proper-p (ert--proper-list-p a)) + (b-proper-p (ert--proper-list-p b))) + (if (not (eql (not a-proper-p) (not b-proper-p))) + `(one-list-proper-one-improper ,a ,b) + (if a-proper-p + (if (not (equal (length a) (length b))) + `(proper-lists-of-different-length ,(length a) ,(length b) + ,a ,b + first-mismatch-at + ,(ert--mismatch a b)) + (loop for i from 0 + for ai in a + for bi in b + for xi = (ert--explain-not-equal ai bi) + do (when xi (return `(list-elt ,i ,xi))) + finally (assert (equal a b) t))) + (let ((car-x (ert--explain-not-equal (car a) (car b)))) + (if car-x + `(car ,car-x) + (let ((cdr-x (ert--explain-not-equal (cdr a) (cdr b)))) + (if cdr-x + `(cdr ,cdr-x) + (assert (equal a b) t) + nil)))))))) + (array (if (not (equal (length a) (length b))) + `(arrays-of-different-length ,(length a) ,(length b) + ,a ,b + ,@(unless (char-table-p a) + `(first-mismatch-at + ,(ert--mismatch a b)))) + (loop for i from 0 + for ai across a + for bi across b + for xi = (ert--explain-not-equal ai bi) + do (when xi (return `(array-elt ,i ,xi))) + finally (assert (equal a b) t)))) + (atom (if (not (equal a b)) + (if (and (symbolp a) (symbolp b) (string= a b)) + `(different-symbols-with-the-same-name ,a ,b) + `(different-atoms ,(ert--explain-format-atom a) + ,(ert--explain-format-atom b))) + nil))))) +(put 'equal 'ert-explainer 'ert--explain-not-equal) + +(defun ert--significant-plist-keys (plist) + "Return the keys of PLIST that have non-null values, in order." + (assert (zerop (mod (length plist) 2)) t) + (loop for (key value . rest) on plist by #'cddr + unless (or (null value) (memq key accu)) collect key into accu + finally (return accu))) + +(defun ert--plist-difference-explanation (a b) + "Return a programmer-readable explanation of why A and B are different plists. + +Returns nil if they are equivalent, i.e., have the same value for +each key, where absent values are treated as nil. The order of +key/value pairs in each list does not matter." + (assert (zerop (mod (length a) 2)) t) + (assert (zerop (mod (length b) 2)) t) + ;; Normalizing the plists would be another way to do this but it + ;; requires a total ordering on all lisp objects (since any object + ;; is valid as a text property key). Perhaps defining such an + ;; ordering is useful in other contexts, too, but it's a lot of + ;; work, so let's punt on it for now. + (let* ((keys-a (ert--significant-plist-keys a)) + (keys-b (ert--significant-plist-keys b)) + (keys-in-a-not-in-b (ert--set-difference-eq keys-a keys-b)) + (keys-in-b-not-in-a (ert--set-difference-eq keys-b keys-a))) + (flet ((explain-with-key (key) + (let ((value-a (plist-get a key)) + (value-b (plist-get b key))) + (assert (not (equal value-a value-b)) t) + `(different-properties-for-key + ,key ,(ert--explain-not-equal-including-properties value-a + value-b))))) + (cond (keys-in-a-not-in-b + (explain-with-key (first keys-in-a-not-in-b))) + (keys-in-b-not-in-a + (explain-with-key (first keys-in-b-not-in-a))) + (t + (loop for key in keys-a + when (not (equal (plist-get a key) (plist-get b key))) + return (explain-with-key key))))))) + +(defun ert--abbreviate-string (s len suffixp) + "Shorten string S to at most LEN chars. + +If SUFFIXP is non-nil, returns a suffix of S, otherwise a prefix." + (let ((n (length s))) + (cond ((< n len) + s) + (suffixp + (substring s (- n len))) + (t + (substring s 0 len))))) + +(defun ert--explain-not-equal-including-properties (a b) + "Explainer function for `ert-equal-including-properties'. + +Returns a programmer-readable explanation of why A and B are not +`ert-equal-including-properties', or nil if they are." + (if (not (equal a b)) + (ert--explain-not-equal a b) + (assert (stringp a) t) + (assert (stringp b) t) + (assert (eql (length a) (length b)) t) + (loop for i from 0 to (length a) + for props-a = (text-properties-at i a) + for props-b = (text-properties-at i b) + for difference = (ert--plist-difference-explanation props-a props-b) + do (when difference + (return `(char ,i ,(substring-no-properties a i (1+ i)) + ,difference + context-before + ,(ert--abbreviate-string + (substring-no-properties a 0 i) + 10 t) + context-after + ,(ert--abbreviate-string + (substring-no-properties a (1+ i)) + 10 nil)))) + ;; TODO(ohler): Get `equal-including-properties' fixed in + ;; Emacs, delete `ert-equal-including-properties', and + ;; re-enable this assertion. + ;;finally (assert (equal-including-properties a b) t) + ))) +(put 'ert-equal-including-properties + 'ert-explainer + 'ert--explain-not-equal-including-properties) + + +;;; Implementation of `ert-info'. + +;; TODO(ohler): The name `info' clashes with +;; `ert--test-execution-info'. One or both should be renamed. +(defvar ert--infos '() + "The stack of `ert-info' infos that currently apply. + +Bound dynamically. This is a list of (PREFIX . MESSAGE) pairs.") + +(defmacro* ert-info ((message-form &key ((:prefix prefix-form) "Info: ")) + &body body) + "Evaluate MESSAGE-FORM and BODY, and report the message if BODY fails. + +To be used within ERT tests. MESSAGE-FORM should evaluate to a +string that will be displayed together with the test result if +the test fails. PREFIX-FORM should evaluate to a string as well +and is displayed in front of the value of MESSAGE-FORM." + (declare (debug ((form &rest [sexp form]) body)) + (indent 1)) + `(let ((ert--infos (cons (cons ,prefix-form ,message-form) ert--infos))) + ,@body)) + + + +;;; Facilities for running a single test. + +(defvar ert-debug-on-error nil + "Non-nil means enter debugger when a test fails or terminates with an error.") + +;; The data structures that represent the result of running a test. +(defstruct ert-test-result + (messages nil) + (should-forms nil) + ) +(defstruct (ert-test-passed (:include ert-test-result))) +(defstruct (ert-test-result-with-condition (:include ert-test-result)) + (condition (assert nil)) + (backtrace (assert nil)) + (infos (assert nil))) +(defstruct (ert-test-quit (:include ert-test-result-with-condition))) +(defstruct (ert-test-failed (:include ert-test-result-with-condition))) +(defstruct (ert-test-aborted-with-non-local-exit (:include ert-test-result))) + + +(defun ert--record-backtrace () + "Record the current backtrace (as a list) and return it." + ;; Since the backtrace is stored in the result object, result + ;; objects must only be printed with appropriate limits + ;; (`print-level' and `print-length') in place. For interactive + ;; use, the cost of ensuring this possibly outweighs the advantage + ;; of storing the backtrace for + ;; `ert-results-pop-to-backtrace-for-test-at-point' given that we + ;; already have `ert-results-rerun-test-debugging-errors-at-point'. + ;; For batch use, however, printing the backtrace may be useful. + (loop + ;; 6 is the number of frames our own debugger adds (when + ;; compiled; more when interpreted). FIXME: Need to describe a + ;; procedure for determining this constant. + for i from 6 + for frame = (backtrace-frame i) + while frame + collect frame)) + +(defun ert--print-backtrace (backtrace) + "Format the backtrace BACKTRACE to the current buffer." + ;; This is essentially a reimplementation of Fbacktrace + ;; (src/eval.c), but for a saved backtrace, not the current one. + (let ((print-escape-newlines t) + (print-level 8) + (print-length 50)) + (dolist (frame backtrace) + (ecase (first frame) + ((nil) + ;; Special operator. + (destructuring-bind (special-operator &rest arg-forms) + (cdr frame) + (insert + (format " %S\n" (list* special-operator arg-forms))))) + ((t) + ;; Function call. + (destructuring-bind (fn &rest args) (cdr frame) + (insert (format " %S(" fn)) + (loop for firstp = t then nil + for arg in args do + (unless firstp + (insert " ")) + (insert (format "%S" arg))) + (insert ")\n"))))))) + +;; A container for the state of the execution of a single test and +;; environment data needed during its execution. +(defstruct ert--test-execution-info + (test (assert nil)) + (result (assert nil)) + ;; A thunk that may be called when RESULT has been set to its final + ;; value and test execution should be terminated. Should not + ;; return. + (exit-continuation (assert nil)) + ;; The binding of `debugger' outside of the execution of the test. + next-debugger + ;; The binding of `ert-debug-on-error' that is in effect for the + ;; execution of the current test. We store it to avoid being + ;; affected by any new bindings the test itself may establish. (I + ;; don't remember whether this feature is important.) + ert-debug-on-error) + +(defun ert--run-test-debugger (info debugger-args) + "During a test run, `debugger' is bound to a closure that calls this function. + +This function records failures and errors and either terminates +the test silently or calls the interactive debugger, as +appropriate. + +INFO is the ert--test-execution-info corresponding to this test +run. DEBUGGER-ARGS are the arguments to `debugger'." + (destructuring-bind (first-debugger-arg &rest more-debugger-args) + debugger-args + (ecase first-debugger-arg + ((lambda debug t exit nil) + (apply (ert--test-execution-info-next-debugger info) debugger-args)) + (error + (let* ((condition (first more-debugger-args)) + (type (case (car condition) + ((quit) 'quit) + (otherwise 'failed))) + (backtrace (ert--record-backtrace)) + (infos (reverse ert--infos))) + (setf (ert--test-execution-info-result info) + (ecase type + (quit + (make-ert-test-quit :condition condition + :backtrace backtrace + :infos infos)) + (failed + (make-ert-test-failed :condition condition + :backtrace backtrace + :infos infos)))) + ;; Work around Emacs' heuristic (in eval.c) for detecting + ;; errors in the debugger. + (incf num-nonmacro-input-events) + ;; FIXME: We should probably implement more fine-grained + ;; control a la non-t `debug-on-error' here. + (cond + ((ert--test-execution-info-ert-debug-on-error info) + (apply (ert--test-execution-info-next-debugger info) debugger-args)) + (t)) + (funcall (ert--test-execution-info-exit-continuation info))))))) + +(defun ert--run-test-internal (ert-test-execution-info) + "Low-level function to run a test according to ERT-TEST-EXECUTION-INFO. + +This mainly sets up debugger-related bindings." + (lexical-let ((info ert-test-execution-info)) + (setf (ert--test-execution-info-next-debugger info) debugger + (ert--test-execution-info-ert-debug-on-error info) ert-debug-on-error) + (catch 'ert--pass + ;; For now, each test gets its own temp buffer and its own + ;; window excursion, just to be safe. If this turns out to be + ;; too expensive, we can remove it. + (with-temp-buffer + (save-window-excursion + (let ((debugger (lambda (&rest debugger-args) + (ert--run-test-debugger info debugger-args))) + (debug-on-error t) + (debug-on-quit t) + ;; FIXME: Do we need to store the old binding of this + ;; and consider it in `ert--run-test-debugger'? + (debug-ignored-errors nil) + (ert--infos '())) + (funcall (ert-test-body (ert--test-execution-info-test info)))))) + (ert-pass)) + (setf (ert--test-execution-info-result info) (make-ert-test-passed))) + nil) + +(defun ert--force-message-log-buffer-truncation () + "Immediately truncate *Messages* buffer according to `message-log-max'. + +This can be useful after reducing the value of `message-log-max'." + (with-current-buffer (get-buffer-create "*Messages*") + ;; This is a reimplementation of this part of message_dolog() in xdisp.c: + ;; if (NATNUMP (Vmessage_log_max)) + ;; { + ;; scan_newline (Z, Z_BYTE, BEG, BEG_BYTE, + ;; -XFASTINT (Vmessage_log_max) - 1, 0); + ;; del_range_both (BEG, BEG_BYTE, PT, PT_BYTE, 0); + ;; } + (when (and (integerp message-log-max) (>= message-log-max 0)) + (let ((begin (point-min)) + (end (save-excursion + (goto-char (point-max)) + (forward-line (- message-log-max)) + (point)))) + (delete-region begin end))))) + +(defvar ert--running-tests nil + "List of tests that are currently in execution. + +This list is empty while no test is running, has one element +while a test is running, two elements while a test run from +inside a test is running, etc. The list is in order of nesting, +innermost test first. + +The elements are of type `ert-test'.") + +(defun ert-run-test (ert-test) + "Run ERT-TEST. + +Returns the result and stores it in ERT-TEST's `most-recent-result' slot." + (setf (ert-test-most-recent-result ert-test) nil) + (block error + (lexical-let ((begin-marker + (with-current-buffer (get-buffer-create "*Messages*") + (set-marker (make-marker) (point-max))))) + (unwind-protect + (lexical-let ((info (make-ert--test-execution-info + :test ert-test + :result + (make-ert-test-aborted-with-non-local-exit) + :exit-continuation (lambda () + (return-from error nil)))) + (should-form-accu (list))) + (unwind-protect + (let ((ert--should-execution-observer + (lambda (form-description) + (push form-description should-form-accu))) + (message-log-max t) + (ert--running-tests (cons ert-test ert--running-tests))) + (ert--run-test-internal info)) + (let ((result (ert--test-execution-info-result info))) + (setf (ert-test-result-messages result) + (with-current-buffer (get-buffer-create "*Messages*") + (buffer-substring begin-marker (point-max)))) + (ert--force-message-log-buffer-truncation) + (setq should-form-accu (nreverse should-form-accu)) + (setf (ert-test-result-should-forms result) + should-form-accu) + (setf (ert-test-most-recent-result ert-test) result)))) + (set-marker begin-marker nil)))) + (ert-test-most-recent-result ert-test)) + +(defun ert-running-test () + "Return the top-level test currently executing." + (car (last ert--running-tests))) + + +;;; Test selectors. + +(defun ert-test-result-type-p (result result-type) + "Return non-nil if RESULT matches type RESULT-TYPE. + +Valid result types: + +nil -- Never matches. +t -- Always matches. +:failed, :passed -- Matches corresponding results. +\(and TYPES...\) -- Matches if all TYPES match. +\(or TYPES...\) -- Matches if some TYPES match. +\(not TYPE\) -- Matches if TYPE does not match. +\(satisfies PREDICATE\) -- Matches if PREDICATE returns true when called with + RESULT." + ;; It would be easy to add `member' and `eql' types etc., but I + ;; haven't bothered yet. + (etypecase result-type + ((member nil) nil) + ((member t) t) + ((member :failed) (ert-test-failed-p result)) + ((member :passed) (ert-test-passed-p result)) + (cons + (destructuring-bind (operator &rest operands) result-type + (ecase operator + (and + (case (length operands) + (0 t) + (t + (and (ert-test-result-type-p result (first operands)) + (ert-test-result-type-p result `(and ,@(rest operands))))))) + (or + (case (length operands) + (0 nil) + (t + (or (ert-test-result-type-p result (first operands)) + (ert-test-result-type-p result `(or ,@(rest operands))))))) + (not + (assert (eql (length operands) 1)) + (not (ert-test-result-type-p result (first operands)))) + (satisfies + (assert (eql (length operands) 1)) + (funcall (first operands) result))))))) + +(defun ert-test-result-expected-p (test result) + "Return non-nil if TEST's expected result type matches RESULT." + (ert-test-result-type-p result (ert-test-expected-result-type test))) + +(defun ert-select-tests (selector universe) + "Return the tests that match SELECTOR. + +UNIVERSE specifies the set of tests to select from; it should be +a list of tests, or t, which refers to all tests named by symbols +in `obarray'. + +Returns the set of tests as a list. + +Valid selectors: + +nil -- Selects the empty set. +t -- Selects UNIVERSE. +:new -- Selects all tests that have not been run yet. +:failed, :passed -- Select tests according to their most recent result. +:expected, :unexpected -- Select tests according to their most recent result. +a string -- Selects all tests that have a name that matches the string, + a regexp. +a test -- Selects that test. +a symbol -- Selects the test that the symbol names, errors if none. +\(member TESTS...\) -- Selects TESTS, a list of tests or symbols naming tests. +\(eql TEST\) -- Selects TEST, a test or a symbol naming a test. +\(and SELECTORS...\) -- Selects the tests that match all SELECTORS. +\(or SELECTORS...\) -- Selects the tests that match any SELECTOR. +\(not SELECTOR\) -- Selects all tests that do not match SELECTOR. +\(tag TAG) -- Selects all tests that have TAG on their tags list. +\(satisfies PREDICATE\) -- Selects all tests that satisfy PREDICATE. + +Only selectors that require a superset of tests, such +as (satisfies ...), strings, :new, etc. make use of UNIVERSE. +Selectors that do not, such as \(member ...\), just return the +set implied by them without checking whether it is really +contained in UNIVERSE." + ;; This code needs to match the etypecase in + ;; `ert-insert-human-readable-selector'. + (etypecase selector + ((member nil) nil) + ((member t) (etypecase universe + (list universe) + ((member t) (ert-select-tests "" universe)))) + ((member :new) (ert-select-tests + `(satisfies ,(lambda (test) + (null (ert-test-most-recent-result test)))) + universe)) + ((member :failed) (ert-select-tests + `(satisfies ,(lambda (test) + (ert-test-result-type-p + (ert-test-most-recent-result test) + ':failed))) + universe)) + ((member :passed) (ert-select-tests + `(satisfies ,(lambda (test) + (ert-test-result-type-p + (ert-test-most-recent-result test) + ':passed))) + universe)) + ((member :expected) (ert-select-tests + `(satisfies + ,(lambda (test) + (ert-test-result-expected-p + test + (ert-test-most-recent-result test)))) + universe)) + ((member :unexpected) (ert-select-tests `(not :expected) universe)) + (string + (etypecase universe + ((member t) (mapcar #'ert-get-test + (apropos-internal selector #'ert-test-boundp))) + (list (ert--remove-if-not (lambda (test) + (and (ert-test-name test) + (string-match selector + (ert-test-name test)))) + universe)))) + (ert-test (list selector)) + (symbol + (assert (ert-test-boundp selector)) + (list (ert-get-test selector))) + (cons + (destructuring-bind (operator &rest operands) selector + (ecase operator + (member + (mapcar (lambda (purported-test) + (etypecase purported-test + (symbol (assert (ert-test-boundp purported-test)) + (ert-get-test purported-test)) + (ert-test purported-test))) + operands)) + (eql + (assert (eql (length operands) 1)) + (ert-select-tests `(member ,@operands) universe)) + (and + ;; Do these definitions of AND, NOT and OR satisfy de + ;; Morgan's laws? Should they? + (case (length operands) + (0 (ert-select-tests 't universe)) + (t (ert-select-tests `(and ,@(rest operands)) + (ert-select-tests (first operands) + universe))))) + (not + (assert (eql (length operands) 1)) + (let ((all-tests (ert-select-tests 't universe))) + (ert--set-difference all-tests + (ert-select-tests (first operands) + all-tests)))) + (or + (case (length operands) + (0 (ert-select-tests 'nil universe)) + (t (ert--union (ert-select-tests (first operands) universe) + (ert-select-tests `(or ,@(rest operands)) + universe))))) + (tag + (assert (eql (length operands) 1)) + (let ((tag (first operands))) + (ert-select-tests `(satisfies + ,(lambda (test) + (member tag (ert-test-tags test)))) + universe))) + (satisfies + (assert (eql (length operands) 1)) + (ert--remove-if-not (first operands) + (ert-select-tests 't universe)))))))) + +(defun ert--insert-human-readable-selector (selector) + "Insert a human-readable presentation of SELECTOR into the current buffer." + ;; This is needed to avoid printing the (huge) contents of the + ;; `backtrace' slot of the result objects in the + ;; `most-recent-result' slots of test case objects in (eql ...) or + ;; (member ...) selectors. + (labels ((rec (selector) + ;; This code needs to match the etypecase in `ert-select-tests'. + (etypecase selector + ((or (member nil t + :new :failed :passed + :expected :unexpected) + string + symbol) + selector) + (ert-test + (if (ert-test-name selector) + (make-symbol (format "<%S>" (ert-test-name selector))) + (make-symbol ""))) + (cons + (destructuring-bind (operator &rest operands) selector + (ecase operator + ((member eql and not or) + `(,operator ,@(mapcar #'rec operands))) + ((member tag satisfies) + selector))))))) + (insert (format "%S" (rec selector))))) + + +;;; Facilities for running a whole set of tests. + +;; The data structure that contains the set of tests being executed +;; during one particular test run, their results, the state of the +;; execution, and some statistics. +;; +;; The data about results and expected results of tests may seem +;; redundant here, since the test objects also carry such information. +;; However, the information in the test objects may be more recent, it +;; may correspond to a different test run. We need the information +;; that corresponds to this run in order to be able to update the +;; statistics correctly when a test is re-run interactively and has a +;; different result than before. +(defstruct ert--stats + (selector (assert nil)) + ;; The tests, in order. + (tests (assert nil) :type vector) + ;; A map of test names (or the test objects themselves for unnamed + ;; tests) to indices into the `tests' vector. + (test-map (assert nil) :type hash-table) + ;; The results of the tests during this run, in order. + (test-results (assert nil) :type vector) + ;; The start times of the tests, in order, as reported by + ;; `current-time'. + (test-start-times (assert nil) :type vector) + ;; The end times of the tests, in order, as reported by + ;; `current-time'. + (test-end-times (assert nil) :type vector) + (passed-expected 0) + (passed-unexpected 0) + (failed-expected 0) + (failed-unexpected 0) + (start-time nil) + (end-time nil) + (aborted-p nil) + (current-test nil) + ;; The time at or after which the next redisplay should occur, as a + ;; float. + (next-redisplay 0.0)) + +(defun ert-stats-completed-expected (stats) + "Return the number of tests in STATS that had expected results." + (+ (ert--stats-passed-expected stats) + (ert--stats-failed-expected stats))) + +(defun ert-stats-completed-unexpected (stats) + "Return the number of tests in STATS that had unexpected results." + (+ (ert--stats-passed-unexpected stats) + (ert--stats-failed-unexpected stats))) + +(defun ert-stats-completed (stats) + "Number of tests in STATS that have run so far." + (+ (ert-stats-completed-expected stats) + (ert-stats-completed-unexpected stats))) + +(defun ert-stats-total (stats) + "Number of tests in STATS, regardless of whether they have run yet." + (length (ert--stats-tests stats))) + +;; The stats object of the current run, dynamically bound. This is +;; used for the mode line progress indicator. +(defvar ert--current-run-stats nil) + +(defun ert--stats-test-key (test) + "Return the key used for TEST in the test map of ert--stats objects. + +Returns the name of TEST if it has one, or TEST itself otherwise." + (or (ert-test-name test) test)) + +(defun ert--stats-set-test-and-result (stats pos test result) + "Change STATS by replacing the test at position POS with TEST and RESULT. + +Also changes the counters in STATS to match." + (let* ((tests (ert--stats-tests stats)) + (results (ert--stats-test-results stats)) + (old-test (aref tests pos)) + (map (ert--stats-test-map stats))) + (flet ((update (d) + (if (ert-test-result-expected-p (aref tests pos) + (aref results pos)) + (etypecase (aref results pos) + (ert-test-passed (incf (ert--stats-passed-expected stats) d)) + (ert-test-failed (incf (ert--stats-failed-expected stats) d)) + (null) + (ert-test-aborted-with-non-local-exit)) + (etypecase (aref results pos) + (ert-test-passed (incf (ert--stats-passed-unexpected stats) d)) + (ert-test-failed (incf (ert--stats-failed-unexpected stats) d)) + (null) + (ert-test-aborted-with-non-local-exit))))) + ;; Adjust counters to remove the result that is currently in stats. + (update -1) + ;; Put new test and result into stats. + (setf (aref tests pos) test + (aref results pos) result) + (remhash (ert--stats-test-key old-test) map) + (setf (gethash (ert--stats-test-key test) map) pos) + ;; Adjust counters to match new result. + (update +1) + nil))) + +(defun ert--make-stats (tests selector) + "Create a new `ert--stats' object for running TESTS. + +SELECTOR is the selector that was used to select TESTS." + (setq tests (ert--coerce-to-vector tests)) + (let ((map (make-hash-table :size (length tests)))) + (loop for i from 0 + for test across tests + for key = (ert--stats-test-key test) do + (assert (not (gethash key map))) + (setf (gethash key map) i)) + (make-ert--stats :selector selector + :tests tests + :test-map map + :test-results (make-vector (length tests) nil) + :test-start-times (make-vector (length tests) nil) + :test-end-times (make-vector (length tests) nil)))) + +(defun ert-run-or-rerun-test (stats test listener) + ;; checkdoc-order: nil + "Run the single test TEST and record the result using STATS and LISTENER." + (let ((ert--current-run-stats stats) + (pos (ert--stats-test-pos stats test))) + (ert--stats-set-test-and-result stats pos test nil) + ;; Call listener after setting/before resetting + ;; (ert--stats-current-test stats); the listener might refresh the + ;; mode line display, and if the value is not set yet/any more + ;; during this refresh, the mode line will flicker unnecessarily. + (setf (ert--stats-current-test stats) test) + (funcall listener 'test-started stats test) + (setf (ert-test-most-recent-result test) nil) + (setf (aref (ert--stats-test-start-times stats) pos) (current-time)) + (unwind-protect + (ert-run-test test) + (setf (aref (ert--stats-test-end-times stats) pos) (current-time)) + (let ((result (ert-test-most-recent-result test))) + (ert--stats-set-test-and-result stats pos test result) + (funcall listener 'test-ended stats test result)) + (setf (ert--stats-current-test stats) nil)))) + +(defun ert-run-tests (selector listener) + "Run the tests specified by SELECTOR, sending progress updates to LISTENER." + (let* ((tests (ert-select-tests selector t)) + (stats (ert--make-stats tests selector))) + (setf (ert--stats-start-time stats) (current-time)) + (funcall listener 'run-started stats) + (let ((abortedp t)) + (unwind-protect + (let ((ert--current-run-stats stats)) + (force-mode-line-update) + (unwind-protect + (progn + (loop for test in tests do + (ert-run-or-rerun-test stats test listener)) + (setq abortedp nil)) + (setf (ert--stats-aborted-p stats) abortedp) + (setf (ert--stats-end-time stats) (current-time)) + (funcall listener 'run-ended stats abortedp))) + (force-mode-line-update)) + stats))) + +(defun ert--stats-test-pos (stats test) + ;; checkdoc-order: nil + "Return the position (index) of TEST in the run represented by STATS." + (gethash (ert--stats-test-key test) (ert--stats-test-map stats))) + + +;;; Formatting functions shared across UIs. + +(defun ert--format-time-iso8601 (time) + "Format TIME in the variant of ISO 8601 used for timestamps in ERT." + (format-time-string "%Y-%m-%d %T%z" time)) + +(defun ert-char-for-test-result (result expectedp) + "Return a character that represents the test result RESULT. + +EXPECTEDP specifies whether the result was expected." + (let ((s (etypecase result + (ert-test-passed ".P") + (ert-test-failed "fF") + (null "--") + (ert-test-aborted-with-non-local-exit "aA")))) + (elt s (if expectedp 0 1)))) + +(defun ert-string-for-test-result (result expectedp) + "Return a string that represents the test result RESULT. + +EXPECTEDP specifies whether the result was expected." + (let ((s (etypecase result + (ert-test-passed '("passed" "PASSED")) + (ert-test-failed '("failed" "FAILED")) + (null '("unknown" "UNKNOWN")) + (ert-test-aborted-with-non-local-exit '("aborted" "ABORTED"))))) + (elt s (if expectedp 0 1)))) + +(defun ert--pp-with-indentation-and-newline (object) + "Pretty-print OBJECT, indenting it to the current column of point. +Ensures a final newline is inserted." + (let ((begin (point))) + (pp object (current-buffer)) + (unless (bolp) (insert "\n")) + (save-excursion + (goto-char begin) + (indent-sexp)))) + +(defun ert--insert-infos (result) + "Insert `ert-info' infos from RESULT into current buffer. + +RESULT must be an `ert-test-result-with-condition'." + (check-type result ert-test-result-with-condition) + (dolist (info (ert-test-result-with-condition-infos result)) + (destructuring-bind (prefix . message) info + (let ((begin (point)) + (indentation (make-string (+ (length prefix) 4) ?\s)) + (end nil)) + (unwind-protect + (progn + (insert message "\n") + (setq end (copy-marker (point))) + (goto-char begin) + (insert " " prefix) + (forward-line 1) + (while (< (point) end) + (insert indentation) + (forward-line 1))) + (when end (set-marker end nil))))))) + + +;;; Running tests in batch mode. + +(defvar ert-batch-backtrace-right-margin 70 + "*The maximum line length for printing backtraces in `ert-run-tests-batch'.") + +;;;###autoload +(defun ert-run-tests-batch (&optional selector) + "Run the tests specified by SELECTOR, printing results to the terminal. + +SELECTOR works as described in `ert-select-tests', except if +SELECTOR is nil, in which case all tests rather than none will be +run; this makes the command line \"emacs -batch -l my-tests.el -f +ert-run-tests-batch-and-exit\" useful. + +Returns the stats object." + (unless selector (setq selector 't)) + (ert-run-tests + selector + (lambda (event-type &rest event-args) + (ecase event-type + (run-started + (destructuring-bind (stats) event-args + (message "Running %s tests (%s)" + (length (ert--stats-tests stats)) + (ert--format-time-iso8601 (ert--stats-start-time stats))))) + (run-ended + (destructuring-bind (stats abortedp) event-args + (let ((unexpected (ert-stats-completed-unexpected stats)) + (expected-failures (ert--stats-failed-expected stats))) + (message "\n%sRan %s tests, %s results as expected%s (%s)%s\n" + (if (not abortedp) + "" + "Aborted: ") + (ert-stats-total stats) + (ert-stats-completed-expected stats) + (if (zerop unexpected) + "" + (format ", %s unexpected" unexpected)) + (ert--format-time-iso8601 (ert--stats-end-time stats)) + (if (zerop expected-failures) + "" + (format "\n%s expected failures" expected-failures))) + (unless (zerop unexpected) + (message "%s unexpected results:" unexpected) + (loop for test across (ert--stats-tests stats) + for result = (ert-test-most-recent-result test) do + (when (not (ert-test-result-expected-p test result)) + (message "%9s %S" + (ert-string-for-test-result result nil) + (ert-test-name test)))) + (message "%s" ""))))) + (test-started + ) + (test-ended + (destructuring-bind (stats test result) event-args + (unless (ert-test-result-expected-p test result) + (etypecase result + (ert-test-passed + (message "Test %S passed unexpectedly" (ert-test-name test))) + (ert-test-result-with-condition + (message "Test %S backtrace:" (ert-test-name test)) + (with-temp-buffer + (ert--print-backtrace (ert-test-result-with-condition-backtrace + result)) + (goto-char (point-min)) + (while (not (eobp)) + (let ((start (point)) + (end (progn (end-of-line) (point)))) + (setq end (min end + (+ start ert-batch-backtrace-right-margin))) + (message "%s" (buffer-substring-no-properties + start end))) + (forward-line 1))) + (with-temp-buffer + (ert--insert-infos result) + (insert " ") + (let ((print-escape-newlines t) + (print-level 5) + (print-length 10)) + (let ((begin (point))) + (ert--pp-with-indentation-and-newline + (ert-test-result-with-condition-condition result)))) + (goto-char (1- (point-max))) + (assert (looking-at "\n")) + (delete-char 1) + (message "Test %S condition:" (ert-test-name test)) + (message "%s" (buffer-string)))) + (ert-test-aborted-with-non-local-exit + (message "Test %S aborted with non-local exit" + (ert-test-name test))))) + (let* ((max (prin1-to-string (length (ert--stats-tests stats)))) + (format-string (concat "%9s %" + (prin1-to-string (length max)) + "s/" max " %S"))) + (message format-string + (ert-string-for-test-result result + (ert-test-result-expected-p + test result)) + (1+ (ert--stats-test-pos stats test)) + (ert-test-name test))))))))) + +;;;###autoload +(defun ert-run-tests-batch-and-exit (&optional selector) + "Like `ert-run-tests-batch', but exits Emacs when done. + +The exit status will be 0 if all test results were as expected, 1 +on unexpected results, or 2 if the tool detected an error outside +of the tests (e.g. invalid SELECTOR or bug in the code that runs +the tests)." + (unwind-protect + (let ((stats (ert-run-tests-batch selector))) + (kill-emacs (if (zerop (ert-stats-completed-unexpected stats)) 0 1))) + (unwind-protect + (progn + (message "Error running tests") + (backtrace)) + (kill-emacs 2)))) + + +;;; Utility functions for load/unload actions. + +(defun ert--activate-font-lock-keywords () + "Activate font-lock keywords for some of ERT's symbols." + (font-lock-add-keywords + nil + '(("(\\(\\\\s *\\(\\sw+\\)?" + (1 font-lock-keyword-face nil t) + (2 font-lock-function-name-face nil t))))) + +(defun* ert--remove-from-list (list-var element &key key test) + "Remove ELEMENT from the value of LIST-VAR if present. + +This can be used as an inverse of `add-to-list'." + (unless key (setq key #'identity)) + (unless test (setq test #'equal)) + (setf (symbol-value list-var) + (ert--remove* element + (symbol-value list-var) + :key key + :test test))) + + +;;; Some basic interactive functions. + +(defun ert-read-test-name (prompt &optional default history + add-default-to-prompt) + "Read the name of a test and return it as a symbol. + +Prompt with PROMPT. If DEFAULT is a valid test name, use it as a +default. HISTORY is the history to use; see `completing-read'. +If ADD-DEFAULT-TO-PROMPT is non-nil, PROMPT will be modified to +include the default, if any. + +Signals an error if no test name was read." + (etypecase default + (string (let ((symbol (intern-soft default))) + (unless (and symbol (ert-test-boundp symbol)) + (setq default nil)))) + (symbol (setq default + (if (ert-test-boundp default) + (symbol-name default) + nil))) + (ert-test (setq default (ert-test-name default)))) + (when add-default-to-prompt + (setq prompt (if (null default) + (format "%s: " prompt) + (format "%s (default %s): " prompt default)))) + (let ((input (completing-read prompt obarray #'ert-test-boundp + t nil history default nil))) + ;; completing-read returns an empty string if default was nil and + ;; the user just hit enter. + (let ((sym (intern-soft input))) + (if (ert-test-boundp sym) + sym + (error "Input does not name a test"))))) + +(defun ert-read-test-name-at-point (prompt) + "Read the name of a test and return it as a symbol. +As a default, use the symbol at point, or the test at point if in +the ERT results buffer. Prompt with PROMPT, augmented with the +default (if any)." + (ert-read-test-name prompt (ert-test-at-point) nil t)) + +(defun ert-find-test-other-window (test-name) + "Find, in another window, the definition of TEST-NAME." + (interactive (list (ert-read-test-name-at-point "Find test definition: "))) + (find-function-do-it test-name 'ert-deftest 'switch-to-buffer-other-window)) + +(defun ert-delete-test (test-name) + "Make the test TEST-NAME unbound. + +Nothing more than an interactive interface to `ert-make-test-unbound'." + (interactive (list (ert-read-test-name-at-point "Delete test"))) + (ert-make-test-unbound test-name)) + +(defun ert-delete-all-tests () + "Make all symbols in `obarray' name no test." + (interactive) + (when (interactive-p) + (unless (y-or-n-p "Delete all tests? ") + (error "Aborted"))) + ;; We can't use `ert-select-tests' here since that gives us only + ;; test objects, and going from them back to the test name symbols + ;; can fail if the `ert-test' defstruct has been redefined. + (mapc #'ert-make-test-unbound (apropos-internal "" #'ert-test-boundp)) + t) + + +;;; Display of test progress and results. + +;; An entry in the results buffer ewoc. There is one entry per test. +(defstruct ert--ewoc-entry + (test (assert nil)) + ;; If the result of this test was expected, its ewoc entry is hidden + ;; initially. + (hidden-p (assert nil)) + ;; An ewoc entry may be collapsed to hide details such as the error + ;; condition. + ;; + ;; I'm not sure the ability to expand and collapse entries is still + ;; a useful feature. + (expanded-p t) + ;; By default, the ewoc entry presents the error condition with + ;; certain limits on how much to print (`print-level', + ;; `print-length'). The user can interactively switch to a set of + ;; higher limits. + (extended-printer-limits-p nil)) + +;; Variables local to the results buffer. + +;; The ewoc. +(defvar ert--results-ewoc) +;; The stats object. +(defvar ert--results-stats) +;; A string with one character per test. Each character represents +;; the result of the corresponding test. The string is displayed near +;; the top of the buffer and serves as a progress bar. +(defvar ert--results-progress-bar-string) +;; The position where the progress bar button begins. +(defvar ert--results-progress-bar-button-begin) +;; The test result listener that updates the buffer when tests are run. +(defvar ert--results-listener) + +(defun ert-insert-test-name-button (test-name) + "Insert a button that links to TEST-NAME." + (insert-text-button (format "%S" test-name) + :type 'ert--test-name-button + 'ert-test-name test-name)) + +(defun ert--results-format-expected-unexpected (expected unexpected) + "Return a string indicating EXPECTED expected results, UNEXPECTED unexpected." + (if (zerop unexpected) + (format "%s" expected) + (format "%s (%s unexpected)" (+ expected unexpected) unexpected))) + +(defun ert--results-update-ewoc-hf (ewoc stats) + "Update the header and footer of EWOC to show certain information from STATS. + +Also sets `ert--results-progress-bar-button-begin'." + (let ((run-count (ert-stats-completed stats)) + (results-buffer (current-buffer)) + ;; Need to save buffer-local value. + (font-lock font-lock-mode)) + (ewoc-set-hf + ewoc + ;; header + (with-temp-buffer + (insert "Selector: ") + (ert--insert-human-readable-selector (ert--stats-selector stats)) + (insert "\n") + (insert + (format (concat "Passed: %s\n" + "Failed: %s\n" + "Total: %s/%s\n\n") + (ert--results-format-expected-unexpected + (ert--stats-passed-expected stats) + (ert--stats-passed-unexpected stats)) + (ert--results-format-expected-unexpected + (ert--stats-failed-expected stats) + (ert--stats-failed-unexpected stats)) + run-count + (ert-stats-total stats))) + (insert + (format "Started at: %s\n" + (ert--format-time-iso8601 (ert--stats-start-time stats)))) + ;; FIXME: This is ugly. Need to properly define invariants of + ;; the `stats' data structure. + (let ((state (cond ((ert--stats-aborted-p stats) 'aborted) + ((ert--stats-current-test stats) 'running) + ((ert--stats-end-time stats) 'finished) + (t 'preparing)))) + (ecase state + (preparing + (insert "")) + (aborted + (cond ((ert--stats-current-test stats) + (insert "Aborted during test: ") + (ert-insert-test-name-button + (ert-test-name (ert--stats-current-test stats)))) + (t + (insert "Aborted.")))) + (running + (assert (ert--stats-current-test stats)) + (insert "Running test: ") + (ert-insert-test-name-button (ert-test-name + (ert--stats-current-test stats)))) + (finished + (assert (not (ert--stats-current-test stats))) + (insert "Finished."))) + (insert "\n") + (if (ert--stats-end-time stats) + (insert + (format "%s%s\n" + (if (ert--stats-aborted-p stats) + "Aborted at: " + "Finished at: ") + (ert--format-time-iso8601 (ert--stats-end-time stats)))) + (insert "\n")) + (insert "\n")) + (let ((progress-bar-string (with-current-buffer results-buffer + ert--results-progress-bar-string))) + (let ((progress-bar-button-begin + (insert-text-button progress-bar-string + :type 'ert--results-progress-bar-button + 'face (or (and font-lock + (ert-face-for-stats stats)) + 'button)))) + ;; The header gets copied verbatim to the results buffer, + ;; and all positions remain the same, so + ;; `progress-bar-button-begin' will be the right position + ;; even in the results buffer. + (with-current-buffer results-buffer + (set (make-local-variable 'ert--results-progress-bar-button-begin) + progress-bar-button-begin)))) + (insert "\n\n") + (buffer-string)) + ;; footer + ;; + ;; We actually want an empty footer, but that would trigger a bug + ;; in ewoc, sometimes clearing the entire buffer. (It's possible + ;; that this bug has been fixed since this has been tested; we + ;; should test it again.) + "\n"))) + + +(defvar ert-test-run-redisplay-interval-secs .1 + "How many seconds ERT should wait between redisplays while running tests. + +While running tests, ERT shows the current progress, and this variable +determines how frequently the progress display is updated.") + +(defun ert--results-update-stats-display (ewoc stats) + "Update EWOC and the mode line to show data from STATS." + ;; TODO(ohler): investigate using `make-progress-reporter'. + (ert--results-update-ewoc-hf ewoc stats) + (force-mode-line-update) + (redisplay t) + (setf (ert--stats-next-redisplay stats) + (+ (float-time) ert-test-run-redisplay-interval-secs))) + +(defun ert--results-update-stats-display-maybe (ewoc stats) + "Call `ert--results-update-stats-display' if not called recently. + +EWOC and STATS are arguments for `ert--results-update-stats-display'." + (when (>= (float-time) (ert--stats-next-redisplay stats)) + (ert--results-update-stats-display ewoc stats))) + +(defun ert--tests-running-mode-line-indicator () + "Return a string for the mode line that shows the test run progress." + (let* ((stats ert--current-run-stats) + (tests-total (ert-stats-total stats)) + (tests-completed (ert-stats-completed stats))) + (if (>= tests-completed tests-total) + (format " ERT(%s/%s,finished)" tests-completed tests-total) + (format " ERT(%s/%s):%s" + (1+ tests-completed) + tests-total + (if (null (ert--stats-current-test stats)) + "?" + (format "%S" + (ert-test-name (ert--stats-current-test stats)))))))) + +(defun ert--make-xrefs-region (begin end) + "Attach cross-references to function names between BEGIN and END. + +BEGIN and END specify a region in the current buffer." + (save-excursion + (save-restriction + (narrow-to-region begin (point)) + ;; Inhibit optimization in `debugger-make-xrefs' that would + ;; sometimes insert unrelated backtrace info into our buffer. + (let ((debugger-previous-backtrace nil)) + (debugger-make-xrefs))))) + +(defun ert--string-first-line (s) + "Return the first line of S, or S if it contains no newlines. + +The return value does not include the line terminator." + (substring s 0 (ert--string-position ?\n s))) + +(defun ert-face-for-test-result (expectedp) + "Return a face that shows whether a test result was expected or unexpected. + +If EXPECTEDP is nil, returns the face for unexpected results; if +non-nil, returns the face for expected results.." + (if expectedp 'ert-test-result-expected 'ert-test-result-unexpected)) + +(defun ert-face-for-stats (stats) + "Return a face that represents STATS." + (cond ((ert--stats-aborted-p stats) 'nil) + ((plusp (ert-stats-completed-unexpected stats)) + (ert-face-for-test-result nil)) + ((eql (ert-stats-completed-expected stats) (ert-stats-total stats)) + (ert-face-for-test-result t)) + (t 'nil))) + +(defun ert--print-test-for-ewoc (entry) + "The ewoc print function for ewoc test entries. ENTRY is the entry to print." + (let* ((test (ert--ewoc-entry-test entry)) + (stats ert--results-stats) + (result (let ((pos (ert--stats-test-pos stats test))) + (assert pos) + (aref (ert--stats-test-results stats) pos))) + (hiddenp (ert--ewoc-entry-hidden-p entry)) + (expandedp (ert--ewoc-entry-expanded-p entry)) + (extended-printer-limits-p (ert--ewoc-entry-extended-printer-limits-p + entry))) + (cond (hiddenp) + (t + (let ((expectedp (ert-test-result-expected-p test result))) + (insert-text-button (format "%c" (ert-char-for-test-result + result expectedp)) + :type 'ert--results-expand-collapse-button + 'face (or (and font-lock-mode + (ert-face-for-test-result + expectedp)) + 'button))) + (insert " ") + (ert-insert-test-name-button (ert-test-name test)) + (insert "\n") + (when (and expandedp (not (eql result 'nil))) + (when (ert-test-documentation test) + (insert " " + (propertize + (ert--string-first-line (ert-test-documentation test)) + 'font-lock-face 'font-lock-doc-face) + "\n")) + (etypecase result + (ert-test-passed + (if (ert-test-result-expected-p test result) + (insert " passed\n") + (insert " passed unexpectedly\n")) + (insert "")) + (ert-test-result-with-condition + (ert--insert-infos result) + (let ((print-escape-newlines t) + (print-level (if extended-printer-limits-p 12 6)) + (print-length (if extended-printer-limits-p 100 10))) + (insert " ") + (let ((begin (point))) + (ert--pp-with-indentation-and-newline + (ert-test-result-with-condition-condition result)) + (ert--make-xrefs-region begin (point))))) + (ert-test-aborted-with-non-local-exit + (insert " aborted\n"))) + (insert "\n"))))) + nil) + +(defun ert--results-font-lock-function (enabledp) + "Redraw the ERT results buffer after font-lock-mode was switched on or off. + +ENABLEDP is true if font-lock-mode is switched on, false +otherwise." + (ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats) + (ewoc-refresh ert--results-ewoc) + (font-lock-default-function enabledp)) + +(defun ert--setup-results-buffer (stats listener buffer-name) + "Set up a test results buffer. + +STATS is the stats object; LISTENER is the results listener; +BUFFER-NAME, if non-nil, is the buffer name to use." + (unless buffer-name (setq buffer-name "*ert*")) + (let ((buffer (get-buffer-create buffer-name))) + (with-current-buffer buffer + (setq buffer-read-only t) + (let ((inhibit-read-only t)) + (buffer-disable-undo) + (erase-buffer) + (ert-results-mode) + ;; Erase buffer again in case switching out of the previous + ;; mode inserted anything. (This happens e.g. when switching + ;; from ert-results-mode to ert-results-mode when + ;; font-lock-mode turns itself off in change-major-mode-hook.) + (erase-buffer) + (set (make-local-variable 'font-lock-function) + 'ert--results-font-lock-function) + (let ((ewoc (ewoc-create 'ert--print-test-for-ewoc nil nil t))) + (set (make-local-variable 'ert--results-ewoc) ewoc) + (set (make-local-variable 'ert--results-stats) stats) + (set (make-local-variable 'ert--results-progress-bar-string) + (make-string (ert-stats-total stats) + (ert-char-for-test-result nil t))) + (set (make-local-variable 'ert--results-listener) listener) + (loop for test across (ert--stats-tests stats) do + (ewoc-enter-last ewoc + (make-ert--ewoc-entry :test test :hidden-p t))) + (ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats) + (goto-char (1- (point-max))) + buffer))))) + + +(defvar ert--selector-history nil + "List of recent test selectors read from terminal.") + +;; Should OUTPUT-BUFFER-NAME and MESSAGE-FN really be arguments here? +;; They are needed only for our automated self-tests at the moment. +;; Or should there be some other mechanism? +;;;###autoload +(defun ert-run-tests-interactively (selector + &optional output-buffer-name message-fn) + "Run the tests specified by SELECTOR and display the results in a buffer. + +SELECTOR works as described in `ert-select-tests'. +OUTPUT-BUFFER-NAME and MESSAGE-FN should normally be nil; they +are used for automated self-tests and specify which buffer to use +and how to display message." + (interactive + (list (let ((default (if ert--selector-history + ;; Can't use `first' here as this form is + ;; not compiled, and `first' is not + ;; defined without cl. + (car ert--selector-history) + "t"))) + (read-from-minibuffer (if (null default) + "Run tests: " + (format "Run tests (default %s): " default)) + nil nil t 'ert--selector-history + default nil)) + nil)) + (unless message-fn (setq message-fn 'message)) + (lexical-let ((output-buffer-name output-buffer-name) + buffer + listener + (message-fn message-fn)) + (setq listener + (lambda (event-type &rest event-args) + (ecase event-type + (run-started + (destructuring-bind (stats) event-args + (setq buffer (ert--setup-results-buffer stats + listener + output-buffer-name)) + (pop-to-buffer buffer))) + (run-ended + (destructuring-bind (stats abortedp) event-args + (funcall message-fn + "%sRan %s tests, %s results were as expected%s" + (if (not abortedp) + "" + "Aborted: ") + (ert-stats-total stats) + (ert-stats-completed-expected stats) + (let ((unexpected + (ert-stats-completed-unexpected stats))) + (if (zerop unexpected) + "" + (format ", %s unexpected" unexpected)))) + (ert--results-update-stats-display (with-current-buffer buffer + ert--results-ewoc) + stats))) + (test-started + (destructuring-bind (stats test) event-args + (with-current-buffer buffer + (let* ((ewoc ert--results-ewoc) + (pos (ert--stats-test-pos stats test)) + (node (ewoc-nth ewoc pos))) + (assert node) + (setf (ert--ewoc-entry-test (ewoc-data node)) test) + (aset ert--results-progress-bar-string pos + (ert-char-for-test-result nil t)) + (ert--results-update-stats-display-maybe ewoc stats) + (ewoc-invalidate ewoc node))))) + (test-ended + (destructuring-bind (stats test result) event-args + (with-current-buffer buffer + (let* ((ewoc ert--results-ewoc) + (pos (ert--stats-test-pos stats test)) + (node (ewoc-nth ewoc pos))) + (when (ert--ewoc-entry-hidden-p (ewoc-data node)) + (setf (ert--ewoc-entry-hidden-p (ewoc-data node)) + (ert-test-result-expected-p test result))) + (aset ert--results-progress-bar-string pos + (ert-char-for-test-result result + (ert-test-result-expected-p + test result))) + (ert--results-update-stats-display-maybe ewoc stats) + (ewoc-invalidate ewoc node)))))))) + (ert-run-tests + selector + listener))) +;;;###autoload +(defalias 'ert 'ert-run-tests-interactively) + + +;;; Simple view mode for auxiliary information like stack traces or +;;; messages. Mainly binds "q" for quit. + +(define-derived-mode ert-simple-view-mode fundamental-mode "ERT-View" + "Major mode for viewing auxiliary information in ERT.") + +(loop for (key binding) in + '(("q" quit-window) + ) + do + (define-key ert-simple-view-mode-map key binding)) + + +;;; Commands and button actions for the results buffer. + +(define-derived-mode ert-results-mode fundamental-mode "ERT-Results" + "Major mode for viewing results of ERT test runs.") + +(loop for (key binding) in + '(;; Stuff that's not in the menu. + ("\t" forward-button) + ([backtab] backward-button) + ("j" ert-results-jump-between-summary-and-result) + ("q" quit-window) + ("L" ert-results-toggle-printer-limits-for-test-at-point) + ("n" ert-results-next-test) + ("p" ert-results-previous-test) + ;; Stuff that is in the menu. + ("R" ert-results-rerun-all-tests) + ("r" ert-results-rerun-test-at-point) + ("d" ert-results-rerun-test-at-point-debugging-errors) + ("." ert-results-find-test-at-point-other-window) + ("b" ert-results-pop-to-backtrace-for-test-at-point) + ("m" ert-results-pop-to-messages-for-test-at-point) + ("l" ert-results-pop-to-should-forms-for-test-at-point) + ("h" ert-results-describe-test-at-point) + ("D" ert-delete-test) + ("T" ert-results-pop-to-timings) + ) + do + (define-key ert-results-mode-map key binding)) + +(easy-menu-define ert-results-mode-menu ert-results-mode-map + "Menu for `ert-results-mode'." + '("ERT Results" + ["Re-run all tests" ert-results-rerun-all-tests] + "--" + ["Re-run test" ert-results-rerun-test-at-point] + ["Debug test" ert-results-rerun-test-at-point-debugging-errors] + ["Show test definition" ert-results-find-test-at-point-other-window] + "--" + ["Show backtrace" ert-results-pop-to-backtrace-for-test-at-point] + ["Show messages" ert-results-pop-to-messages-for-test-at-point] + ["Show `should' forms" ert-results-pop-to-should-forms-for-test-at-point] + ["Describe test" ert-results-describe-test-at-point] + "--" + ["Delete test" ert-delete-test] + "--" + ["Show execution time of each test" ert-results-pop-to-timings] + )) + +(define-button-type 'ert--results-progress-bar-button + 'action #'ert--results-progress-bar-button-action + 'help-echo "mouse-2, RET: Reveal test result") + +(define-button-type 'ert--test-name-button + 'action #'ert--test-name-button-action + 'help-echo "mouse-2, RET: Find test definition") + +(define-button-type 'ert--results-expand-collapse-button + 'action #'ert--results-expand-collapse-button-action + 'help-echo "mouse-2, RET: Expand/collapse test result") + +(defun ert--results-test-node-or-null-at-point () + "If point is on a valid ewoc node, return it; return nil otherwise. + +To be used in the ERT results buffer." + (let* ((ewoc ert--results-ewoc) + (node (ewoc-locate ewoc))) + ;; `ewoc-locate' will return an arbitrary node when point is on + ;; header or footer, or when all nodes are invisible. So we need + ;; to validate its return value here. + ;; + ;; Update: I'm seeing nil being returned in some cases now, + ;; perhaps this has been changed? + (if (and node + (>= (point) (ewoc-location node)) + (not (ert--ewoc-entry-hidden-p (ewoc-data node)))) + node + nil))) + +(defun ert--results-test-node-at-point () + "If point is on a valid ewoc node, return it; signal an error otherwise. + +To be used in the ERT results buffer." + (or (ert--results-test-node-or-null-at-point) + (error "No test at point"))) + +(defun ert-results-next-test () + "Move point to the next test. + +To be used in the ERT results buffer." + (interactive) + (ert--results-move (ewoc-locate ert--results-ewoc) 'ewoc-next + "No tests below")) + +(defun ert-results-previous-test () + "Move point to the previous test. + +To be used in the ERT results buffer." + (interactive) + (ert--results-move (ewoc-locate ert--results-ewoc) 'ewoc-prev + "No tests above")) + +(defun ert--results-move (node ewoc-fn error-message) + "Move point from NODE to the previous or next node. + +EWOC-FN specifies the direction and should be either `ewoc-prev' +or `ewoc-next'. If there are no more nodes in that direction, an +error is signalled with the message ERROR-MESSAGE." + (loop + (setq node (funcall ewoc-fn ert--results-ewoc node)) + (when (null node) + (error "%s" error-message)) + (unless (ert--ewoc-entry-hidden-p (ewoc-data node)) + (goto-char (ewoc-location node)) + (return)))) + +(defun ert--results-expand-collapse-button-action (button) + "Expand or collapse the test node BUTTON belongs to." + (let* ((ewoc ert--results-ewoc) + (node (save-excursion + (goto-char (ert--button-action-position)) + (ert--results-test-node-at-point))) + (entry (ewoc-data node))) + (setf (ert--ewoc-entry-expanded-p entry) + (not (ert--ewoc-entry-expanded-p entry))) + (ewoc-invalidate ewoc node))) + +(defun ert-results-find-test-at-point-other-window () + "Find the definition of the test at point in another window. + +To be used in the ERT results buffer." + (interactive) + (let ((name (ert-test-at-point))) + (unless name + (error "No test at point")) + (ert-find-test-other-window name))) + +(defun ert--test-name-button-action (button) + "Find the definition of the test BUTTON belongs to, in another window." + (let ((name (button-get button 'ert-test-name))) + (ert-find-test-other-window name))) + +(defun ert--ewoc-position (ewoc node) + ;; checkdoc-order: nil + "Return the position of NODE in EWOC, or nil if NODE is not in EWOC." + (loop for i from 0 + for node-here = (ewoc-nth ewoc 0) then (ewoc-next ewoc node-here) + do (when (eql node node-here) + (return i)) + finally (return nil))) + +(defun ert-results-jump-between-summary-and-result () + "Jump back and forth between the test run summary and individual test results. + +From an ewoc node, jumps to the character that represents the +same test in the progress bar, and vice versa. + +To be used in the ERT results buffer." + ;; Maybe this command isn't actually needed much, but if it is, it + ;; seems like an indication that the UI design is not optimal. If + ;; jumping back and forth between a summary at the top of the buffer + ;; and the error log in the remainder of the buffer is useful, then + ;; the summary apparently needs to be easily accessible from the + ;; error log, and perhaps it would be better to have it in a + ;; separate buffer to keep it visible. + (interactive) + (let ((ewoc ert--results-ewoc) + (progress-bar-begin ert--results-progress-bar-button-begin)) + (cond ((ert--results-test-node-or-null-at-point) + (let* ((node (ert--results-test-node-at-point)) + (pos (ert--ewoc-position ewoc node))) + (goto-char (+ progress-bar-begin pos)))) + ((and (<= progress-bar-begin (point)) + (< (point) (button-end (button-at progress-bar-begin)))) + (let* ((node (ewoc-nth ewoc (- (point) progress-bar-begin))) + (entry (ewoc-data node))) + (when (ert--ewoc-entry-hidden-p entry) + (setf (ert--ewoc-entry-hidden-p entry) nil) + (ewoc-invalidate ewoc node)) + (ewoc-goto-node ewoc node))) + (t + (goto-char progress-bar-begin))))) + +(defun ert-test-at-point () + "Return the name of the test at point as a symbol, or nil if none." + (or (and (eql major-mode 'ert-results-mode) + (let ((test (ert--results-test-at-point-no-redefinition))) + (and test (ert-test-name test)))) + (let* ((thing (thing-at-point 'symbol)) + (sym (intern-soft thing))) + (and (ert-test-boundp sym) + sym)))) + +(defun ert--results-test-at-point-no-redefinition () + "Return the test at point, or nil. + +To be used in the ERT results buffer." + (assert (eql major-mode 'ert-results-mode)) + (if (ert--results-test-node-or-null-at-point) + (let* ((node (ert--results-test-node-at-point)) + (test (ert--ewoc-entry-test (ewoc-data node)))) + test) + (let ((progress-bar-begin ert--results-progress-bar-button-begin)) + (when (and (<= progress-bar-begin (point)) + (< (point) (button-end (button-at progress-bar-begin)))) + (let* ((test-index (- (point) progress-bar-begin)) + (test (aref (ert--stats-tests ert--results-stats) + test-index))) + test))))) + +(defun ert--results-test-at-point-allow-redefinition () + "Look up the test at point, and check whether it has been redefined. + +To be used in the ERT results buffer. + +Returns a list of two elements: the test (or nil) and a symbol +specifying whether the test has been redefined. + +If a new test has been defined with the same name as the test at +point, replaces the test at point with the new test, and returns +the new test and the symbol `redefined'. + +If the test has been deleted, returns the old test and the symbol +`deleted'. + +If the test is still current, returns the test and the symbol nil. + +If there is no test at point, returns a list with two nils." + (let ((test (ert--results-test-at-point-no-redefinition))) + (cond ((null test) + `(nil nil)) + ((null (ert-test-name test)) + `(,test nil)) + (t + (let* ((name (ert-test-name test)) + (new-test (and (ert-test-boundp name) + (ert-get-test name)))) + (cond ((eql test new-test) + `(,test nil)) + ((null new-test) + `(,test deleted)) + (t + (ert--results-update-after-test-redefinition + (ert--stats-test-pos ert--results-stats test) + new-test) + `(,new-test redefined)))))))) + +(defun ert--results-update-after-test-redefinition (pos new-test) + "Update results buffer after the test at pos POS has been redefined. + +Also updates the stats object. NEW-TEST is the new test +definition." + (let* ((stats ert--results-stats) + (ewoc ert--results-ewoc) + (node (ewoc-nth ewoc pos)) + (entry (ewoc-data node))) + (ert--stats-set-test-and-result stats pos new-test nil) + (setf (ert--ewoc-entry-test entry) new-test + (aref ert--results-progress-bar-string pos) (ert-char-for-test-result + nil t)) + (ewoc-invalidate ewoc node)) + nil) + +(defun ert--button-action-position () + "The buffer position where the last button action was triggered." + (cond ((integerp last-command-event) + (point)) + ((eventp last-command-event) + (posn-point (event-start last-command-event))) + (t (assert nil)))) + +(defun ert--results-progress-bar-button-action (button) + "Jump to details for the test represented by the character clicked in BUTTON." + (goto-char (ert--button-action-position)) + (ert-results-jump-between-summary-and-result)) + +(defun ert-results-rerun-all-tests () + "Re-run all tests, using the same selector. + +To be used in the ERT results buffer." + (interactive) + (assert (eql major-mode 'ert-results-mode)) + (let ((selector (ert--stats-selector ert--results-stats))) + (ert-run-tests-interactively selector (buffer-name)))) + +(defun ert-results-rerun-test-at-point () + "Re-run the test at point. + +To be used in the ERT results buffer." + (interactive) + (destructuring-bind (test redefinition-state) + (ert--results-test-at-point-allow-redefinition) + (when (null test) + (error "No test at point")) + (let* ((stats ert--results-stats) + (progress-message (format "Running %stest %S" + (ecase redefinition-state + ((nil) "") + (redefined "new definition of ") + (deleted "deleted ")) + (ert-test-name test)))) + ;; Need to save and restore point manually here: When point is on + ;; the first visible ewoc entry while the header is updated, point + ;; moves to the top of the buffer. This is undesirable, and a + ;; simple `save-excursion' doesn't prevent it. + (let ((point (point))) + (unwind-protect + (unwind-protect + (progn + (message "%s..." progress-message) + (ert-run-or-rerun-test stats test + ert--results-listener)) + (ert--results-update-stats-display ert--results-ewoc stats) + (message "%s...%s" + progress-message + (let ((result (ert-test-most-recent-result test))) + (ert-string-for-test-result + result (ert-test-result-expected-p test result))))) + (goto-char point)))))) + +(defun ert-results-rerun-test-at-point-debugging-errors () + "Re-run the test at point with `ert-debug-on-error' bound to t. + +To be used in the ERT results buffer." + (interactive) + (let ((ert-debug-on-error t)) + (ert-results-rerun-test-at-point))) + +(defun ert-results-pop-to-backtrace-for-test-at-point () + "Display the backtrace for the test at point. + +To be used in the ERT results buffer." + (interactive) + (let* ((test (ert--results-test-at-point-no-redefinition)) + (stats ert--results-stats) + (pos (ert--stats-test-pos stats test)) + (result (aref (ert--stats-test-results stats) pos))) + (etypecase result + (ert-test-passed (error "Test passed, no backtrace available")) + (ert-test-result-with-condition + (let ((backtrace (ert-test-result-with-condition-backtrace result)) + (buffer (get-buffer-create "*ERT Backtrace*"))) + (pop-to-buffer buffer) + (setq buffer-read-only t) + (let ((inhibit-read-only t)) + (buffer-disable-undo) + (erase-buffer) + (ert-simple-view-mode) + ;; Use unibyte because `debugger-setup-buffer' also does so. + (set-buffer-multibyte nil) + (setq truncate-lines t) + (ert--print-backtrace backtrace) + (debugger-make-xrefs) + (goto-char (point-min)) + (insert "Backtrace for test `") + (ert-insert-test-name-button (ert-test-name test)) + (insert "':\n"))))))) + +(defun ert-results-pop-to-messages-for-test-at-point () + "Display the part of the *Messages* buffer generated during the test at point. + +To be used in the ERT results buffer." + (interactive) + (let* ((test (ert--results-test-at-point-no-redefinition)) + (stats ert--results-stats) + (pos (ert--stats-test-pos stats test)) + (result (aref (ert--stats-test-results stats) pos))) + (let ((buffer (get-buffer-create "*ERT Messages*"))) + (pop-to-buffer buffer) + (setq buffer-read-only t) + (let ((inhibit-read-only t)) + (buffer-disable-undo) + (erase-buffer) + (ert-simple-view-mode) + (insert (ert-test-result-messages result)) + (goto-char (point-min)) + (insert "Messages for test `") + (ert-insert-test-name-button (ert-test-name test)) + (insert "':\n"))))) + +(defun ert-results-pop-to-should-forms-for-test-at-point () + "Display the list of `should' forms executed during the test at point. + +To be used in the ERT results buffer." + (interactive) + (let* ((test (ert--results-test-at-point-no-redefinition)) + (stats ert--results-stats) + (pos (ert--stats-test-pos stats test)) + (result (aref (ert--stats-test-results stats) pos))) + (let ((buffer (get-buffer-create "*ERT list of should forms*"))) + (pop-to-buffer buffer) + (setq buffer-read-only t) + (let ((inhibit-read-only t)) + (buffer-disable-undo) + (erase-buffer) + (ert-simple-view-mode) + (if (null (ert-test-result-should-forms result)) + (insert "\n(No should forms during this test.)\n") + (loop for form-description in (ert-test-result-should-forms result) + for i from 1 do + (insert "\n") + (insert (format "%s: " i)) + (let ((begin (point))) + (ert--pp-with-indentation-and-newline form-description) + (ert--make-xrefs-region begin (point))))) + (goto-char (point-min)) + (insert "`should' forms executed during test `") + (ert-insert-test-name-button (ert-test-name test)) + (insert "':\n") + (insert "\n") + (insert (concat "(Values are shallow copies and may have " + "looked different during the test if they\n" + "have been modified destructively.)\n")) + (forward-line 1))))) + +(defun ert-results-toggle-printer-limits-for-test-at-point () + "Toggle how much of the condition to print for the test at point. + +To be used in the ERT results buffer." + (interactive) + (let* ((ewoc ert--results-ewoc) + (node (ert--results-test-node-at-point)) + (entry (ewoc-data node))) + (setf (ert--ewoc-entry-extended-printer-limits-p entry) + (not (ert--ewoc-entry-extended-printer-limits-p entry))) + (ewoc-invalidate ewoc node))) + +(defun ert-results-pop-to-timings () + "Display test timings for the last run. + +To be used in the ERT results buffer." + (interactive) + (let* ((stats ert--results-stats) + (start-times (ert--stats-test-start-times stats)) + (end-times (ert--stats-test-end-times stats)) + (buffer (get-buffer-create "*ERT timings*")) + (data (loop for test across (ert--stats-tests stats) + for start-time across (ert--stats-test-start-times stats) + for end-time across (ert--stats-test-end-times stats) + collect (list test + (float-time (subtract-time end-time + start-time)))))) + (setq data (sort data (lambda (a b) + (> (second a) (second b))))) + (pop-to-buffer buffer) + (setq buffer-read-only t) + (let ((inhibit-read-only t)) + (buffer-disable-undo) + (erase-buffer) + (ert-simple-view-mode) + (if (null data) + (insert "(No data)\n") + (insert (format "%-3s %8s %8s\n" "" "time" "cumul")) + (loop for (test time) in data + for cumul-time = time then (+ cumul-time time) + for i from 1 do + (let ((begin (point))) + (insert (format "%3s: %8.3f %8.3f " i time cumul-time)) + (ert-insert-test-name-button (ert-test-name test)) + (insert "\n")))) + (goto-char (point-min)) + (insert "Tests by run time (seconds):\n\n") + (forward-line 1)))) + +;;;###autoload +(defun ert-describe-test (test-or-test-name) + "Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test)." + (interactive (list (ert-read-test-name-at-point "Describe test"))) + (when (< emacs-major-version 24) + (error "Requires Emacs 24")) + (let (test-name + test-definition) + (etypecase test-or-test-name + (symbol (setq test-name test-or-test-name + test-definition (ert-get-test test-or-test-name))) + (ert-test (setq test-name (ert-test-name test-or-test-name) + test-definition test-or-test-name))) + (help-setup-xref (list #'ert-describe-test test-or-test-name) + (called-interactively-p 'interactive)) + (save-excursion + (with-help-window (help-buffer) + (with-current-buffer (help-buffer) + (insert (if test-name (format "%S" test-name) "")) + (insert " is a test") + (let ((file-name (and test-name + (symbol-file test-name 'ert-deftest)))) + (when file-name + (insert " defined in `" (file-name-nondirectory file-name) "'") + (save-excursion + (re-search-backward "`\\([^`']+\\)'" nil t) + (help-xref-button 1 'help-function-def test-name file-name))) + (insert ".") + (fill-region-as-paragraph (point-min) (point)) + (insert "\n\n") + (unless (and (ert-test-boundp test-name) + (eql (ert-get-test test-name) test-definition)) + (let ((begin (point))) + (insert "Note: This test has been redefined or deleted, " + "this documentation refers to an old definition.") + (fill-region-as-paragraph begin (point))) + (insert "\n\n")) + (insert (or (ert-test-documentation test-definition) + "It is not documented.") + "\n"))))))) + +(defun ert-results-describe-test-at-point () + "Display the documentation of the test at point. + +To be used in the ERT results buffer." + (interactive) + (ert-describe-test (ert--results-test-at-point-no-redefinition))) + + +;;; Actions on load/unload. + +(add-to-list 'find-function-regexp-alist '(ert-deftest . ert--find-test-regexp)) +(add-to-list 'minor-mode-alist '(ert--current-run-stats + (:eval + (ert--tests-running-mode-line-indicator)))) +(add-to-list 'emacs-lisp-mode-hook 'ert--activate-font-lock-keywords) + +(defun ert--unload-function () + "Unload function to undo the side-effects of loading ert.el." + (ert--remove-from-list 'find-function-regexp-alist 'ert-deftest :key #'car) + (ert--remove-from-list 'minor-mode-alist 'ert--current-run-stats :key #'car) + (ert--remove-from-list 'emacs-lisp-mode-hook + 'ert--activate-font-lock-keywords) + nil) + +(defvar ert-unload-hook '()) +(add-hook 'ert-unload-hook 'ert--unload-function) + + +(provide 'ert) + +;;; ert.el ends here === modified file 'test/ChangeLog' --- test/ChangeLog 2010-11-11 21:06:15 +0000 +++ test/ChangeLog 2011-01-12 16:08:24 +0000 @@ -1,3 +1,11 @@ +2011-01-13 Christian Ohler + + * automated: New directory for automated tests. + + * automated/ert-tests.el, automated/ert-x-tests.el: New files. + + * automated/Makefile.in: New file. + 2010-11-11 Stefan Monnier * indent/modula2.mod: New file. === added directory 'test/automated' === added file 'test/automated/Makefile.in' --- test/automated/Makefile.in 1970-01-01 00:00:00 +0000 +++ test/automated/Makefile.in 2011-01-12 16:08:24 +0000 @@ -0,0 +1,158 @@ +# Maintenance productions for the automated test directory +# Copyright (C) 2010, 2011 Free Software Foundation, Inc. + +# This file is part of GNU Emacs. + +# GNU Emacs is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. + +# GNU Emacs is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +# You should have received a copy of the GNU General Public License +# along with GNU Emacs. If not, see . + +SHELL = /bin/sh + +srcdir = @srcdir@ +top_srcdir = @top_srcdir@ +abs_top_builddir = @abs_top_builddir@ +test = $(srcdir) +VPATH = $(srcdir) +lispsrc = $(top_srcdir)/lisp +lisp = ${abs_top_builddir}/lisp + +# You can specify a different executable on the make command line, +# e.g. "make EMACS=../src/emacs ...". + +# We sometimes change directory before running Emacs (typically when +# building out-of-tree, we chdir to the source directory), so we need +# to use an absolute file name. +EMACS = ${abs_top_builddir}/src/emacs + +# Command line flags for Emacs. + +EMACSOPT = -batch --no-site-file --no-site-lisp + +# Extra flags to pass to the byte compiler +BYTE_COMPILE_EXTRA_FLAGS = +# For example to not display the undefined function warnings you can use this: +# BYTE_COMPILE_EXTRA_FLAGS = --eval '(setq byte-compile-warnings (quote (not unresolved)))' +# The example above is just for developers, it should not be used by default. + +# The actual Emacs command run in the targets below. +emacs = EMACSLOADPATH=$(lispsrc):$(test) LC_ALL=C $(EMACS) $(EMACSOPT) + +# Common command to find subdirectories +setwins=subdirs=`(find . -type d -print)`; \ + for file in $$subdirs; do \ + case $$file in */.* | */.*/* | */=* ) ;; \ + *) wins="$$wins $$file" ;; \ + esac; \ + done + +all: test + +doit: + + +# Files MUST be compiled one by one. If we compile several files in a +# row (i.e., in the same instance of Emacs) we can't make sure that +# the compilation environment is clean. We also set the load-path of +# the Emacs used for compilation to the current directory and its +# subdirectories, to make sure require's and load's in the files being +# compiled find the right files. + +.SUFFIXES: .elc .el + +# An old-fashioned suffix rule, which, according to the GNU Make manual, +# cannot have prerequisites. +.el.elc: + @echo Compiling $< + @$(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $< + +.PHONY: lisp-compile compile-main compile compile-always + +lisp-compile: + cd $(lisp); $(MAKE) $(MFLAGS) compile EMACS=$(EMACS) + +# In `compile-main' we could directly do +# ... | xargs $(MAKE) $(MFLAGS) EMACS="$(EMACS)" +# and it works, but it generates a lot of messages like +# make[2]: « gnus/gnus-mlspl.elc » is up to date. +# so instead, we use "xargs echo" to split the list of file into manageable +# chunks and then use an intermediate `compile-targets' target so the +# actual targets (the .elc files) are not mentioned as targets on the +# make command line. + + +.PHONY: compile-targets +# 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 lisp-compile + @(cd $(test); $(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 echo) | \ + while read chunk; do \ + $(MAKE) $(MFLAGS) compile-targets EMACS="$(EMACS)" TARGETS="$$chunk"; \ + done + +.PHONY: compile-clean +# Erase left-over .elc files that do not have a corresponding .el file. +compile-clean: + @cd $(test); $(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 + +# Compile all Lisp files, but don't recompile those that are up to +# date. Some .el files don't get compiled because they set the +# local variable no-byte-compile. +# Calling make recursively because suffix rule cannot have prerequisites. +# Explicitly pass EMACS (sometimes ../src/bootstrap-emacs) to those +# sub-makes that run rules that use it, for the sake of some non-GNU makes. +compile: $(LOADDEFS) autoloads compile-first + $(MAKE) $(MFLAGS) compile-main EMACS=$(EMACS) + +# Compile all Lisp files. This is like `compile' but compiles files +# unconditionally. Some files don't actually get compiled because they +# set the local variable no-byte-compile. +compile-always: doit + cd $(test); rm -f *.elc */*.elc */*/*.elc */*/*/*.elc + $(MAKE) $(MFLAGS) compile EMACS=$(EMACS) + +bootstrap-clean: + cd $(test); rm -f *.elc */*.elc */*/*.elc */*/*/*.elc + +distclean: + -rm -f ./Makefile + +maintainer-clean: distclean bootstrap-clean + +check: compile-main + @(cd $(test); $(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. === added file 'test/automated/ert-tests.el' --- test/automated/ert-tests.el 1970-01-01 00:00:00 +0000 +++ test/automated/ert-tests.el 2011-01-12 16:08:24 +0000 @@ -0,0 +1,949 @@ +;;; ert-tests.el --- ERT's self-tests + +;; Copyright (C) 2007, 2008, 2010, 2011 Free Software Foundation, Inc. + +;; Author: Christian Ohler + +;; This file is part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see `http://www.gnu.org/licenses/'. + +;;; Commentary: + +;; This file is part of ERT, the Emacs Lisp Regression Testing tool. +;; See ert.el or the texinfo manual for more details. + +;;; Code: + +(eval-when-compile + (require 'cl)) +(require 'ert) + + +;;; Self-test that doesn't rely on ERT, for bootstrapping. + +;; This is used to test that bodies actually run. +(defvar ert--test-body-was-run) +(ert-deftest ert-test-body-runs () + (setq ert--test-body-was-run t)) + +(defun ert-self-test () + "Run ERT's self-tests and make sure they actually ran." + (let ((window-configuration (current-window-configuration))) + (let ((ert--test-body-was-run nil)) + ;; The buffer name chosen here should not compete with the default + ;; results buffer name for completion in `switch-to-buffer'. + (let ((stats (ert-run-tests-interactively "^ert-" " *ert self-tests*"))) + (assert ert--test-body-was-run) + (if (zerop (ert-stats-completed-unexpected stats)) + ;; Hide results window only when everything went well. + (set-window-configuration window-configuration) + (error "ERT self-test failed")))))) + +(defun ert-self-test-and-exit () + "Run ERT's self-tests and exit Emacs. + +The exit code will be zero if the tests passed, nonzero if they +failed or if there was a problem." + (unwind-protect + (progn + (ert-self-test) + (kill-emacs 0)) + (unwind-protect + (progn + (message "Error running tests") + (backtrace)) + (kill-emacs 1)))) + + +;;; Further tests are defined using ERT. + +(ert-deftest ert-test-nested-test-body-runs () + "Test that nested test bodies run." + (lexical-let ((was-run nil)) + (let ((test (make-ert-test :body (lambda () + (setq was-run t))))) + (assert (not was-run)) + (ert-run-test test) + (assert was-run)))) + + +;;; Test that pass/fail works. +(ert-deftest ert-test-pass () + (let ((test (make-ert-test :body (lambda ())))) + (let ((result (ert-run-test test))) + (assert (ert-test-passed-p result))))) + +(ert-deftest ert-test-fail () + (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) + (let ((result (let ((ert-debug-on-error nil)) + (ert-run-test test)))) + (assert (ert-test-failed-p result) t) + (assert (equal (ert-test-result-with-condition-condition result) + '(ert-test-failed "failure message")) + t)))) + +(ert-deftest ert-test-fail-debug-with-condition-case () + (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) + (condition-case condition + (progn + (let ((ert-debug-on-error t)) + (ert-run-test test)) + (assert nil)) + ((error) + (assert (equal condition '(ert-test-failed "failure message")) t))))) + +(ert-deftest ert-test-fail-debug-with-debugger-1 () + (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) + (let ((debugger (lambda (&rest debugger-args) + (assert nil)))) + (let ((ert-debug-on-error nil)) + (ert-run-test test))))) + +(ert-deftest ert-test-fail-debug-with-debugger-2 () + (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) + (block nil + (let ((debugger (lambda (&rest debugger-args) + (return-from nil nil)))) + (let ((ert-debug-on-error t)) + (ert-run-test test)) + (assert nil))))) + +(ert-deftest ert-test-fail-debug-nested-with-debugger () + (let ((test (make-ert-test :body (lambda () + (let ((ert-debug-on-error t)) + (ert-fail "failure message")))))) + (let ((debugger (lambda (&rest debugger-args) + (assert nil nil "Assertion a")))) + (let ((ert-debug-on-error nil)) + (ert-run-test test)))) + (let ((test (make-ert-test :body (lambda () + (let ((ert-debug-on-error nil)) + (ert-fail "failure message")))))) + (block nil + (let ((debugger (lambda (&rest debugger-args) + (return-from nil nil)))) + (let ((ert-debug-on-error t)) + (ert-run-test test)) + (assert nil nil "Assertion b"))))) + +(ert-deftest ert-test-error () + (let ((test (make-ert-test :body (lambda () (error "Error message"))))) + (let ((result (let ((ert-debug-on-error nil)) + (ert-run-test test)))) + (assert (ert-test-failed-p result) t) + (assert (equal (ert-test-result-with-condition-condition result) + '(error "Error message")) + t)))) + +(ert-deftest ert-test-error-debug () + (let ((test (make-ert-test :body (lambda () (error "Error message"))))) + (condition-case condition + (progn + (let ((ert-debug-on-error t)) + (ert-run-test test)) + (assert nil)) + ((error) + (assert (equal condition '(error "Error message")) t))))) + + +;;; Test that `should' works. +(ert-deftest ert-test-should () + (let ((test (make-ert-test :body (lambda () (should nil))))) + (let ((result (let ((ert-debug-on-error nil)) + (ert-run-test test)))) + (assert (ert-test-failed-p result) t) + (assert (equal (ert-test-result-with-condition-condition result) + '(ert-test-failed ((should nil) :form nil :value nil))) + t))) + (let ((test (make-ert-test :body (lambda () (should t))))) + (let ((result (ert-run-test test))) + (assert (ert-test-passed-p result) t)))) + +(ert-deftest ert-test-should-value () + (should (eql (should 'foo) 'foo)) + (should (eql (should 'bar) 'bar))) + +(ert-deftest ert-test-should-not () + (let ((test (make-ert-test :body (lambda () (should-not t))))) + (let ((result (let ((ert-debug-on-error nil)) + (ert-run-test test)))) + (assert (ert-test-failed-p result) t) + (assert (equal (ert-test-result-with-condition-condition result) + '(ert-test-failed ((should-not t) :form t :value t))) + t))) + (let ((test (make-ert-test :body (lambda () (should-not nil))))) + (let ((result (ert-run-test test))) + (assert (ert-test-passed-p result))))) + +(ert-deftest ert-test-should-with-macrolet () + (let ((test (make-ert-test :body (lambda () + (macrolet ((foo () `(progn t nil))) + (should (foo))))))) + (let ((result (let ((ert-debug-on-error nil)) + (ert-run-test test)))) + (should (ert-test-failed-p result)) + (should (equal + (ert-test-result-with-condition-condition result) + '(ert-test-failed ((should (foo)) + :form (progn t nil) + :value nil))))))) + +(ert-deftest ert-test-should-error () + ;; No error. + (let ((test (make-ert-test :body (lambda () (should-error (progn)))))) + (let ((result (let ((ert-debug-on-error nil)) + (ert-run-test test)))) + (should (ert-test-failed-p result)) + (should (equal (ert-test-result-with-condition-condition result) + '(ert-test-failed + ((should-error (progn)) + :form (progn) + :value nil + :fail-reason "did not signal an error")))))) + ;; A simple error. + (should (equal (should-error (error "Foo")) + '(error "Foo"))) + ;; Error of unexpected type. + (let ((test (make-ert-test :body (lambda () + (should-error (error "Foo") + :type 'singularity-error))))) + (let ((result (ert-run-test test))) + (should (ert-test-failed-p result)) + (should (equal + (ert-test-result-with-condition-condition result) + '(ert-test-failed + ((should-error (error "Foo") :type 'singularity-error) + :form (error "Foo") + :condition (error "Foo") + :fail-reason + "the error signalled did not have the expected type")))))) + ;; Error of the expected type. + (let* ((error nil) + (test (make-ert-test + :body (lambda () + (setq error + (should-error (signal 'singularity-error nil) + :type 'singularity-error)))))) + (let ((result (ert-run-test test))) + (should (ert-test-passed-p result)) + (should (equal error '(singularity-error)))))) + +(ert-deftest ert-test-should-error-subtypes () + (should-error (signal 'singularity-error nil) + :type 'singularity-error + :exclude-subtypes t) + (let ((test (make-ert-test + :body (lambda () + (should-error (signal 'arith-error nil) + :type 'singularity-error))))) + (let ((result (ert-run-test test))) + (should (ert-test-failed-p result)) + (should (equal + (ert-test-result-with-condition-condition result) + '(ert-test-failed + ((should-error (signal 'arith-error nil) + :type 'singularity-error) + :form (signal arith-error nil) + :condition (arith-error) + :fail-reason + "the error signalled did not have the expected type")))))) + (let ((test (make-ert-test + :body (lambda () + (should-error (signal 'arith-error nil) + :type 'singularity-error + :exclude-subtypes t))))) + (let ((result (ert-run-test test))) + (should (ert-test-failed-p result)) + (should (equal + (ert-test-result-with-condition-condition result) + '(ert-test-failed + ((should-error (signal 'arith-error nil) + :type 'singularity-error + :exclude-subtypes t) + :form (signal arith-error nil) + :condition (arith-error) + :fail-reason + "the error signalled did not have the expected type")))))) + (let ((test (make-ert-test + :body (lambda () + (should-error (signal 'singularity-error nil) + :type 'arith-error + :exclude-subtypes t))))) + (let ((result (ert-run-test test))) + (should (ert-test-failed-p result)) + (should (equal + (ert-test-result-with-condition-condition result) + '(ert-test-failed + ((should-error (signal 'singularity-error nil) + :type 'arith-error + :exclude-subtypes t) + :form (signal singularity-error nil) + :condition (singularity-error) + :fail-reason + "the error signalled was a subtype of the expected type"))))) + )) + +(defmacro ert--test-my-list (&rest args) + "Don't use this. Instead, call `list' with ARGS, it does the same thing. + +This macro is used to test if macroexpansion in `should' works." + `(list ,@args)) + +(ert-deftest ert-test-should-failure-debugging () + "Test that `should' errors contain the information we expect them to." + (loop for (body expected-condition) in + `((,(lambda () (let ((x nil)) (should x))) + (ert-test-failed ((should x) :form x :value nil))) + (,(lambda () (let ((x t)) (should-not x))) + (ert-test-failed ((should-not x) :form x :value t))) + (,(lambda () (let ((x t)) (should (not x)))) + (ert-test-failed ((should (not x)) :form (not t) :value nil))) + (,(lambda () (let ((x nil)) (should-not (not x)))) + (ert-test-failed ((should-not (not x)) :form (not nil) :value t))) + (,(lambda () (let ((x t) (y nil)) (should-not + (ert--test-my-list x y)))) + (ert-test-failed + ((should-not (ert--test-my-list x y)) + :form (list t nil) + :value (t nil)))) + (,(lambda () (let ((x t)) (should (error "Foo")))) + (error "Foo"))) + do + (let ((test (make-ert-test :body body))) + (condition-case actual-condition + (progn + (let ((ert-debug-on-error t)) + (ert-run-test test)) + (assert nil)) + ((error) + (should (equal actual-condition expected-condition))))))) + +(ert-deftest ert-test-deftest () + (should (equal (macroexpand '(ert-deftest abc () "foo" :tags '(bar))) + '(progn + (ert-set-test 'abc + (make-ert-test :name 'abc + :documentation "foo" + :tags '(bar) + :body (lambda ()))) + (push '(ert-deftest . abc) current-load-list) + 'abc))) + (should (equal (macroexpand '(ert-deftest def () + :expected-result ':passed)) + '(progn + (ert-set-test 'def + (make-ert-test :name 'def + :expected-result-type ':passed + :body (lambda ()))) + (push '(ert-deftest . def) current-load-list) + 'def))) + ;; :documentation keyword is forbidden + (should-error (macroexpand '(ert-deftest ghi () + :documentation "foo")))) + +(ert-deftest ert-test-record-backtrace () + (let ((test (make-ert-test :body (lambda () (ert-fail "foo"))))) + (let ((result (ert-run-test test))) + (should (ert-test-failed-p result)) + (with-temp-buffer + (ert--print-backtrace (ert-test-failed-backtrace result)) + (goto-char (point-min)) + (end-of-line) + (let ((first-line (buffer-substring-no-properties (point-min) (point)))) + (should (equal first-line " signal(ert-test-failed (\"foo\"))"))))))) + +(ert-deftest ert-test-messages () + :tags '(:causes-redisplay) + (let* ((message-string "Test message") + (messages-buffer (get-buffer-create "*Messages*")) + (test (make-ert-test :body (lambda () (message "%s" message-string))))) + (with-current-buffer messages-buffer + (let ((result (ert-run-test test))) + (should (equal (concat message-string "\n") + (ert-test-result-messages result))))))) + +(ert-deftest ert-test-running-tests () + (let ((outer-test (ert-get-test 'ert-test-running-tests))) + (should (equal (ert-running-test) outer-test)) + (let (test1 test2 test3) + (setq test1 (make-ert-test + :name "1" + :body (lambda () + (should (equal (ert-running-test) outer-test)) + (should (equal ert--running-tests + (list test1 test2 test3 + outer-test))))) + test2 (make-ert-test + :name "2" + :body (lambda () + (should (equal (ert-running-test) outer-test)) + (should (equal ert--running-tests + (list test3 test2 outer-test))) + (ert-run-test test1))) + test3 (make-ert-test + :name "3" + :body (lambda () + (should (equal (ert-running-test) outer-test)) + (should (equal ert--running-tests + (list test3 outer-test))) + (ert-run-test test2)))) + (should (ert-test-passed-p (ert-run-test test3)))))) + +(ert-deftest ert-test-test-result-expected-p () + "Test `ert-test-result-expected-p' and (implicitly) `ert-test-result-type-p'." + ;; passing test + (let ((test (make-ert-test :body (lambda ())))) + (should (ert-test-result-expected-p test (ert-run-test test)))) + ;; unexpected failure + (let ((test (make-ert-test :body (lambda () (ert-fail "failed"))))) + (should-not (ert-test-result-expected-p test (ert-run-test test)))) + ;; expected failure + (let ((test (make-ert-test :body (lambda () (ert-fail "failed")) + :expected-result-type ':failed))) + (should (ert-test-result-expected-p test (ert-run-test test)))) + ;; `not' expected type + (let ((test (make-ert-test :body (lambda ()) + :expected-result-type '(not :failed)))) + (should (ert-test-result-expected-p test (ert-run-test test)))) + (let ((test (make-ert-test :body (lambda ()) + :expected-result-type '(not :passed)))) + (should-not (ert-test-result-expected-p test (ert-run-test test)))) + ;; `and' expected type + (let ((test (make-ert-test :body (lambda ()) + :expected-result-type '(and :passed :failed)))) + (should-not (ert-test-result-expected-p test (ert-run-test test)))) + (let ((test (make-ert-test :body (lambda ()) + :expected-result-type '(and :passed + (not :failed))))) + (should (ert-test-result-expected-p test (ert-run-test test)))) + ;; `or' expected type + (let ((test (make-ert-test :body (lambda ()) + :expected-result-type '(or (and :passed :failed) + :passed)))) + (should (ert-test-result-expected-p test (ert-run-test test)))) + (let ((test (make-ert-test :body (lambda ()) + :expected-result-type '(or (and :passed :failed) + nil (not t))))) + (should-not (ert-test-result-expected-p test (ert-run-test test))))) + +;;; Test `ert-select-tests'. +(ert-deftest ert-test-select-regexp () + (should (equal (ert-select-tests "^ert-test-select-regexp$" t) + (list (ert-get-test 'ert-test-select-regexp))))) + +(ert-deftest ert-test-test-boundp () + (should (ert-test-boundp 'ert-test-test-boundp)) + (should-not (ert-test-boundp (make-symbol "ert-not-a-test")))) + +(ert-deftest ert-test-select-member () + (should (equal (ert-select-tests '(member ert-test-select-member) t) + (list (ert-get-test 'ert-test-select-member))))) + +(ert-deftest ert-test-select-test () + (should (equal (ert-select-tests (ert-get-test 'ert-test-select-test) t) + (list (ert-get-test 'ert-test-select-test))))) + +(ert-deftest ert-test-select-symbol () + (should (equal (ert-select-tests 'ert-test-select-symbol t) + (list (ert-get-test 'ert-test-select-symbol))))) + +(ert-deftest ert-test-select-and () + (let ((test (make-ert-test + :name nil + :body nil + :most-recent-result (make-ert-test-failed + :condition nil + :backtrace nil + :infos nil)))) + (should (equal (ert-select-tests `(and (member ,test) :failed) t) + (list test))))) + +(ert-deftest ert-test-select-tag () + (let ((test (make-ert-test + :name nil + :body nil + :tags '(a b)))) + (should (equal (ert-select-tests `(tag a) (list test)) (list test))) + (should (equal (ert-select-tests `(tag b) (list test)) (list test))) + (should (equal (ert-select-tests `(tag c) (list test)) '())))) + + +;;; Tests for utility functions. +(ert-deftest ert-test-proper-list-p () + (should (ert--proper-list-p '())) + (should (ert--proper-list-p '(1))) + (should (ert--proper-list-p '(1 2))) + (should (ert--proper-list-p '(1 2 3))) + (should (ert--proper-list-p '(1 2 3 4))) + (should (not (ert--proper-list-p 'a))) + (should (not (ert--proper-list-p '(1 . a)))) + (should (not (ert--proper-list-p '(1 2 . a)))) + (should (not (ert--proper-list-p '(1 2 3 . a)))) + (should (not (ert--proper-list-p '(1 2 3 4 . a)))) + (let ((a (list 1))) + (setf (cdr (last a)) a) + (should (not (ert--proper-list-p a)))) + (let ((a (list 1 2))) + (setf (cdr (last a)) a) + (should (not (ert--proper-list-p a)))) + (let ((a (list 1 2 3))) + (setf (cdr (last a)) a) + (should (not (ert--proper-list-p a)))) + (let ((a (list 1 2 3 4))) + (setf (cdr (last a)) a) + (should (not (ert--proper-list-p a)))) + (let ((a (list 1 2))) + (setf (cdr (last a)) (cdr a)) + (should (not (ert--proper-list-p a)))) + (let ((a (list 1 2 3))) + (setf (cdr (last a)) (cdr a)) + (should (not (ert--proper-list-p a)))) + (let ((a (list 1 2 3 4))) + (setf (cdr (last a)) (cdr a)) + (should (not (ert--proper-list-p a)))) + (let ((a (list 1 2 3))) + (setf (cdr (last a)) (cddr a)) + (should (not (ert--proper-list-p a)))) + (let ((a (list 1 2 3 4))) + (setf (cdr (last a)) (cddr a)) + (should (not (ert--proper-list-p a)))) + (let ((a (list 1 2 3 4))) + (setf (cdr (last a)) (cdddr a)) + (should (not (ert--proper-list-p a))))) + +(ert-deftest ert-test-parse-keys-and-body () + (should (equal (ert--parse-keys-and-body '(foo)) '(nil (foo)))) + (should (equal (ert--parse-keys-and-body '(:bar foo)) '((:bar foo) nil))) + (should (equal (ert--parse-keys-and-body '(:bar foo a (b))) + '((:bar foo) (a (b))))) + (should (equal (ert--parse-keys-and-body '(:bar foo :a (b))) + '((:bar foo :a (b)) nil))) + (should (equal (ert--parse-keys-and-body '(bar foo :a (b))) + '(nil (bar foo :a (b))))) + (should-error (ert--parse-keys-and-body '(:bar foo :a)))) + + +(ert-deftest ert-test-run-tests-interactively () + :tags '(:causes-redisplay) + (let ((passing-test (make-ert-test :name 'passing-test + :body (lambda () (ert-pass)))) + (failing-test (make-ert-test :name 'failing-test + :body (lambda () (ert-fail + "failure message"))))) + (let ((ert-debug-on-error nil)) + (let* ((buffer-name (generate-new-buffer-name " *ert-test-run-tests*")) + (messages nil) + (mock-message-fn + (lambda (format-string &rest args) + (push (apply #'format format-string args) messages)))) + (save-window-excursion + (unwind-protect + (let ((case-fold-search nil)) + (ert-run-tests-interactively + `(member ,passing-test ,failing-test) buffer-name + mock-message-fn) + (should (equal messages `(,(concat + "Ran 2 tests, 1 results were " + "as expected, 1 unexpected")))) + (with-current-buffer buffer-name + (goto-char (point-min)) + (should (equal + (buffer-substring (point-min) + (save-excursion + (forward-line 4) + (point))) + (concat + "Selector: (member )\n" + "Passed: 1\n" + "Failed: 1 (1 unexpected)\n" + "Total: 2/2\n"))))) + (when (get-buffer buffer-name) + (kill-buffer buffer-name)))))))) + +(ert-deftest ert-test-special-operator-p () + (should (ert--special-operator-p 'if)) + (should-not (ert--special-operator-p 'car)) + (should-not (ert--special-operator-p 'ert--special-operator-p)) + (let ((b (ert--gensym))) + (should-not (ert--special-operator-p b)) + (fset b 'if) + (should (ert--special-operator-p b)))) + +(ert-deftest ert-test-list-of-should-forms () + (let ((test (make-ert-test :body (lambda () + (should t) + (should (null '())) + (should nil) + (should t))))) + (let ((result (let ((ert-debug-on-error nil)) + (ert-run-test test)))) + (should (equal (ert-test-result-should-forms result) + '(((should t) :form t :value t) + ((should (null '())) :form (null nil) :value t) + ((should nil) :form nil :value nil))))))) + +(ert-deftest ert-test-list-of-should-forms-observers-should-not-stack () + (let ((test (make-ert-test + :body (lambda () + (let ((test2 (make-ert-test + :body (lambda () + (should t))))) + (let ((result (ert-run-test test2))) + (should (ert-test-passed-p result)))))))) + (let ((result (let ((ert-debug-on-error nil)) + (ert-run-test test)))) + (should (ert-test-passed-p result)) + (should (eql (length (ert-test-result-should-forms result)) + 1))))) + +(ert-deftest ert-test-list-of-should-forms-no-deep-copy () + (let ((test (make-ert-test :body (lambda () + (let ((obj (list 'a))) + (should (equal obj '(a))) + (setf (car obj) 'b) + (should (equal obj '(b)))))))) + (let ((result (let ((ert-debug-on-error nil)) + (ert-run-test test)))) + (should (ert-test-passed-p result)) + (should (equal (ert-test-result-should-forms result) + '(((should (equal obj '(a))) :form (equal (b) (a)) :value t + :explanation nil) + ((should (equal obj '(b))) :form (equal (b) (b)) :value t + :explanation nil) + )))))) + +(ert-deftest ert-test-remprop () + (let ((x (ert--gensym))) + (should (equal (symbol-plist x) '())) + ;; Remove nonexistent property on empty plist. + (ert--remprop x 'b) + (should (equal (symbol-plist x) '())) + (put x 'a 1) + (should (equal (symbol-plist x) '(a 1))) + ;; Remove nonexistent property on nonempty plist. + (ert--remprop x 'b) + (should (equal (symbol-plist x) '(a 1))) + (put x 'b 2) + (put x 'c 3) + (put x 'd 4) + (should (equal (symbol-plist x) '(a 1 b 2 c 3 d 4))) + ;; Remove property that is neither first nor last. + (ert--remprop x 'c) + (should (equal (symbol-plist x) '(a 1 b 2 d 4))) + ;; Remove last property from a plist of length >1. + (ert--remprop x 'd) + (should (equal (symbol-plist x) '(a 1 b 2))) + ;; Remove first property from a plist of length >1. + (ert--remprop x 'a) + (should (equal (symbol-plist x) '(b 2))) + ;; Remove property when there is only one. + (ert--remprop x 'b) + (should (equal (symbol-plist x) '())))) + +(ert-deftest ert-test-remove-if-not () + (let ((list (list 'a 'b 'c 'd)) + (i 0)) + (let ((result (ert--remove-if-not (lambda (x) + (should (eql x (nth i list))) + (incf i) + (member i '(2 3))) + list))) + (should (equal i 4)) + (should (equal result '(b c))) + (should (equal list '(a b c d))))) + (should (equal '() + (ert--remove-if-not (lambda (x) (should nil)) '())))) + +(ert-deftest ert-test-remove* () + (let ((list (list 'a 'b 'c 'd)) + (key-index 0) + (test-index 0)) + (let ((result + (ert--remove* 'foo list + :key (lambda (x) + (should (eql x (nth key-index list))) + (prog1 + (list key-index x) + (incf key-index))) + :test + (lambda (a b) + (should (eql a 'foo)) + (should (equal b (list test-index + (nth test-index list)))) + (incf test-index) + (member test-index '(2 3)))))) + (should (equal key-index 4)) + (should (equal test-index 4)) + (should (equal result '(a d))) + (should (equal list '(a b c d))))) + (let ((x (cons nil nil)) + (y (cons nil nil))) + (should (equal (ert--remove* x (list x y)) + ;; or (list x), since we use `equal' -- the + ;; important thing is that only one element got + ;; removed, this proves that the default test is + ;; `eql', not `equal' + (list y))))) + + +(ert-deftest ert-test-set-functions () + (let ((c1 (cons nil nil)) + (c2 (cons nil nil)) + (sym (make-symbol "a"))) + (let ((e '()) + (a (list 'a 'b sym nil "" "x" c1 c2)) + (b (list c1 'y 'b sym 'x))) + (should (equal (ert--set-difference e e) e)) + (should (equal (ert--set-difference a e) a)) + (should (equal (ert--set-difference e a) e)) + (should (equal (ert--set-difference a a) e)) + (should (equal (ert--set-difference b e) b)) + (should (equal (ert--set-difference e b) e)) + (should (equal (ert--set-difference b b) e)) + (should (equal (ert--set-difference a b) (list 'a nil "" "x" c2))) + (should (equal (ert--set-difference b a) (list 'y 'x))) + + ;; We aren't testing whether this is really using `eq' rather than `eql'. + (should (equal (ert--set-difference-eq e e) e)) + (should (equal (ert--set-difference-eq a e) a)) + (should (equal (ert--set-difference-eq e a) e)) + (should (equal (ert--set-difference-eq a a) e)) + (should (equal (ert--set-difference-eq b e) b)) + (should (equal (ert--set-difference-eq e b) e)) + (should (equal (ert--set-difference-eq b b) e)) + (should (equal (ert--set-difference-eq a b) (list 'a nil "" "x" c2))) + (should (equal (ert--set-difference-eq b a) (list 'y 'x))) + + (should (equal (ert--union e e) e)) + (should (equal (ert--union a e) a)) + (should (equal (ert--union e a) a)) + (should (equal (ert--union a a) a)) + (should (equal (ert--union b e) b)) + (should (equal (ert--union e b) b)) + (should (equal (ert--union b b) b)) + (should (equal (ert--union a b) (list 'a 'b sym nil "" "x" c1 c2 'y 'x))) + (should (equal (ert--union b a) (list c1 'y 'b sym 'x 'a nil "" "x" c2))) + + (should (equal (ert--intersection e e) e)) + (should (equal (ert--intersection a e) e)) + (should (equal (ert--intersection e a) e)) + (should (equal (ert--intersection a a) a)) + (should (equal (ert--intersection b e) e)) + (should (equal (ert--intersection e b) e)) + (should (equal (ert--intersection b b) b)) + (should (equal (ert--intersection a b) (list 'b sym c1))) + (should (equal (ert--intersection b a) (list c1 'b sym)))))) + +(ert-deftest ert-test-gensym () + ;; Since the expansion of `should' calls `ert--gensym' and thus has a + ;; side-effect on `ert--gensym-counter', we have to make sure all + ;; macros in our test body are expanded before we rebind + ;; `ert--gensym-counter' and run the body. Otherwise, the test would + ;; fail if run interpreted. + (let ((body (byte-compile + '(lambda () + (should (equal (symbol-name (ert--gensym)) "G0")) + (should (equal (symbol-name (ert--gensym)) "G1")) + (should (equal (symbol-name (ert--gensym)) "G2")) + (should (equal (symbol-name (ert--gensym "foo")) "foo3")) + (should (equal (symbol-name (ert--gensym "bar")) "bar4")) + (should (equal ert--gensym-counter 5)))))) + (let ((ert--gensym-counter 0)) + (funcall body)))) + +(ert-deftest ert-test-coerce-to-vector () + (let* ((a (vector)) + (b (vector 1 a 3)) + (c (list)) + (d (list b a))) + (should (eql (ert--coerce-to-vector a) a)) + (should (eql (ert--coerce-to-vector b) b)) + (should (equal (ert--coerce-to-vector c) (vector))) + (should (equal (ert--coerce-to-vector d) (vector b a))))) + +(ert-deftest ert-test-string-position () + (should (eql (ert--string-position ?x "") nil)) + (should (eql (ert--string-position ?a "abc") 0)) + (should (eql (ert--string-position ?b "abc") 1)) + (should (eql (ert--string-position ?c "abc") 2)) + (should (eql (ert--string-position ?d "abc") nil)) + (should (eql (ert--string-position ?A "abc") nil))) + +(ert-deftest ert-test-mismatch () + (should (eql (ert--mismatch "" "") nil)) + (should (eql (ert--mismatch "" "a") 0)) + (should (eql (ert--mismatch "a" "a") nil)) + (should (eql (ert--mismatch "ab" "a") 1)) + (should (eql (ert--mismatch "Aa" "aA") 0)) + (should (eql (ert--mismatch '(a b c) '(a b d)) 2))) + +(ert-deftest ert-test-string-first-line () + (should (equal (ert--string-first-line "") "")) + (should (equal (ert--string-first-line "abc") "abc")) + (should (equal (ert--string-first-line "abc\n") "abc")) + (should (equal (ert--string-first-line "foo\nbar") "foo")) + (should (equal (ert--string-first-line " foo\nbar\nbaz\n") " foo"))) + +(ert-deftest ert-test-explain-not-equal () + (should (equal (ert--explain-not-equal nil 'foo) + '(different-atoms nil foo))) + (should (equal (ert--explain-not-equal '(a a) '(a b)) + '(list-elt 1 (different-atoms a b)))) + (should (equal (ert--explain-not-equal '(1 48) '(1 49)) + '(list-elt 1 (different-atoms (48 "#x30" "?0") + (49 "#x31" "?1"))))) + (should (equal (ert--explain-not-equal 'nil '(a)) + '(different-types nil (a)))) + (should (equal (ert--explain-not-equal '(a b c) '(a b c d)) + '(proper-lists-of-different-length 3 4 (a b c) (a b c d) + first-mismatch-at 3))) + (let ((sym (make-symbol "a"))) + (should (equal (ert--explain-not-equal 'a sym) + `(different-symbols-with-the-same-name a ,sym))))) + +(ert-deftest ert-test-explain-not-equal-improper-list () + (should (equal (ert--explain-not-equal '(a . b) '(a . c)) + '(cdr (different-atoms b c))))) + +(ert-deftest ert-test-significant-plist-keys () + (should (equal (ert--significant-plist-keys '()) '())) + (should (equal (ert--significant-plist-keys '(a b c d e f c g p q r nil s t)) + '(a c e p s)))) + +(ert-deftest ert-test-plist-difference-explanation () + (should (equal (ert--plist-difference-explanation + '(a b c nil) '(a b)) + nil)) + (should (equal (ert--plist-difference-explanation + '(a b c t) '(a b)) + '(different-properties-for-key c (different-atoms t nil)))) + (should (equal (ert--plist-difference-explanation + '(a b c t) '(c nil a b)) + '(different-properties-for-key c (different-atoms t nil)))) + (should (equal (ert--plist-difference-explanation + '(a b c (foo . bar)) '(c (foo . baz) a b)) + '(different-properties-for-key c + (cdr + (different-atoms bar baz)))))) + +(ert-deftest ert-test-abbreviate-string () + (should (equal (ert--abbreviate-string "foo" 4 nil) "foo")) + (should (equal (ert--abbreviate-string "foo" 3 nil) "foo")) + (should (equal (ert--abbreviate-string "foo" 3 nil) "foo")) + (should (equal (ert--abbreviate-string "foo" 2 nil) "fo")) + (should (equal (ert--abbreviate-string "foo" 1 nil) "f")) + (should (equal (ert--abbreviate-string "foo" 0 nil) "")) + (should (equal (ert--abbreviate-string "bar" 4 t) "bar")) + (should (equal (ert--abbreviate-string "bar" 3 t) "bar")) + (should (equal (ert--abbreviate-string "bar" 3 t) "bar")) + (should (equal (ert--abbreviate-string "bar" 2 t) "ar")) + (should (equal (ert--abbreviate-string "bar" 1 t) "r")) + (should (equal (ert--abbreviate-string "bar" 0 t) ""))) + +(ert-deftest ert-test-explain-not-equal-string-properties () + (should + (equal (ert--explain-not-equal-including-properties #("foo" 0 1 (a b)) + "foo") + '(char 0 "f" + (different-properties-for-key a (different-atoms b nil)) + context-before "" + context-after "oo"))) + (should (equal (ert--explain-not-equal-including-properties + #("foo" 1 3 (a b)) + #("goo" 0 1 (c d))) + '(array-elt 0 (different-atoms (?f "#x66" "?f") + (?g "#x67" "?g"))))) + (should + (equal (ert--explain-not-equal-including-properties + #("foo" 0 1 (a b c d) 1 3 (a b)) + #("foo" 0 1 (c d a b) 1 2 (a foo))) + '(char 1 "o" (different-properties-for-key a (different-atoms b foo)) + context-before "f" context-after "o")))) + +(ert-deftest ert-test-equal-including-properties () + (should (equal-including-properties "foo" "foo")) + (should (ert-equal-including-properties "foo" "foo")) + + (should (equal-including-properties #("foo" 0 3 (a b)) + (propertize "foo" 'a 'b))) + (should (ert-equal-including-properties #("foo" 0 3 (a b)) + (propertize "foo" 'a 'b))) + + (should (equal-including-properties #("foo" 0 3 (a b c d)) + (propertize "foo" 'a 'b 'c 'd))) + (should (ert-equal-including-properties #("foo" 0 3 (a b c d)) + (propertize "foo" 'a 'b 'c 'd))) + + (should-not (equal-including-properties #("foo" 0 3 (a b c e)) + (propertize "foo" 'a 'b 'c 'd))) + (should-not (ert-equal-including-properties #("foo" 0 3 (a b c e)) + (propertize "foo" 'a 'b 'c 'd))) + + ;; This is bug 6581. + (should-not (equal-including-properties #("foo" 0 3 (a (t))) + (propertize "foo" 'a (list t)))) + (should (ert-equal-including-properties #("foo" 0 3 (a (t))) + (propertize "foo" 'a (list t))))) + +(ert-deftest ert-test-stats-set-test-and-result () + (let* ((test-1 (make-ert-test :name 'test-1 + :body (lambda () nil))) + (test-2 (make-ert-test :name 'test-2 + :body (lambda () nil))) + (test-3 (make-ert-test :name 'test-2 + :body (lambda () nil))) + (stats (ert--make-stats (list test-1 test-2) 't)) + (failed (make-ert-test-failed :condition nil + :backtrace nil + :infos nil))) + (should (eql 2 (ert-stats-total stats))) + (should (eql 0 (ert-stats-completed stats))) + (should (eql 0 (ert-stats-completed-expected stats))) + (should (eql 0 (ert-stats-completed-unexpected stats))) + (ert--stats-set-test-and-result stats 0 test-1 (make-ert-test-passed)) + (should (eql 2 (ert-stats-total stats))) + (should (eql 1 (ert-stats-completed stats))) + (should (eql 1 (ert-stats-completed-expected stats))) + (should (eql 0 (ert-stats-completed-unexpected stats))) + (ert--stats-set-test-and-result stats 0 test-1 failed) + (should (eql 2 (ert-stats-total stats))) + (should (eql 1 (ert-stats-completed stats))) + (should (eql 0 (ert-stats-completed-expected stats))) + (should (eql 1 (ert-stats-completed-unexpected stats))) + (ert--stats-set-test-and-result stats 0 test-1 nil) + (should (eql 2 (ert-stats-total stats))) + (should (eql 0 (ert-stats-completed stats))) + (should (eql 0 (ert-stats-completed-expected stats))) + (should (eql 0 (ert-stats-completed-unexpected stats))) + (ert--stats-set-test-and-result stats 0 test-3 failed) + (should (eql 2 (ert-stats-total stats))) + (should (eql 1 (ert-stats-completed stats))) + (should (eql 0 (ert-stats-completed-expected stats))) + (should (eql 1 (ert-stats-completed-unexpected stats))) + (ert--stats-set-test-and-result stats 1 test-2 (make-ert-test-passed)) + (should (eql 2 (ert-stats-total stats))) + (should (eql 2 (ert-stats-completed stats))) + (should (eql 1 (ert-stats-completed-expected stats))) + (should (eql 1 (ert-stats-completed-unexpected stats))) + (ert--stats-set-test-and-result stats 0 test-1 (make-ert-test-passed)) + (should (eql 2 (ert-stats-total stats))) + (should (eql 2 (ert-stats-completed stats))) + (should (eql 2 (ert-stats-completed-expected stats))) + (should (eql 0 (ert-stats-completed-unexpected stats))))) + + +(provide 'ert-tests) + +;;; ert-tests.el ends here === added file 'test/automated/ert-x-tests.el' --- test/automated/ert-x-tests.el 1970-01-01 00:00:00 +0000 +++ test/automated/ert-x-tests.el 2011-01-12 16:08:24 +0000 @@ -0,0 +1,273 @@ +;;; ert-x-tests.el --- Tests for ert-x.el + +;; Copyright (C) 2008, 2010, 2011 Free Software Foundation, Inc. + +;; Author: Phil Hagelberg +;; Author: Christian Ohler + +;; This file is part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see `http://www.gnu.org/licenses/'. + +;;; Commentary: + +;; This file is part of ERT, the Emacs Lisp Regression Testing tool. +;; See ert.el or the texinfo manual for more details. + +;;; Code: + +(eval-when-compile + (require 'cl)) +(require 'ert) +(require 'ert-x) + +;;; Utilities + +(ert-deftest ert-test-buffer-string-reindented () + (ert-with-test-buffer (:name "well-indented") + (insert (concat "(hello (world\n" + " 'elisp)\n")) + (emacs-lisp-mode) + (should (equal (ert-buffer-string-reindented) (buffer-string)))) + (ert-with-test-buffer (:name "badly-indented") + (insert (concat "(hello\n" + " world)")) + (emacs-lisp-mode) + (should-not (equal (ert-buffer-string-reindented) (buffer-string))))) + +(defun ert--hash-table-to-alist (table) + (let ((accu nil)) + (maphash (lambda (key value) + (push (cons key value) accu)) + table) + (nreverse accu))) + +(ert-deftest ert-test-test-buffers () + (let (buffer-1 + buffer-2) + (let ((test-1 + (make-ert-test + :name 'test-1 + :body (lambda () + (ert-with-test-buffer (:name "foo") + (should (string-match + "[*]Test buffer (ert-test-test-buffers): foo[*]" + (buffer-name))) + (setq buffer-1 (current-buffer)))))) + (test-2 + (make-ert-test + :name 'test-2 + :body (lambda () + (ert-with-test-buffer (:name "bar") + (should (string-match + "[*]Test buffer (ert-test-test-buffers): bar[*]" + (buffer-name))) + (setq buffer-2 (current-buffer)) + (ert-fail "fail for test")))))) + (let ((ert--test-buffers (make-hash-table :weakness t))) + (ert-run-tests `(member ,test-1 ,test-2) #'ignore) + (should (equal (ert--hash-table-to-alist ert--test-buffers) + `((,buffer-2 . t)))) + (should-not (buffer-live-p buffer-1)) + (should (buffer-live-p buffer-2)))))) + + +(ert-deftest ert-filter-string () + (should (equal (ert-filter-string "foo bar baz" "quux") + "foo bar baz")) + (should (equal (ert-filter-string "foo bar baz" "bar") + "foo baz"))) + +(ert-deftest ert-propertized-string () + (should (ert-equal-including-properties + (ert-propertized-string "a" '(a b) "b" '(c t) "cd") + #("abcd" 1 2 (a b) 2 4 (c t)))) + (should (ert-equal-including-properties + (ert-propertized-string "foo " '(face italic) "bar" " baz" nil + " quux") + #("foo bar baz quux" 4 11 (face italic))))) + + +;;; Tests for ERT itself that require test features from ert-x.el. + +(ert-deftest ert-test-run-tests-interactively-2 () + :tags '(:causes-redisplay) + (let ((passing-test (make-ert-test :name 'passing-test + :body (lambda () (ert-pass)))) + (failing-test (make-ert-test :name 'failing-test + :body (lambda () + (ert-info ((propertize "foo\nbar" + 'a 'b)) + (ert-fail + "failure message")))))) + (let ((ert-debug-on-error nil)) + (let* ((buffer-name (generate-new-buffer-name "*ert-test-run-tests*")) + (messages nil) + (mock-message-fn + (lambda (format-string &rest args) + (push (apply #'format format-string args) messages)))) + (flet ((expected-string (with-font-lock-p) + (ert-propertized-string + "Selector: (member )\n" + "Passed: 1\n" + "Failed: 1 (1 unexpected)\n" + "Total: 2/2\n\n" + "Started at:\n" + "Finished.\n" + "Finished at:\n\n" + `(category ,(button-category-symbol + 'ert--results-progress-bar-button) + button (t) + face ,(if with-font-lock-p + 'ert-test-result-unexpected + 'button)) + ".F" nil "\n\n" + `(category ,(button-category-symbol + 'ert--results-expand-collapse-button) + button (t) + face ,(if with-font-lock-p + 'ert-test-result-unexpected + 'button)) + "F" nil " " + `(category ,(button-category-symbol + 'ert--test-name-button) + button (t) + ert-test-name failing-test) + "failing-test" + nil "\n Info: " '(a b) "foo\n" + nil " " '(a b) "bar" + nil "\n (ert-test-failed \"failure message\")\n\n\n" + ))) + (save-window-excursion + (unwind-protect + (let ((case-fold-search nil)) + (ert-run-tests-interactively + `(member ,passing-test ,failing-test) buffer-name + mock-message-fn) + (should (equal messages `(,(concat + "Ran 2 tests, 1 results were " + "as expected, 1 unexpected")))) + (with-current-buffer buffer-name + (font-lock-mode 0) + (should (ert-equal-including-properties + (ert-filter-string (buffer-string) + '("Started at:\\(.*\\)$" 1) + '("Finished at:\\(.*\\)$" 1)) + (expected-string nil))) + ;; `font-lock-mode' only works if interactive, so + ;; pretend we are. + (let ((noninteractive nil)) + (font-lock-mode 1)) + (should (ert-equal-including-properties + (ert-filter-string (buffer-string) + '("Started at:\\(.*\\)$" 1) + '("Finished at:\\(.*\\)$" 1)) + (expected-string t))))) + (when (get-buffer buffer-name) + (kill-buffer buffer-name))))))))) + +(ert-deftest ert-test-describe-test () + "Tests `ert-describe-test'." + (save-window-excursion + (ert-with-buffer-renamed ("*Help*") + (if (< emacs-major-version 24) + (should (equal (should-error (ert-describe-test 'ert-describe-test)) + '(error "Requires Emacs 24"))) + (ert-describe-test 'ert-test-describe-test) + (with-current-buffer "*Help*" + (let ((case-fold-search nil)) + (should (string-match (concat + "\\`ert-test-describe-test is a test" + " defined in `ert-x-tests.elc?'\\.\n\n" + "Tests `ert-describe-test'\\.\n\\'") + (buffer-string))))))))) + +(ert-deftest ert-test-message-log-truncation () + :tags '(:causes-redisplay) + (let ((test (make-ert-test + :body (lambda () + ;; Emacs would combine messages if we + ;; generate the same message multiple + ;; times. + (message "a") + (message "b") + (message "c") + (message "d"))))) + (let (result) + (ert-with-buffer-renamed ("*Messages*") + (let ((message-log-max 2)) + (setq result (ert-run-test test))) + (should (equal (with-current-buffer "*Messages*" + (buffer-string)) + "c\nd\n"))) + (should (equal (ert-test-result-messages result) "a\nb\nc\nd\n"))))) + +(ert-deftest ert-test-builtin-message-log-flushing () + "This test attempts to demonstrate that there is no way to +force immediate truncation of the *Messages* buffer from Lisp +\(and hence justifies the existence of +`ert--force-message-log-buffer-truncation'\): The only way that +came to my mind was \(message \"\"\), which doesn't have the +desired effect." + :tags '(:causes-redisplay) + (ert-with-buffer-renamed ("*Messages*") + (with-current-buffer "*Messages*" + (should (equal (buffer-string) "")) + ;; We used to get sporadic failures in this test that involved + ;; a spurious newline at the beginning of the buffer, before + ;; the first message. Below, we print a message and erase the + ;; buffer since this seems to eliminate the sporadic failures. + (message "foo") + (erase-buffer) + (should (equal (buffer-string) "")) + (let ((message-log-max 2)) + (let ((message-log-max t)) + (loop for i below 4 do + (message "%s" i)) + (should (equal (buffer-string) "0\n1\n2\n3\n"))) + (should (equal (buffer-string) "0\n1\n2\n3\n")) + (message "") + (should (equal (buffer-string) "0\n1\n2\n3\n")) + (message "Test message") + (should (equal (buffer-string) "3\nTest message\n")))))) + +(ert-deftest ert-test-force-message-log-buffer-truncation () + :tags '(:causes-redisplay) + (labels ((body () + (loop for i below 3 do + (message "%s" i))) + ;; Uses the implicit messages buffer truncation implemented + ;; in Emacs' C core. + (c (x) + (ert-with-buffer-renamed ("*Messages*") + (let ((message-log-max x)) + (body)) + (with-current-buffer "*Messages*" + (buffer-string)))) + ;; Uses our lisp reimplementation. + (lisp (x) + (ert-with-buffer-renamed ("*Messages*") + (let ((message-log-max t)) + (body)) + (let ((message-log-max x)) + (ert--force-message-log-buffer-truncation)) + (with-current-buffer "*Messages*" + (buffer-string))))) + (loop for x in '(0 1 2 3 4 t) do + (should (equal (c x) (lisp x)))))) + + +(provide 'ert-x-tests) + +;;; ert-x-tests.el ends here ------------------------------------------------------------ revno: 102829 committer: Chong Yidong branch nick: trunk timestamp: Wed 2011-01-12 23:30:23 -0500 message: * font-lock.el (font-lock-verbose): Default to nil. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-13 04:23:41 +0000 +++ lisp/ChangeLog 2011-01-13 04:30:23 +0000 @@ -1,5 +1,9 @@ 2011-01-13 Chong Yidong + * font-lock.el (font-lock-verbose): Default to nil. + +2011-01-13 Chong Yidong + * simple.el (sendmail-user-agent-compose): Move to sendmail.el. (compose-mail): New arg RETURN-ACTION. (compose-mail-other-window, compose-mail-other-frame): Likewise. === modified file 'lisp/font-lock.el' --- lisp/font-lock.el 2010-10-06 04:14:05 +0000 +++ lisp/font-lock.el 2011-01-13 04:30:23 +0000 @@ -276,13 +276,14 @@ (integer :tag "level" 1))))) :group 'font-lock) -(defcustom font-lock-verbose 0 +(defcustom font-lock-verbose nil "If non-nil, means show status messages for buffer fontification. If a number, only buffers greater than this size have fontification messages." :type '(choice (const :tag "never" nil) (other :tag "always" t) (integer :tag "size")) - :group 'font-lock) + :group 'font-lock + :version "24.1") ;; Originally these variable values were face names such as `bold' etc. ------------------------------------------------------------ Use --include-merges or -n0 to see merged revisions.