diff options
Diffstat (limited to 'lisp')
534 files changed, 46603 insertions, 28982 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a2467e6b00f..a693cc0bdc6 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,10 +1,3 @@ -2015-01-22 Wolfgang Jenkner <wjenkner@inode.at> - - * calc/calc-units.el (math-units-in-expr-p) - (math-single-units-in-expr-p, math-find-compatible-unit-rec) - (math-extract-units): Handle the `neg' operator. (Bug#19582) - [Backport] - 2015-01-21 Daniel Koning <dk@danielkoning.com> (tiny change) * subr.el (posnp): Correct docstring of `posnp'. @@ -16,11 +9,6 @@ * button.el (button-activate, push-button): Doc fix. (Bug#19628) -2015-01-16 Samer Masterson <samer@samertm.com> (tiny change) - - * pcomplete.el (pcomplete-parse-arguments): Parse arguments - regardless of pcomplete-cycle-completions's value. (Bug#18950) - 2015-01-13 Michael Albinus <michael.albinus@gmx.de> * filenotify.el (file-notify-descriptors, file-notify-handle-event): @@ -33,32 +21,17 @@ * net/tramp.el (tramp-handle-file-notify-rm-watch): Do not check `file-notify-descriptors', the implementation has been changed. -2015-01-13 Juri Linkov <juri@linkov.net> - - * comint.el (comint-history-isearch-search) - (comint-history-isearch-wrap): Use field-beginning instead of - comint-line-beginning-position. - (comint-send-input): Go to the end of the field instead of the end - of the line to accept whole multi-line input. - http://lists.gnu.org/archive/html/emacs-devel/2014-12/msg00305.html - (comint-history-isearch-message): Use field-beginning - instead of comint-line-beginning-position - that's more fixes for - http://lists.gnu.org/archive/html/emacs-devel/2014-12/msg00305.html - (comint-history-isearch-message): Fix args of isearch-message-prefix. - - [Backport] - 2015-01-09 Eli Zaretskii <eliz@gnu.org> * net/net-utils.el (net-utils-run-program, net-utils-run-simple): On MS-Windows, bind coding-system-for-read to the console output codepage. (Bug#19458) -2015-01-08 Eli Zaretskii <eliz@gnu.org> +2015-01-04 Dmitry Gutov <dgutov@yandex.ru> - * simple.el (line-move-visual): When converting X pixel coordinate - to temporary-goal-column, adjust the value for right-to-left - screen lines. This fixes vertical-motion, next/prev-line, etc. + Unbreak `mouse-action' property in text buttons. + + * button.el (push-button): Fix regression from 2012-12-06. 2015-01-06 Glenn Morris <rgm@gnu.org> @@ -67,26 +40,1128 @@ 2014-12-14 Steve Purcell <steve@sanityinc.com> (tiny change) - * emacs-lisp/package.el (package-menu-mode): Use an extra column - for the "Version" column, to accomodate date-and-time-based versions. - 2015-01-04 Paul Eggert <eggert@cs.ucla.edu> Fix dired quoting bug with "Hit`N`Hide". Fixes Bug#19498. * files.el (shell-quote-wildcard-pattern): Also quote "`". +2015-01-27 Katsumi Yamaoka <yamaoka@jpl.org> + + * emacs-lisp/cl.el (cl--function-convert): + Merge cache that cl--labels-convert adds (bug#19699). + +2015-01-27 Ivan Shmakov <ivan@siamics.net> + + * tar-mode.el: Allow for adding new archive members. (Bug#19274) + (tar-new-regular-file-header, tar--pad-to, tar--put-at) + (tar-header-serialize): New functions. + (tar-current-position): Split from tar-current-descriptor. + (tar-current-descriptor): Use it. + (tar-new-entry): New command. + (tar-mode-map): Bind it. + +2015-01-27 Sam Steingold <sds@gnu.org> + + * progmodes/python.el (python-check-custom-command): Buffer local + because it usually includes the buffer name. + (python-check-command): Set to epylint when pyflakes is not available. + +2015-01-27 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/eudcb-bbdb.el, net/eudcb-ldap.el, net/eudcb-mab.el, + net/eudc-bob.el, net/eudcb-ph.el, net/eudc.el, net/eudc-export.el, + net/eudc-hotlist.el, net/eudc-vars.el: New maintainer. + +2015-01-27 Artur Malabarba <bruce.connor.am@gmail.com> + + * isearch.el (isearch-process-search-char): Add docstring. + +2015-01-27 Oleh Krehel <ohwoeowho@gmail.com> + + * emacs-lisp/derived.el (define-derived-mode): Declare indent 3. + +2015-01-27 Katsumi Yamaoka <yamaoka@jpl.org> + + * emacs-lisp/cl.el (cl--function-convert): Run cl--labels-convert + for the case cl-flet or cl-labels form is wrapped with lexical-let + (bug#19613). + +2015-01-26 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/cl-generic.el (cl--generic-method): New struct. + (cl--generic): The method-table is now a (list-of cl--generic-method). + (cl--generic-member-method): New function. + (cl-generic-define-method): Use it. + (cl--generic-build-combined-method, cl--generic-cache-miss): + Adapt to new method-table. + (cl--generic-no-next-method-function): Add `method' argument. + (cl-generic-call-method): Adapt to new method representation. + (cl--generic-cnm-sample, cl--generic-nnm-sample): Adjust. + (cl-find-method, cl-method-qualifiers): New functions. + (cl--generic-method-info): Adapt to new method representation. + Return a string for the qualifiers. + (cl--generic-describe): + * emacs-lisp/eieio-opt.el (eieio-help-class): Adjust accordingly. + (eieio-all-generic-functions, eieio-method-documentation): + Adjust to new method representation. + + * emacs-lisp/eieio-compat.el (eieio--defmethod): Use cl-find-method. + +2015-01-26 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/cl-generic.el: Add a method-combination hook. + (cl-generic-method-combination-function): New var. + (cl--generic-lambda): Remove `with-cnm' arg. + (cl-defmethod): Change accordingly. + (cl-generic-define-method): Don't check qualifiers validity. + Preserve all qualifiers in `method-table'. + (cl-generic-call-method): New function. + (cl--generic-nest): Remove (morph into cl-generic-call-method). + (cl--generic-build-combined-method): Adjust to new format of method-table + and use cl-generic-method-combination-function. + (cl--generic-standard-method-combination): New function, extracted from + cl--generic-build-combined-method. + (cl--generic-cnm-sample): Adjust to new format of method-table. + + * emacs-lisp/eieio-compat.el (eieio--defmethod): Use () qualifiers + instead of :primary. + + * emacs-lisp/eieio-datadebug.el (eieio-debug-methodinvoke): + Remove obsolete function. + +2015-01-26 Lars Ingebrigtsen <larsi@gnus.org> + + * net/shr.el (shr-make-table-1): Fix colspan typo. + + * net/eww.el (eww-add-bookmark): Fix prompt and clean up the code + slightly. + +2015-01-25 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/cl-generic.el (cl--generic-no-next-method-function): New fun. + (cl--generic-build-combined-method, cl--generic-nnm-sample): Use it + (bug#19672). + (cl--generic-typeof-types): Add support for `sequence'. + (cl-defmethod): Add non-keywords in the qualifiers. + +2015-01-25 Dmitry Gutov <dgutov@yandex.ru> + + * emacs-lisp/find-func.el (find-function-regexp): Don't match + `defgroup' (regression from the previous change here). + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/ldap.el (ldap-search-internal): Mention binddn in invalid + credentials error message. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/ldap.el (ldap-password-read): Validate password before + caching it. + (ldap-search-internal): Handle ldapsearch error conditions. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/ldap.el (ldap-password-read): Handle password-cache being nil. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/eudc.el (eudc-expand-inline): Always restore former server + and protocol. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/eudcb-ldap.el: Don't nag the user in case a default base is + provided by the LDAP system configuration file. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/eudc.el (eudc-format-query): Preserve the + eudc-inline-query-format ordering of attributes in the returned list. + * net/eudcb-ldap.el (eudc-ldap-format-query-as-rfc1558): + Append the LDAP wildcard character to the last attribute value. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/eudcb-ldap.el (eudc-ldap-cleanup-record-simple): + Downcase field names of LDAP results. + (eudc-ldap-cleanup-record-filtering-addresses): Likewise. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/ldap.el (ldap-ldapsearch-password-prompt): New defcustom. + (ldap-search-internal): Send password to ldapsearch through a pipe + instead of via the command line. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/ldap.el: Require password-cache. + (ldap-password-read): New function. + (ldap-search-internal): Call ldap-password-read when it is + configured to be called. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/eudc-vars.el (eudc-expansion-overwrites-query): + Change default to nil. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/eudc.el (eudc-expand-inline): Ignore text properties of + string-to-expand. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/eudc-vars.el (eudc-inline-expansion-format): Default to a + format that includes first name and surname. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/eudc-vars.el (eudc-inline-query-format): Change default to + query email and first name instead of surname. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/ldap.el (ldap-search-internal): Support new-style LDAP URIs. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/eudc-vars.el (eudc-server): Adjust docstring to mention + eudc-server-hotlist. + (eudc-server-hotlist): Move from eudc.el and make defcustom. + * net/eudc.el (eudc-server-hotlist): Move to eudc-vars.el. + (eudc-set-server): Allow setting protocol to nil. + (eudc-expand-inline): Support hotlist-only expansions when server + is not set. + +2015-01-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/cl-generic.el (cl-no-primary-method): New fun and error. + (cl--generic-build-combined-method): Use it. + +2015-01-22 Paul Eggert <eggert@cs.ucla.edu> + + Don't downcase system diagnostics' first letters + * emacs-lisp/bytecomp.el (byte-compile-file): + * ffap.el (find-file-at-point): + * files.el (insert-file-1): + * net/ange-ftp.el (ange-ftp-barf-if-not-directory) + (ange-ftp-copy-file-internal): + * progmodes/etags.el (visit-tags-table): + Keep diagnostics consistent with system's. + * ffap.el (ffap-machine-p): + Ignore case while comparing diagnostics. + +2015-01-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * help.el (help-make-usage): Don't turn a "_" arg into an empty-string + arg (bug#19645). + * emacs-lisp/cl-generic.el (cl--generic-lambda): Don't confuse a string + body with a docstring. + +2015-01-22 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/xref.el (xref-location-marker, xref-location-group): + Use `cl-defgeneric' and `cl-defmethod' instead of the EIEIO + counterparts. + + * progmodes/etags.el (xref-location-marker): Same. + + * progmodes/xref.el (xref--current): Rename from `xref--selected'. + (xref--inhibit-mark-current): Rename from + `xref--inhibit-mark-selected'. Update the usages. + (xref-quit): Reword the docstring. Kill buffers after quitting + windows instead of before. + (xref--insert-xrefs): Tweak help-echo. + (xref--read-identifier-history, xref--read-pattern-history): + New variables. + (xref--read-identifier, xref-find-apropos): Use them. + +2015-01-21 Ulrich Müller <ulm@gentoo.org> + + * play/gamegrid.el (gamegrid-add-score-with-update-game-score): + Allow the 'update-game-score' helper program to run suid or sgid. + +2015-01-21 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eieio.el: Use cl-defmethod. + (defclass): Generate cl-defmethod calls; use setf methods for :accessor. + (eieio-object-name-string): Declare as obsolete. + + * emacs-lisp/eieio-opt.el: Adapt to cl-generic. + (eieio--specializers-apply-to-class-p): New function. + (eieio-all-generic-functions): Use it. + (eieio-method-documentation): Use it as well as cl--generic-method-info. + Change format of return value. + (eieio-help-class): Adapt accordingly. + + * emacs-lisp/eieio-compat.el (eieio--defmethod): Avoid no-next-method + errors when there's a `before' but no `primary' (bug#19645). + (next-method-p): Return nil rather than signal an error. + (eieio-defgeneric): Remove bogus (fboundp 'method). + + * emacs-lisp/eieio-speedbar.el: + * emacs-lisp/eieio-datadebug.el: + * emacs-lisp/eieio-custom.el: + * emacs-lisp/eieio-base.el: Use cl-defmethod. + + * emacs-lisp/cl-generic.el (cl-defgeneric): Add support for `declare'. + (cl--generic-setf-rewrite): Setup the setf expander right away. + (cl-defmethod): Make sure the setf expander is setup before we expand + the body. + (cl-defmethod): Silence byte-compiler warnings. + (cl-generic-define-method): Shuffle code to change return value. + (cl--generic-method-info): New function, extracted from + cl--generic-describe. + (cl--generic-describe): Use it. + +2015-01-21 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/xref.el (xref--xref-buffer-mode-map): Define before + the major mode. Remap `quit-window' to `xref-quit'. + (xref--xref-buffer-mode): Inherit from special-mode. + + xref: Keep track of temporary buffers (bug#19466). + * progmodes/xref.el (xref--temporary-buffers, xref--selected) + (xref--inhibit-mark-selected): New variables. + (xref--mark-selected): New function. + (xref--show-location): Maybe add the buffer to + `xref--temporary-buffers', add `xref--mark-selected' to + `buffer-list-update-hook' there. + (xref--window): Add docstring. + (xref-quit): Rename from `xref--quit'. Update both references. + Add KILL argument. When it's non-nil, kill the temporary buffers + that haven't been selected by the user. + (xref--show-xref-buffer): Change the second argument to alist, + extract the values for `xref--window' and + `xref--temporary-buffers' from it. Add `xref--mark-selected' to + `buffer-list-update-hook' to each buffer in the list. + (xref--show-xrefs): Move the logic of calling `xref-find-function' + here. Save the difference between buffer lists before and after + it's called as "temporary buffers", and `pass it to + `xref-show-xrefs-function'. + (xref--find-definitions, xref-find-references) + (xref-find-apropos): Update accordingly. + +2015-01-20 Artur Malabarba <bruce.connor.am@gmail.com> + + * emacs-lisp/package.el (package-dir-info): Fix `while' logic. + +2015-01-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eieio-generic.el: Remove. + (defgeneric, defmethod): Move to eieio-compat.el. Mark obsolete. + * emacs-lisp/eieio-compat.el: New file. + * emacs-lisp/eieio.el: Don't require eieio-generic any more. + * emacs-lisp/eieio-core.el (eieio--slot-originating-class-p): + Remove unused function. + (eieio-defclass): Move to eieio-compat.el. + * emacs-lisp/macroexp.el (macroexp-macroexpand): New function. + (macroexp--expand-all): Use it. + * emacs-lisp/bytecomp.el (byte-compile-recurse-toplevel): Here too. + +2015-01-20 Michal Nazarewicz <mina86@mina86.com> + + * emacs-lisp/eldoc.el (eldoc-documentation-function): Describe how + major modes should use `add-function' to alter value of the variable. + * hexl.el (hexl-mode): + * ielm.el (inferior-emacs-lisp-mode): + * progmodes/cfengine.el (cfengine3-mode): + * progmodes/elisp-mode (emacs-lisp-mode): + * progmodes/octave.el (octave-mode): + * progmodes/python.el (python-mode): + * simple.el (read--expression): Set `eldoc-documentation-function' + using `add-function' so the default value is always used. + + * descr-text.el (describe-char-eldoc): New function returning + basic Unicode codepoint information (e.g. name) about character + at point. It is meant to be used as a default value of the + `eldoc-documentation-function' variable. + (describe-char-eldoc--format, describe-char-eldoc--truncate): + New helper functions for `describe-char-eldoc' function. + +2015-01-20 Michal Nazarewicz <mina86@mina86.com> + + * textmodes/paragraphs.el (sentence-end-base): Include an + ellipsis (…) and interrobang (‽) characters as end of a sentence, + and a closing single quote (’) as an end of a quote. + +2015-01-20 Michal Nazarewicz <mina86@mina86.com> + + * textmodes/tildify.el (tildify-double-space-undos): A new + variable specifying whether pressing space in `tildify-mode' after + a space has been replaced with hard space undos the substitution. + (tildify-space): Add code branch for handling `tildify-doule-space'. + + * textmodes/tildify.el (tildify-space): A new function + which can be used as a `post-self-insert-hook' to automatically + convert spaces into hard spaces. + (tildify-space-pattern): A new variable specifying pattern where + `tildify-space' should take effect. + (tildify-space-predicates): A new variable specifying list of + predicate functions that all must return non-nil for + `tildify-space' to take effect. + (tildify-space-region-predicate): A new functions meant to be + used as a predicate in `tildify-space-predicates' list. + (tildify-mode): A new minor mode enabling `tildify-space' as a + `post-self-insert-hook' + +2015-01-20 Daniel Colascione <dancol@dancol.org> + + * vc/vc-dir.el (vc-dir): Default to repository root, not + default-directory. + +2015-01-20 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/etags.el (xref-etags-location): New class. + (xref-make-etags-location): New function. + (etags--xref-find-definitions): Use it. + (xref-location-marker): New method implementation. + + * progmodes/xref.el: Mention that xref-location is an EIEIO class. + (xref--insert-xrefs): Expand help-echo string. + +2015-01-19 Dmitry Gutov <dgutov@yandex.ru> + + * ido.el: Update Customization instructions. + +2015-01-19 Jonas Bernoulli <jonas@bernoul.li> + + Define Ido keymaps once (bug#17000). + * ido.el (ido-common-completion-map) + (ido-file-dir-completion-map) + (ido-file-completion-map, ido-buffer-completion-map): Set up key + bindings when each variable is defined. + (ido-completion-map): Move definition. + (ido-init-completion-maps): Noop. + (ido-common-initialization): Don't call it. + (ido-setup-completion-map): Improve doc-string, cleanup. + +2015-01-19 Ivan Shmakov <ivan@siamics.net> + + * cus-dep.el (custom-make-dependencies): Ensure that + default-directory is interpreted as a directory (see bug#19140.) + +2015-01-19 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/xref.el (xref--display-position): + Set `other-window-scroll-buffer'. + (xref-goto-xref): Use `user-error'. + +2015-01-19 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/xref.el (xref--display-history): New variable. + (xref--window-configuration): Remove. + (xref--save-to-history): New function. + (xref--display-position): Use it. Add new argument. + (xref--restore-window-configuration): Remove. + (xref--show-location, xref-show-location-at-point): + Update accordingly. + (xref--xref-buffer-mode): Don't use `pre-command-hook'. + (xref--quit): New command. + (xref-goto-xref): Use it. + (xref--xref-buffer-mode-map): Bind `q' to it. + +2015-01-18 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/xref.el (xref-goto-xref): Perform the jump even inside + indentation or at eol. + +2015-01-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eieio-core.el: Add `subclass' specializer for cl-generic. + (eieio--generic-subclass-tagcode, eieio--generic-subclass-tag-types): + New functions. + (cl-generic-tagcode-function, cl-generic-tag-types-function): Use them. + + * emacs-lisp/eieio.el (defclass): Add obsolescence warning for the + `newname' argument. + + * emacs-lisp/cl-generic.el (cl-generic-define-method): Correctly handle + introduction of a new dispatch argument. + (cl--generic-cache-miss): Handle dispatch on an argument which was not + considered as dispatchable for this method. + (cl-defmethod): Warn when adding a method to an obsolete generic function. + (cl--generic-lambda): Make sure it works if cl-lib is not yet loaded. + + * emacs-lisp/eieio-generic.el (eieio--defgeneric-init-form): Use autoloadp. + +2015-01-18 Artur Malabarba <bruce.connor.am@gmail.com> + + * emacs-lisp/package.el (package--append-to-alist): Rename from + `package--add-to-alist' + Updated docstring due to new name. + +2015-01-18 Leo Liu <sdl.web@gmail.com> + + * emacs-lisp/cl-extra.el (cl-subseq): Use seq-subseq and fix + multiple evaluation. (Bug#19519) + + * emacs-lisp/seq.el (seq-subseq): Throw bad bounding indices + error. (Bug#19434) + +2015-01-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eieio-core.el: Add `subclass' specializer for cl-generic. + (eieio--generic-subclass-tagcode, eieio--generic-subclass-tag-types): + New functions. + (cl-generic-tagcode-function, cl-generic-tag-types-function): Use them. + + * emacs-lisp/cl-macs.el (cl-defstruct): Minor optimization when include + or print is nil. + (cl-struct-type-p): New function. + + * emacs-lisp/cl-generic.el: Add support for cl-next-method-p. + (cl-defmethod): Add edebug spec. + (cl--generic-build-combined-method): Fix call to + cl-no-applicable-method. + (cl--generic-nnm-sample, cl--generic-cnm-sample): New constant. + (cl--generic-isnot-nnm-p): New function. + (cl--generic-lambda): Use it to add support for cl-next-method-p. + (cl-no-next-method, cl-no-applicable-method): Simplify arg list. + (cl-next-method-p): New function. + +2015-01-17 Ulrich Müller <ulm@gentoo.org> + + * version.el (emacs-repository-get-version): Update docstring. + +2015-01-17 Ivan Shmakov <ivan@siamics.net> + + * url/url-cookie.el (url-cookie-write-file): Let-bind print-length + and print-level to nil to avoid writing a garbled list. (Bug#16805) + + * files.el (find-file-other-window, find-file-other-frame): + Use mapc instead of mapcar. (Bug#18175) + + * files.el (dir-locals-collect-variables): Use default-directory + in place of the file name while working on non-file buffers, just + like hack-dir-local-variables already does. (Bug#19140) + + * textmodes/enriched.el (enriched-encode): + Use inhibit-point-motion-hooks in addition to inhibit-read-only. + (Bug#18246) + + * desktop.el (desktop-read): Do not call desktop-clear when no + desktop file is found. (Bug#18371) + + * misearch.el (multi-isearch-unload-function): New function. + (misearch-unload-function): New alias. (Bug#19566) + +2015-01-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eieio-core.el (eieio--class-constructor): Rename from + class-constructor, and make it an alias for `identity'. + Update all callers. + + * emacs-lisp/eieio.el (eieio-constructor): Handle obsolete object name + argument here (bug#19620)... + (defclass): ...instead of in the constructor here. + +2015-01-16 Jorgen Schaefer <contact@jorgenschaefer.de> + + * emacs-lisp/package.el (package-archive-priorities): + Specify correct type. + +2015-01-17 Ulrich Müller <ulm@gentoo.org> + + * version.el (emacs-bzr-version-dirstate, emacs-bzr-version-bzr): + Remove. + (emacs-repository-get-version): Discard the Bazaar case. + * vc/vc-bzr.el (vc-bzr-version-dirstate): Rename from + emacs-bzr-version-dirstate and move from version.el to here. + (vc-bzr-working-revision): Use it. + +2015-01-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eieio-generic.el (call-next-method): Don't bother checking + eieio--scoped-class any more. + + * emacs-lisp/eieio-core.el (eieio--scoped-class-stack): Remove var. + (eieio--scoped-class): Remove function. + (eieio--with-scoped-class): Remove macro. Replace uses with `progn'. + (eieio--slot-name-index): Don't check the :protection anymore. + (eieio-initializing-object): Remove var. + (eieio-set-defaults): Don't let-bind eieio-initializing-object. + +2015-01-17 Stefan Monnier <monnier@iro.umontreal.ca> + + Improve handling of doc-strings and describe-function for cl-generic. + + * help-mode.el (help-function-def): Add optional arg `type'. + + * help-fns.el (find-lisp-object-file-name): Accept any `type' as long + as it's a symbol. + (help-fns-short-filename): New function. + (describe-function-1): Use it. Use autoload-do-load. + + * emacs-lisp/find-func.el: Use lexical-binding. + (find-function-regexp): Don't rule out `defgeneric'. + (find-function-regexp-alist): Document new possibility of including + a function instead of a regexp. + (find-function-search-for-symbol): Implement that new possibility. + (find-function-library): Don't assume that `function' is a symbol. + (find-function-do-it): Remove unused var `orig-buf'. + + * emacs-lisp/eieio-generic.el (eieio--defalias): Move from eieio-core. + (eieio--defgeneric-init-form): Don't throw away a previous docstring. + (eieio--method-optimize-primary): Don't mess with the docstring. + (defgeneric): Keep the `args' in the docstring. + (defmethod): Don't use the method's docstring for the generic + function's docstring. + + * emacs-lisp/eieio-core.el (eieio--defalias): Move to eieio-generic.el. + (eieio-defclass-autoload): Don't record the superclasses any more. + (eieio-defclass-internal): Reuse the old class object if it was just an + autoload stub. + (eieio--class-precedence-list): Load the class if it's autoloaded. + + * emacs-lisp/cl-generic.el (cl-generic-ensure-function): It's OK to + override an autoload. + (cl-generic-current-method-specializers): Replace dyn-bind variable + with a lexically-scoped macro. + (cl--generic-lambda): Update accordingly. + (cl-generic-define-method): Record manually in the load-history with + type `cl-defmethod'. + (cl--generic-get-dispatcher): Minor optimization. + (cl--generic-search-method): New function. + (find-function-regexp-alist): Add entry for `cl-defmethod' type. + (cl--generic-search-method): Add hyperlinks for methods. Merge the + specializers and the function's arguments. + +2015-01-16 Artur Malabarba <bruce.connor.am@gmail.com> + + * emacs-lisp/package.el (package--read-pkg-desc): + New function. Read a `define-package' form in current buffer. + Return the pkg-desc, with desc-kind set to KIND. + (package-dir-info): New function. Find package information for a + directory. The return result is a `package-desc'. + (package-install-from-buffer): Install packages from dired buffer. + (package-install-file): Install packages from directory. + (package-desc-suffix) + (package-install-from-archive) + * emacs-lisp/package-x.el (package-upload-buffer-internal): + Ensure all remaining instances of `package-desc-kind' handle the 'dir + value. + +2015-01-16 Jorgen Schaefer <contact@jorgenschaefer.de> + + * emacs-lisp/package.el: Provide repository priorities. + (package-archive-priorities): New variable. + (package--add-to-alist): New function. + (package--add-to-archive-contents): Use it. + (package-menu--find-upgrades): Use it as well. Small clean up to + make the use of the package name here explicit. + (package-archive-priority): New function. + (package-desc-priority-version): New function. + +2015-01-16 Daniel Colascione <dancol@dancol.org> + + * cus-start.el (all): Make `ring-bell-function' customizable. + +2015-01-16 Dmitry Gutov <dgutov@yandex.ru> + + * vc/vc-svn.el (vc-svn-dir-status-files): Pass t as + vc-svn-after-dir-status's second argument. (Bug#19429) + +2015-01-16 Samer Masterson <samer@samertm.com> (tiny change) + + * pcomplete.el (pcomplete-parse-arguments): Parse arguments + regardless of pcomplete-cycle-completions's value. (Bug#18950) + +2015-01-16 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * dom.el (dom-strings): New function. + + * files.el (directory-files-recursively): Don't use the word + "path" for a file name. + +2015-01-15 Wolfgang Jenkner <wjenkner@inode.at> + + * calc/calc-units.el (math-units-in-expr-p) + (math-single-units-in-expr-p, math-find-compatible-unit-rec) + (math-extract-units): Handle the `neg' operator. (Bug#19582) + +2015-01-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/cl-macs.el (cl--labels-magic): New constant. + (cl--labels-convert): Use it to ask the macro what is its replacement + in the #'f case. + + * emacs-lisp/cl-generic.el (cl--generic-build-combined-method): + Return the value of the primary rather than the after method. + + * emacs-lisp/eieio-core.el: Provide support for cl-generic. + (eieio--generic-tagcode): New function. + (cl-generic-tagcode-function): Use it. + (eieio--generic-tag-types): New function. + (cl-generic-tag-types-function): Use it. + (eieio-object-p): Tighten up the test. + + * emacs-lisp/cl-generic.el (cl-generic-define-method): Fix paren typo. + +2015-01-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/cl-generic.el: New file. + + * emacs-lisp/cl-macs.el (cl-flet): Allow (FUN EXP) forms. + (cl-load-time-value, cl-labels): Use closures rather than + backquoted lambdas. + (cl-macrolet): Use `eval' to create the function value, and support CL + style arguments in for the defined macros. + +2015-01-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * net/eww.el: Use lexical-binding. + (eww-links-at-point): Remove unused arg. + (eww-mode-map): Inherit from special-mode-map. + (eww-mode): Derive from special-mode. Don't use `setq' on a hook. + +2015-01-13 Alan Mackenzie <acm@muc.de> + + Allow compilation during loading of CC Mode-derived modes (bug#19206). + * progmodes/cc-bytecomp.el (cc-bytecomp-compiling-or-loading): + New function which walks the stack to discover whether we're compiling + or loading. + (cc-bytecomp-is-compiling): Reformulate, and move towards beginning. + (cc-bytecomp-is-loading): New defsubst. + (cc-bytecomp-setup-environment, cc-bytecomp-restore-environment): + Use the above defsubsts. + (cc-require-when-compile, cc-bytecomp-defvar) + (cc-bytecomp-defun): Simplify conditionals. + * progmodes/cc-defs.el (cc-bytecomp-compiling-or-loading): + "Borrow" this function from cc-bytecomp.el. + (c-get-current-file): Reformulate using the above. + (c-lang-defconst): Prevent duplicate entries of file names in a + symbol's 'source property. + (c-lang-const): Use cc-bytecomp-is-compiling. + * progmodes/cc-langs.el (c-make-init-lang-vars-fun): + Use cc-bytecomp-is-compiling. + +2015-01-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eieio-core.el (eieio-defclass): Fix call to `defclass' + (bug#19552). + +2015-01-13 Dmitry Gutov <dgutov@yandex.ru> + + * menu-bar.el (menu-bar-goto-menu): Before calling + `xref-marker-stack-empty-p', first check that `xref' is loaded. + (Bug#19554) + +2015-01-12 Martin Rudalics <rudalics@gmx.at> + + * progmodes/xref.el (xref-marker-stack-empty-p): Add autoload + cookie (Bug#19554). + + * frame.el (frame-notice-user-settings): Remove code dealing with + frame-initial-frame-tool-bar-height. Turn off `tool-bar-mode' + only if `window-system-frame-alist' or `default-frame-alist' ask + for it. + (make-frame): Update frame-adjust-size-history if needed. + +2015-01-12 Paul Eggert <eggert@cs.ucla.edu> + + Have 'make' output better GEN names + * Makefile.in (PHONY_EXTRAS): New macro. + (.PHONY): Depend on it, and on $(lisp)/loaddefs.el, so that the + relevant files' time stamps are ignored. + (custom-deps, $(lisp)/cus-load.el, finder-data) + ($(lisp)/finder-inf.el): Use PHONY_EXTRAS. + (custom-deps, $(lisp)/cus-load.el, finder-data) + ($(lisp)/finder-inf.el, autoloads, $(lisp)/loaddefs.el) + ($(lisp)/subdirs.el, update-subdirs): + Output more-accurate destination names with GEN. + + Say "ELC foo.elc" instead of "GEN foo.elc" + * Makefile.in (AM_V_ELC, am__v_ELC_, am__v_ELC_0, am__v_ELC_1): + New macros. + ($(THEFILE)c, .el.elc): Use them. + +2015-01-11 Michael Albinus <michael.albinus@gmx.de> + + * files.el (directory-files-recursively): Do not include + superfluous remote file names. + +2015-01-11 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww): Interpret anything that looks like a protocol + designator as a full URL. + +2015-01-10 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/shr.el (shr-urlify): Don't bother the user about + invalidly-encoded display strings. + +2015-01-10 Ivan Shmakov <ivan@siamics.net> + + * net/shr.el (shr-urlify): Decode URLs before using them as titles + (bug#19555). + +2015-01-10 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww): Always interpret URLs that start with https?: + as plain URLs, even if they have spaces in them (bug#19556). + (eww): Also interpret things like "en.wikipedia.org/wiki/Free + software" as an URL. + (eww): Don't interpret "org/foo" as an URL. + (eww): Clear the title when loading so that we don't display + misleading information. + +2015-01-10 Daniel Colascione <dancol@dancol.org> + + * vc/vc-hooks.el (vc-prefix-map): Bind vc-delete-file to C-x v x, + by analogy with dired. + +2015-01-09 Daniel Colascione <dancol@dancol.org> + + * progmodes/js.el (js--function-heading-1-re) + (js--function-prologue-beginning): Parse ES6 generator function + declarations. (That is, "function* name()"). + +2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eieio.el (defclass): Move from eieio-defclass all the code + that creates functions, and most of the sanity checks. + Mark as obsolete the <class>-child-p function. + * emacs-lisp/eieio-core.el (eieio--define-field-accessors): Remove. + (eieio--class, eieio--object): Use cl-defstruct. + (eieio--object-num-slots): Define manually. + (eieio-defclass-autoload): Use eieio--class-make. + (eieio-defclass-internal): Rename from eieio-defclass. Move all the + `(lambda...) definitions and most of the sanity checks to `defclass'. + Mark as obsolete the <class>-list-p function, the <class> variable and + the <initarg> variables. Use pcase-dolist. + (eieio-defclass): New compatibility function. + * emacs-lisp/eieio-opt.el (eieio-build-class-alist) + (eieio-class-speedbar): Don't use eieio-default-superclass var. + +2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eieio-generic.el: New file. + * emacs-lisp/eieio-core.el: Move all generic function code to + eieio-generic.el. + (eieio--defmethod): Declare. + + * emacs-lisp/eieio.el: Require eieio-generic. Move all generic + function code to eieio-generic.el. + * emacs-lisp/eieio-opt.el (eieio-help-generic): Move to + eieio-generic.el. + * emacs-lisp/eieio-datadebug.el (eieio-debug-methodinvoke): Update call + to eieio--generic-call. + * emacs-lisp/eieio-base.el (eieio-instance-inheritor): Don't use + <class>-child type. + +2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/chart.el (chart-add-sequence, chart-bar-quickie): + Don't use <class> as a variable. + + * emacs-lisp/eieio.el (same-class-p): Accept class object as well. + (call-next-method): Simplify. + (clone): Obey eieio-backward-compatibility. + + * emacs-lisp/eieio-opt.el (eieio-read-generic-p): Remove. + (eieio-read-generic): Use `generic-p' instead. + + * emacs-lisp/eieio-core.el (eieio-backward-compatibility): New var. + (eieio-defclass-autoload): Obey it. + (eieio--class-object): Improve error behavior. + (eieio-class-children-fast, same-class-fast-p): Remove. Inline at + every use site. + (eieio--defgeneric-form-primary-only): Rename from + eieio-defgeneric-form-primary-only; update all callers. + (eieio--defgeneric-form-primary-only-one): Rename from + eieio-defgeneric-form-primary-only-one; update all callers. + (eieio-defgeneric-reset-generic-form) + (eieio-defgeneric-reset-generic-form-primary-only) + (eieio-defgeneric-reset-generic-form-primary-only-one): Remove. + (eieio--method-optimize-primary): New function to replace them. + (eieio--defmethod, eieio-defmethod): Use it. + (eieio--perform-slot-validation): Rename from + eieio-perform-slot-validation; update all callers. + (eieio--validate-slot-value): Rename from eieio-validate-slot-value. + Change `class' to be a class object. Update all callers. + (eieio--validate-class-slot-value): Rename from + eieio-validate-class-slot-value. Change `class' to be a class object. + Update all callers. + (eieio-oset-default): Accept class object as well. + (eieio--generic-call-primary-only): Rename from + eieio-generic-call-primary-only. Update all callers. + + * emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value): + Improve error messages. + (eieio-persistent-slot-type-is-class-p): Handle `list-of' types, as + well as user-defined types. Emit errors for legacy types like + <class>-child and <class>-list, if not eieio-backward-compatibility. + +2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eieio.el (eieio-class-parents): Accept class objects. + (eieio--class-slot-initarg): Rename from class-slot-initarg. + Change `class' arg to be a class object. Update all callers. + (call-next-method): Adjust to new return value of `eieio-generic-form'. + (eieio-default-superclass): Set var to the class object. + (eieio-edebug-prin1-to-string): Fix recursive call for lists. + Change print behavior to affect class objects rather than + class symbols. + + * emacs-lisp/eieio-core.el (eieio-class-object): New function. + (eieio-class-parents-fast): Remove macro. + (eieio--class-option-assoc): Rename from class-option-assoc. + Update all callers. + (eieio--class-option): Rename from class-option. Change `class' arg to + be a class object. Update all callers. + (eieio--class-method-invocation-order): Rename from + class-method-invocation-order. Change `class' arg to be a class + object. Update all callers. + (eieio-defclass-autoload, eieio-defclass): Set the `parent' field to + a list of class objects rather than names. + (eieio-defclass): Remove redundant quotes. Use `eieio-oref-default' + for accessors to class allocated slots. + (eieio--perform-slot-validation-for-default): Rename from + eieio-perform-slot-validation-for-default. Update all callers. + (eieio--add-new-slot): Rename from eieio-add-new-slot. + Update all callers. Use push. + (eieio-copy-parents-into-subclass): Adjust to new content of + `parent' field. Use dolist. + (eieio-oref): Remove support for providing a class rather than + an object. + (eieio-oref-default): Prefer class objects over class names. + (eieio--slot-originating-class-p): Rename from + eieio-slot-originating-class-p. Update all callers. Use `or'. + (eieio--slot-name-index): Turn check into assertion. + (eieio--class-slot-name-index): Rename from + eieio-class-slot-name-index. Change `class' arg to be a class object. + Update all callers. + (eieio-attribute-to-initarg): Move to eieio-test-persist.el. + (eieio--c3-candidate): Rename from eieio-c3-candidate. + Update all callers. + (eieio--c3-merge-lists): Rename from eieio-c3-merge-lists. + Update all callers. + (eieio--class-precedence-c3): Rename from eieio-class-precedence-c3. + Update all callers. + (eieio--class-precedence-dfs): Rename from eieio-class-precedence-dfs. + Update all callers. + (eieio--class-precedence-bfs): Rename from eieio-class-precedence-bfs. + Update all callers. Adjust to new `parent' content. + (eieio--class-precedence-list): Rename from -class-precedence-list. + Update all callers. + (eieio-generic-call): Use autoloadp and autoload-do-load. + Slight simplification. + (eieio-generic-call, eieio-generic-call-primary-only): Adjust to new + return value of `eieio-generic-form'. + (eieiomt-add): Index the hashtable with class objects rather than + class names. + (eieio-generic-form): Accept class objects as well. + + * emacs-lisp/eieio-base.el (eieio-persistent-convert-list-to-object): + Adjust to new convention for eieio-persistent-validate/fix-slot-value. + (eieio-persistent-validate/fix-slot-value): + Change `class' arg to be a class object. Update all callers. + +2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eieio.el (child-of-class-p): Make it accept class objects + additionally to class names. + + * emacs-lisp/eieio-core.el (eieio--with-scoped-class): Use let-binding. + (object): Remove first (constant) slot; rename second to `class-tag'. + (eieio--object-class-object, eieio--object-class-name): New funs + to replace eieio--object-class. + (eieio--class-object, eieio--class-p): New functions. + (same-class-fast-p): Make it a defsubst, change its implementation + to check the class objects rather than their names. + (eieio-object-p): Rewrite. + (eieio-defclass): Adjust the object initialization according to the new + object layout. + (eieio--scoped-class): Declare it returns a class object (not a class + name any more). Adjust calls accordingly (along with calls to + eieio--with-scoped-class). + (eieio--slot-name-index): Rename from eieio-slot-name-index and change + its class arg to be a class object. Adjust callers accordingly. + (eieio-slot-originating-class-p): Make its start-class arg a class + object. Adjust all callers. + (eieio--initarg-to-attribute): Rename from eieio-initarg-to-attribute. + Make its `class' arg a class object. Adjust all callers. + + * emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value): + Use eieio--slot-name-index rather than eieio-slot-name-index. + +2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eieio.el (make-instance): Simplify by not adding an object + name argument. + (eieio-object-name): Use eieio-object-name-string. + (eieio--object-names): New const. + (eieio-object-name-string, eieio-object-set-name-string): Re-implement + using a hashtable rather than a built-in slot. + (eieio-constructor): Rename from `constructor'. Remove `newname' arg. + (clone): Don't mess with the object's "name". + + * emacs-lisp/eieio-custom.el (eieio-widget-test): Remove dummy arg. + (eieio-object-value-get): Use eieio-object-set-name-string. + + * emacs-lisp/eieio-core.el (eieio--defalias): Follow aliases. + (eieio--object): Remove `name' field. + (eieio-defclass): Adjust to new convention where constructors don't + take an "object name" any more. + (eieio--defgeneric-init-form, eieio--defmethod): Follow aliases. + (eieio-validate-slot-value, eieio-oset-default) + (eieio-slot-name-index): Don't hardcode eieio--object-num-slots. + (eieio-generic-call-primary-only): Simplify. + + * emacs-lisp/eieio-base.el (clone) <eieio-instance-inheritor>: + Use call-next-method. + (eieio-constructor): Rename from `constructor'. + (eieio-persistent-convert-list-to-object): Drop objname. + (eieio-persistent-validate/fix-slot-value): Don't hardcode + eieio--object-num-slots. + (eieio-named): Use a normal slot. + (slot-missing) <eieio-named>: Remove. + (eieio-object-name-string, eieio-object-set-name-string, clone) + <eieio-named>: New methods. + +2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eieio-core.el (eieio--class-v): Rename from class-v. + (method-*): Add a "eieio--" prefix to those constants. + + * emacs-lisp/eieio.el: Move edebug specs to the corresponding macro. + + * emacs-lisp/eieio-speedbar.el: Use lexical-binding. + +2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eieio.el (child-of-class-p): Fix case where `class' is + `eieio-default-superclass'. + + * emacs-lisp/eieio-datadebug.el: Use lexical-binding. + + * emacs-lisp/eieio-custom.el: Use lexical-binding. + (eieio-object-value-to-abstract): Simplify. + + * emacs-lisp/eieio-opt.el (eieio-build-class-list): Use cl-mapcan. + (eieio-build-class-alist): Use dolist. + (eieio-all-generic-functions): Adjust to use of hashtables. + + * emacs-lisp/eieio-core.el (class): Rename field symbol-obarray to + symbol-hashtable. It contains a hashtable instead of an obarray. + (generic-p): Use symbol property `eieio-method-hashtable' instead of + `eieio-method-obarray'. + (generic-primary-only-p, generic-primary-only-one-p): + Slight optimization. + (eieio-defclass-autoload-map): Use a hashtable instead of an obarray. + (eieio-defclass-autoload, eieio-defclass): Adjust/simplify accordingly. + (eieio-class-un-autoload): Use autoload-do-load. + (eieio-defclass): Use dolist, cl-pushnew, cl-callf. + Use new cl-deftype-satisfies. Adjust to use of hashtables. + Don't hardcode the value of eieio--object-num-slots. + (eieio-defgeneric-form-primary-only-one): Remove `doc-string' arg. + Use a closure rather than a backquoted lambda. + (eieio--defmethod): Adjust call accordingly. Set doc-string via the + function-documentation property. + (eieio-slot-originating-class-p, eieio-slot-name-index) + (eieiomt--optimizing-hashtable, eieiomt-install, eieiomt-add) + (eieio-generic-form): Adjust to use of hashtables. + (eieiomt--sym-optimize): Rename from eieiomt-sym-optimize; take + additional class argument. + (eieio-generic-call-methodname): Remove, unused. + + * emacs-lisp/eieio-base.el (eieio-persistent-slot-type-is-class-p): + Prefer \' to $. + +2015-01-08 Eli Zaretskii <eliz@gnu.org> + + * simple.el (line-move-visual): When converting X pixel coordinate + to temporary-goal-column, adjust the value for right-to-left + screen lines. This fixes vertical-motion, next/prev-line, etc. + +2015-01-08 Glenn Morris <rgm@gnu.org> + + * files.el (file-tree-walk): Remove; of unknown authorship. (Bug#19325) + +2015-01-07 K. Handa <handa@gnu.org> + + * international/ccl.el (define-ccl-program): Improve the docstring. + +2015-01-06 Sam Steingold <sds@gnu.org> + + * shell.el (shell-display-buffer-actions): Remove, + use `display-buffer-alist' instead. + +2015-01-05 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/xref.el (xref--insert-xrefs): Add `help-echo' property + to the references. + +2015-01-05 Stefan Monnier <monnier@iro.umontreal.ca> + + * minibuffer.el (completion-category-defaults): New var. + Set unicode-name to use substring completion. + (completion-category-defaults): Set it to nil. + +2015-01-04 Dmitry Gutov <dgutov@yandex.ru> + + Add mouse interaction to xref. + * progmodes/xref.el (xref--button-map): New variable. + (xref--mouse-2): New command. + (xref--insert-xrefs): Add `mouse-face' and `keymap' properties to + the inserted references. + +2015-01-04 Paul Eggert <eggert@cs.ucla.edu> + + Less 'make' chatter for lisp dir + * Makefile.in (THEFILE): Define to be 'no-such-file' by default, + to make it clearer that the caller must specify it. + (compile-onefile): Remove, replacing by ... + ($(THEFILE)c): ... new rule. This lets us use AM_V_GEN here. + ($(THEFILE)c, .el.elc, $(MH_E_DIR)/mh-loaddefs.el) + ($(TRAMP_DIR)/tramp-loaddefs.el, $(CAL_DIR)/cal-loaddefs.el) + ($(CAL_DIR)/diary-loaddefs.el, $(CAL_DIR)/hol-loaddefs.el): + Use AM_V_GEN to lessen 'make' chatter. + (.el.elc): Omit duplicate comment. + + Less 'make' chatter in batch mode + * emacs-lisp/autoload.el (autoload-generate-file-autoloads): + * emacs-lisp/bytecomp.el (byte-compile-file): + * files.el (save-buffer, basic-save-buffer): + * international/quail.el (quail-update-leim-list-file): + Don't output messages like "Generating ..." in batch mode. + 2015-01-04 Dmitry Gutov <dgutov@yandex.ru> Unbreak `mouse-action' property in text buttons. * button.el (push-button): Fix regression from 2012-12-06. +2015-01-03 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/xref.el (xref-marker-stack-empty-p): New function. + + * menu-bar.el (menu-bar-goto-menu): Use it. + +2015-01-03 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/xref.el (xref--window-configuration): New variable. + (xref-show-location-at-point): New command. + (xref--restore-window-configuration): New function. + (xref-next-line, xref-prev-line): Delegate to + `xref-show-location-at-point'. + (xref--location-at-point): Don't signal the error. + (xref-goto-xref): Do that here instead. + (xref--xref-buffer-mode): Add `xref--restore-window-configuration' + to `pre-command-hook'. + (xref--xref-buffer-mode-map): Don't remap `next-line' and + `previous-line'. Additionally bind `xref-next-line' and + `xref-prev-line' to `n' and `p' respectively. + Bind `xref-show-location-at-point' to `C-o'. + 2015-01-01 Eli Zaretskii <eliz@gnu.org> * tool-bar.el (tool-bar-local-item) (tool-bar-local-item-from-menu): Call force-mode-line-update to make sure the tool-bar changes show on display. -2014-12-29 Michael Albinus <michael.albinus@gmx.de> +2015-01-01 Michael Albinus <michael.albinus@gmx.de> Sync with Tramp 2.2.11. @@ -98,11 +1173,107 @@ * net/trampver.el: Update release number. -2014-12-29 Filipp Gunbin <fgunbin@fastmail.fm> +2015-01-01 Filipp Gunbin <fgunbin@fastmail.fm> * autorevert.el (auto-revert-handler): Fix auto-revert-tail-mode for remote files. (Bug#19449) +2015-01-01 Simen Heggestøyl <simenheg@gmail.com> (tiny change) + + * textmodes/css-mode.el (scss-mode): Fix typo (bug#19446). + +2014-12-31 Paul Eggert <eggert@cs.ucla.edu> + + Less 'make' chatter in lisp directory + * Makefile.in (AM_DEFAULT_VERBOSITY, AM_V_GEN, am__v_GEN_) + (am__v_GEN_0, am__v_GEN_1): New macros, from ../src/Makefile.in. + (custom-deps, finder-data, autoloads, update-subdirs): Use them. + +2014-12-31 Filipp Gunbin <fgunbin@fastmail.fm> + + * info.el (info-display-manual): Limit the completion alternatives + to currently visited manuals if prefix argument is non-nil. + +2014-12-30 Paul Eggert <eggert@cs.ucla.edu> + + * Makefile.in (semantic): Simplify. + +2014-12-30 Juri Linkov <juri@linkov.net> + + * net/eww.el (eww-isearch-next-buffer): New function. + (eww-mode): Set multi-isearch-next-buffer-function to it. + +2014-12-30 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/xref.el (xref-find-definitions): Mention "no + identifier at point" case in the docstring. + + * menu-bar.el (menu-bar-goto-uses-etags-p): New function. + (menu-bar-goto-menu): Use it to show or hide the `set-tags-name' + and `separator-tag-file' items. + +2014-12-29 Paul Eggert <eggert@cs.ucla.edu> + + * obsolete/pc-select.el (pc-selection-mode): Use system-type. + This is instead of system-name, which is both wrong here and obsolete. + * desktop.el (desktop-save-frameset): + * dnd.el (dnd-get-local-file-uri): + * nxml/rng-uri.el (rng-uri-file-name-1): + Prefer (system-name) to system-name, and avoid naming + locals 'system-name'. + * startup.el (system-name): Now an obsolete variable. (Bug#19438) + +2014-12-29 Dmitry Gutov <dgutov@yandex.ru> + + * menu-bar.el (menu-bar-next-tag-other-window) + (menu-bar-next-tag): Remove. + +2014-12-29 K. Handa <handa@gnu.org> + + * international/mule.el (make-translation-table-from-alist): + Accept nil or zero-length vector for FROM and TO. + +2014-12-29 Lars Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww-mode): Truncate overlong lines for prettier + display when resizing. + + * net/shr.el (shr-width): Default to using the window width when + rendering. + +2014-12-29 Dmitry Gutov <dgutov@yandex.ru> + + Unbreak jumping to an alias's definition. + * emacs-lisp/find-func.el (find-function-library): Return a pair + (ORIG-FUNCTION . LIBRARY) instead of just its second element. + (find-function-noselect): Use it. + * progmodes/elisp-mode.el (elisp--xref-identifier-file): Rename to + `elisp--xref-identifier-location', incorporate logic from + `elisp--xref-find-definitions', use the changed + `find-function-library' return value. + +2014-12-29 Juri Linkov <juri@linkov.net> + + * comint.el (comint-history-isearch-message): Use field-beginning + instead of comint-line-beginning-position - that's more fixes for + http://lists.gnu.org/archive/html/emacs-devel/2014-12/msg00305.html + (comint-history-isearch-message): Fix args of isearch-message-prefix. + +2014-12-29 Juri Linkov <juri@linkov.net> + + * vc/vc-dir.el (vc-dir-display-file): New command (bug#19450). + (vc-dir-mode-map): Bind it to "\C-o". + (vc-dir-menu-map): Add it to menu. + +2014-12-29 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/etags.el (find-tag-other-window) + (find-tag-other-frame, find-tag-regexp, tags-loop-continue) + (tags-apropos): Declare obsolete. + + * menu-bar.el (menu-bar-goto-menu): Replace all but one etags item + with xref ones. + 2014-12-28 Eli Zaretskii <eliz@gnu.org> * international/mule.el (define-coding-system): Fix typos in the @@ -113,37 +1284,93 @@ * international/mule.el (define-coding-system): Improve the doc string. +2014-12-28 Ivan Shmakov <ivan@siamics.net> + + * net/shr.el (shr-tag-table): Fix handling of tbody/header/footer + elements in tables (bug#19444). + + * net/eww.el (eww-handle-link): Fix typo in "up" rel handling + (bug#19445). + +2014-12-28 Juri Linkov <juri@linkov.net> + + * vc/compare-w.el: Require diff-mode for diff faces. + (compare-windows-removed, compare-windows-added): New faces + inheriting from diff faces. + (compare-windows): Define obsolete face alias. + (compare-windows-highlight): Replace face `compare-windows' with + new faces `compare-windows-added' and `compare-windows-removed' + (bug#19451). + (compare-windows-get-recent-window): Signal an error when + no other window is found (bug#19170). + +2014-12-27 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/elisp-mode.el (elisp--xref-identifier-file): + Skip features that have no sources. + + * simple.el (execute-extended-command): + When `suggest-key-bindings' is nil, don't. + +2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> + + python.el: Native readline completion. + * progmodes/python.el (python-shell-completion-native-disabled-interpreters) + (python-shell-completion-native-enable) + (python-shell-completion-native-output-timeout): New defcustoms. + (python-shell-completion-native-interpreter-disabled-p) + (python-shell-completion-native-try) + (python-shell-completion-native-setup) + (python-shell-completion-native-turn-off) + (python-shell-completion-native-turn-on) + (python-shell-completion-native-turn-on-maybe) + (python-shell-completion-native-turn-on-maybe-with-msg) + (python-shell-completion-native-toggle): New functions. + (python-shell-completion-native-get-completions): New function. + (python-shell-completion-at-point): Use it. + 2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> - * progmodes/python.el (python-shell-buffer-substring): Handle - cornercase when region sent starts at point-min. + python.el: Enhance shell user interaction and deprecate + python-shell-get-or-create-process. + * progmodes/python.el (python-shell-get-process-or-error): + New function. + (python-shell-with-shell-buffer): Use it. + (python-shell-send-string, python-shell-send-region) + (python-shell-send-buffer, python-shell-send-defun) + (python-shell-send-file, python-shell-switch-to-shell): Use it. + Add argument MSG to display user-friendly message when no process + is running. + (python-shell-switch-to-shell): Call pop-to-buffer with NORECORD. + (python-shell-make-comint): Rename argument SHOW from POP. + Use display-buffer instead of pop-to-buffer. + (run-python): Doc fix. Return process. + (python-shell-get-or-create-process): Make obsolete. + +2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * progmodes/python.el (python-shell-buffer-substring): + Handle cornercase when region sent starts at point-min. 2014-12-27 Eli Zaretskii <eliz@gnu.org> * language/misc-lang.el (composition-function-table): Add Syriac - characters and also ZWJ/ZWNJ. See - http://lists.gnu.org/archive/html/help-gnu-emacs/2014-12/msg00248.html + characters and also ZWJ/ZWNJ. + See http://lists.gnu.org/archive/html/help-gnu-emacs/2014-12/msg00248.html for the details. 2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> python.el: Fix message when sending region. - * progmodes/python.el (python-shell-send-region): Rename argument send-main from nomain. Fix message. (python-shell-send-buffer): Rename argument send-main from arg. -2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> - python.el: Cleanup temp files even with eval errors. - * progmodes/python.el (python-shell-send-file): Make file-name mandatory. Fix temp file removal in the majority of cases. -2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> - python.el: Handle file encoding for shell. - * progmodes/python.el (python-rx-constituents): Add coding-cookie. (python-shell--save-temp-file): Write file with proper encoding. (python-shell-buffer-substring): Add coding cookie for detected @@ -153,29 +1380,29 @@ (python-info-encoding-from-cookie) (python-info-encoding): New functions. -2014-12-24 Michael Albinus <michael.albinus@gmx.de> +2014-12-27 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): Use `tramp-rsh-end-of-line', it ought to be more robust. -2014-12-23 Stefan Monnier <monnier@iro.umontreal.ca> +2014-12-27 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/js.el (js-syntax-propertize): "return" can't be divided (bug#19397). -2014-12-23 Michael Albinus <michael.albinus@gmx.de> +2014-12-27 Michael Albinus <michael.albinus@gmx.de> * net/tramp.el (tramp-read-passwd): Ignore errors from `auth-source-*'. * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): Use "\n" as end-of-line delimeter for passwords, when running on MS Windows. -2014-12-23 Stefan Monnier <monnier@iro.umontreal.ca> +2014-12-27 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/sh-script.el (sh-set-shell): Don't change the global value of indent-line-function (bug#19433). -2014-12-23 Fabián Ezequiel Gallina <fgallina@gnu.org> +2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> Fix line numbers on Python shell. * progmodes/python.el (python-shell--save-temp-file): Do not @@ -186,28 +1413,28 @@ (python-shell-buffer-substring): Cleanup fake-loc logic. (python-shell-send-region): Remove fake-loc logic, simplify. -2014-12-22 Fabián Ezequiel Gallina <fgallina@gnu.org> +2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> * progmodes/python.el (python-indent-post-self-insert-function): Make colon to re-indent only for dedenters, handling multiline-statements gracefully. -2014-12-21 Michael Albinus <michael.albinus@gmx.de> +2014-12-27 Michael Albinus <michael.albinus@gmx.de> * net/tramp.el (tramp-handle-insert-file-contents): Set `find-file-not-found-functions' in case of errors. (Bug#18623) -2014-12-19 Michael Albinus <michael.albinus@gmx.de> +2014-12-27 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-send-command-and-read): New optional arg MARKER. (tramp-get-remote-path): Use it. -2014-12-18 Stefan Monnier <monnier@iro.umontreal.ca> +2014-12-27 Stefan Monnier <monnier@iro.umontreal.ca> * subr.el (redisplay-dont-pause): Mark as obsolete. -2014-12-17 Michael Albinus <michael.albinus@gmx.de> +2014-12-27 Michael Albinus <michael.albinus@gmx.de> * net/tramp.el (tramp-error-with-buffer): Call `message' properly. (tramp-accept-process-output): Use nil as argument for @@ -222,42 +1449,724 @@ wrong debug buffer. (tramp-maybe-open-connection): Set connection property "gateway". -2014-12-15 Stefan Monnier <monnier@iro.umontreal.ca> +2014-12-27 Stefan Monnier <monnier@iro.umontreal.ca> * subr.el (sit-for): Tweak docstring (bug#19381). -2014-12-15 Dmitry Gutov <dgutov@yandex.ru> +2014-12-27 Dmitry Gutov <dgutov@yandex.ru> * vc/vc-git.el (vc-git-after-dir-status-stage): Move `up-to-date' stage to after `diff-index' (bug#19386). -2014-12-14 João Távora <joaotavora@gmail.com> +2014-12-27 João Távora <joaotavora@gmail.com> * textmodes/tex-mode.el (tex-insert-quote): Consider and respect `electric-pair-mode' (bug#19356). -2014-12-12 Michael Albinus <michael.albinus@gmx.de> +2014-12-27 Dmitry Gutov <dgutov@yandex.ru> + + elisp-xref-find: Don't create buffers eagerly. + + * progmodes/elisp-mode.el (elisp--identifier-location): Fold back + into `elisp--company-location'. + (elisp--identifier-completion-table): Rename to + `elisp--identifier-completion-table', and do not include just any + symbols with a property list. + (elisp-completion-at-point): Revert the 2014-12-25 change. + (elisp--xref-identifier-file): New function. + (elisp--xref-find-definitions): Use it. + + * emacs-lisp/find-func.el (find-function-library): New function, + extracted from `find-function-noselect'. + + * progmodes/xref.el (xref-elisp-location): New class. + (xref-make-elisp-location): New function. + (xref-location-marker): New implementation. + +2014-12-27 Juri Linkov <juri@linkov.net> + + * minibuffer.el (minibuffer-completion-help): + Use shrink-window-if-larger-than-buffer in window-height + when temp-buffer-resize-mode is nil. + + * window.el (with-displayed-buffer-window): Remove window-height + from the action alist in the temp-buffer-window-show call + when window-height is handled explicitly afterwards (bug#19355). + +2014-12-27 Juri Linkov <juri@linkov.net> + + Support subdirectories when saving places in dired. + * saveplace.el (toggle-save-place, save-place-to-alist) + (save-places-to-alist, save-place-dired-hook): + Use dired-current-directory instead of dired-directory (bug#19436). + (save-place-dired-hook): Add check for alist to make the new + format future-proof to allow other possible formats. + +2014-12-26 Fabián Ezequiel Gallina <fgallina@gnu.org> + + python.el: Generate clearer shell buffer names. + * progmodes/python.el (python-shell-get-process-name) + (python-shell-internal-get-process-name): Use `buffer-name`. + (python-shell-internal-get-or-create-process): Simplify. + +2014-12-26 Dmitry Gutov <dgutov@yandex.ru> + + Add basic xref apropos implementation to elisp-mode. + + * progmodes/elisp-mode.el (elisp--xref-find-definitions): + Filter out nil results. + (elisp--xref-find-apropos): New function. + (elisp-xref-find): Use it. + + * progmodes/xref.el (xref--show-xrefs): Use `user-error'. + +2014-12-25 Filipp Gunbin <fgunbin@fastmail.fm> + + * dired-aux.el (dired-maybe-insert-subdir): + Make dired-maybe-insert-subdir always skip trivial files. + +2014-12-25 Helmut Eller <eller.helmut@gmail.com> + Dmitry Gutov <dgutov@yandex.ru> + + Consolidate cross-referencing commands. + + Move autoloaded bindings for `M-.', `M-,', `C-x 4 .' and + `C-x 5 .' from etags.el to xref.el. + + * progmodes/xref.el: New file. + + * progmodes/elisp-mode.el (elisp--identifier-types): New variable. + (elisp--identifier-location): New function, extracted from + `elisp--company-location'. + (elisp--company-location): Use it. + (elisp--identifier-completion-table): New variable. + (elisp-completion-at-point): Use it. + (emacs-lisp-mode): Set the local values of `xref-find-function' + and `xref-identifier-completion-table-function'. + (elisp-xref-find, elisp--xref-find-definitions) + (elisp--xref-identifier-completion-table): New functions. + + * progmodes/etags.el (find-tag-marker-ring): Mark obsolete in + favor of `xref--marker-ring'. + (tags-lazy-completion-table): Autoload. + (tags-reset-tags-tables): Use `xref-clear-marker-stack'. + (find-tag-noselect): Use `xref-push-marker-stack'. + (pop-tag-mark): Make an alias for `xref-pop-marker-stack'. + (etags--xref-limit): New constant. + (etags-xref-find, etags--xref-find-definitions): New functions. + +2014-12-25 Martin Rudalics <rudalics@gmx.at> + + * cus-start.el (resize-mini-windows): Make it customizable. + +2014-12-24 Stephen Leake <stephen_leake@stephe-leake.org> + + * startup.el (fancy-about-text): Change buttons for etc/CONTRIBUTE + to (info "(emacs)Contributing"). (Bug#19299) + +2014-12-24 Martin Rudalics <rudalics@gmx.at> + + * window.el (mouse-autoselect-window-position-1): New variable. + (mouse-autoselect-window-cancel) + (mouse-autoselect-window-select, handle-select-window): + With delayed autoselection select window only if mouse moves after + selecting its frame. + +2014-12-24 Michael Albinus <michael.albinus@gmx.de> + + * eshell/esh-ext.el (eshell-find-interpreter): Expand relative + remote file names. (Bug#18782) + +2014-12-23 Sam Steingold <sds@gnu.org> + + * shell.el (shell-display-buffer-actions): New user option. + (shell): Pass it to `pop-to-buffer' instead of hard-coding + `pop-to-buffer-same-window'. + +2014-12-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/js.el (js--syntax-propertize-regexp-syntax-table): New var. + (js-syntax-propertize-regexp): Use it to recognize "slash in + a character class" (bug#19397). + +2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * completion.el: Use post-self-insert-hook (bug#19400). + (completion-separator-self-insert-command) + (completion-separator-self-insert-autofilling): Remove. + (completion-separator-chars): New var. + (completion-c-mode-hook, completion-setup-fortran-mode): Use it instead + of changing the keymap. + (completion--post-self-insert): New function. + (dynamic-completion-mode): Use it instead of rebinding keys. + (cmpl--completion-string): Rename from completion-string. + (add-completion-to-head, delete-completion): Let-bind it explicitly. + +2014-12-22 Bozhidar Batsov <bozhidar@batsov.com> + + * progmodes/ruby-mode.el (ruby--string-region): Simplify code + by leveraging `syntax-ppss'. + +2014-12-22 Artur Malabarba <bruce.connor.am@gmail.com> + + * let-alist.el (let-alist): Use `make-symbol' instead of `gensym'. + +2014-12-20 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-sh.el (tramp-histfile-override): Add :version. + +2014-12-20 Teodor Zlatanov <tzz@lifelogs.com> + + * net/tramp-sh.el (tramp-histfile-override): Clarify docstring. + +2014-12-19 Artur Malabarba <bruce.connor.am@gmail.com> + + * let-alist.el (let-alist): Enable access to deeper alists by + using dots inside the dotted symbols. + +2014-12-19 Alan Mackenzie <acm@muc.de> + + Make C++11 uniform init syntax work. + New keywords "final" and "override". + * progmodes/cc-engine.el (c-back-over-member-initializer-braces): + New function. + (c-guess-basic-syntax): Set `containing-sex' and `lim' using the + new function. + * progmodes/cc-fonts.el (c-font-lock-declarations): Check more + carefully for "are we at a declarator?" using + c-back-over-member-initializers. + * progmodes/cc-langs.el (c-type-modifier-kwds): Include "final" + and "override" in the C++ value. + +2014-12-19 Martin Rudalics <rudalics@gmx.at> + + * textmodes/ispell.el (ispell-command-loop): Don't use `next-window'. + +2014-12-21 Lars Ingebrigtsen <larsi@gnus.org> + + * net/nsm.el (nsm-save-host): Don't save the host name twice + (bug#19269). + +2014-12-18 Sam Steingold <sds@gnu.org> + + Keyboard interface (C-f10) to `mouse-buffer-menu' (C-down-mouse-1). + * mouse.el (mouse-buffer-menu-map): Extract from `mouse-buffer-menu'. + (mouse-buffer-menu): Use `mouse-buffer-menu-map'. + * menu-bar.el (menu-bar-buffer-vector): Extract from + `menu-bar-update-buffers'. + (menu-bar-update-buffers): Use `menu-bar-buffer-vector'. + (buffer-menu-open): New user command, bound globally to C-f10, + provides a keyboard interface to `mouse-buffer-menu' (C-down-mouse-1). + (mouse-buffer-menu-keymap): Use `menu-bar-buffer-vector' to + convert the value returned by `mouse-buffer-menu-map' to a list + acceptable to `popup-menu' for `buffer-menu-open'. + +2014-12-18 Artur Malabarba <bruce.connor.am@gmail.com> + + * let-alist.el (let-alist): Evaluate the `alist' argument only once. + +2014-12-18 Sam Steingold <sds@gnu.org> + + * emacs-lisp/package.el: Avoid compilation warning by declaring + the `find-library-name' function. + (package-activate-1): Fix the `with-demoted-errors' calls: + the first argument must be a string literal. + +2014-12-18 Martin Rudalics <rudalics@gmx.at> + + Add code for "preserving" window sizes. + * dired.el (dired-pop-to-buffer): Call fit-window-to-buffer with + `preserve-size' t. + (dired-mark-pop-up): Preserve size of window showing marked files. + * electric.el (Electric-pop-up-window): + * help.el (resize-temp-buffer-window): Call fit-window-to-buffer + with `preserve-size' t. + * minibuffer.el (minibuffer-completion-help): + Use `resize-temp-buffer-window' instead of `fit-window-to-buffer' + (Bug#19355). Preserve size of completions window. + * register.el (register-preview): Preserve size of register + preview window. + * tmm.el (tmm-add-prompt): Call fit-window-to-buffer + with `preserve-size' t (Bug#1291). + * window.el (with-displayed-buffer-window): Add calls to + `window-preserve-size'. + (window-min-pixel-size, window--preservable-size) + (window-preserve-size, window-preserved-size) + (window--preserve-size, window--min-size-ignore-p): New functions. + (window-min-size, window-min-delta, window--resizable) + (window--resize-this-window, split-window-below) + (split-window-right): Amend doc-string. + (window--min-size-1, window-sizable, window--size-fixed-1) + (window-size-fixed-p, window--min-delta-1) + (frame-windows-min-size, window--max-delta-1, window-resize) + (window--resize-child-windows, window--resize-siblings) + (enlarge-window, shrink-window, split-window): Handle preserving + window sizes. + (adjust-window-trailing-edge): Handle preserving window + sizes. Signal user-error instead of an error when there's no + window above or below. + (window--state-put-2): Handle horizontal scroll bars. + (window--display-buffer): Call `preserve-size' if asked for. + (display-buffer): Mention `preserve-size' alist member in doc-string. + (fit-window-to-buffer): New argument PRESERVE-SIZE. + * textmodes/ispell.el (ispell-command-loop): Suppress horizontal + scroll bar on ispell's windows. Don't count window lines and + don't deal with dedicated windows. + (ispell-show-choices, ispell-help): Let `ispell-display-buffer' + do the window handling. + (ispell-adjusted-window-height, ispell-overlay-window): Remove. + (ispell-display-buffer): New function to reuse, create and fit + window to ispell's buffers. (Bug#3413) + +2014-12-18 Dmitry Gutov <dgutov@yandex.ru> + + * emacs-lisp/package.el (package-activate): Do not re-activate or + reload the dependencies (bug#19390). + +2014-12-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/cc-cmds.el (c-subword-mode): Alias to subword-mode. + (c-update-modeline): + * progmodes/cc-langs.el (c-mode-menu): Use c-subword-mode. + * progmodes/cc-mode.el (subword-mode): Move autoload to cc-cmds.el. + (c-mode-base-map): Use c-subword-mode. + +2014-12-18 Eli Zaretskii <eliz@gnu.org> + + * international/mule-diag.el (describe-font-internal): + Display additional info returned by font-info. + + * linum.el (linum--face-width): Rename from linum--face-height, + and use the new functionality of font-info. + (linum-update-window): Use linum--face-width and frame-char-width, + instead of approximating with height. + +2014-12-18 Dmitry Gutov <dgutov@yandex.ru> + + * vc/vc-svn.el (vc-svn-dir-status-files): Revert the 2014-12-02 + change (bug#19387). Use `apply' on `vc-dir-command' (bug#19405). + + * emacs-lisp/package.el (package-activate-1): Add RELOAD argument + and a docstring. + (package-activate): Call itself on dependencies on PACKAGE with + the same FORCE argument. Pass FORCE as RELOAD into + `package-activate-1' (bug#19390). + +2014-12-17 Sam Steingold <sds@gnu.org> + + * emacs-lisp/package.el (package--list-loaded-files): + Handle `(nil ...)' elements in `load-history'. + +2014-12-17 Teodor Zlatanov <tzz@lifelogs.com> + + * net/tramp-sh.el (tramp-histfile-override): New variable. + (tramp-open-shell, tramp-maybe-open-connection): Use it. + +2014-12-17 Dmitry Gutov <dgutov@yandex.ru> + + * vc/vc.el: Improve `dir-status-files' description. + + * emacs-lisp/package.el (package--list-loaded-files): Don't call + file-truename on load-history elements (bug#19390). + +2014-12-16 Nicolas Petton <petton.nicolas@gmail.com> + + * emacs-lisp/seq.el: New file. + +2014-12-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * jit-lock.el (jit-lock-function): Don't defer if jit-lock-defer-time + is 0 and there is no input pending. + +2014-12-15 Juri Linkov <juri@linkov.net> + + * replace.el (query-replace-read-from): Use query-replace-compile-replacement + only on the return value (bug#19383). + +2014-12-15 Juri Linkov <juri@linkov.net> + + * isearch.el (isearch-lazy-highlight-search): Extend the bound of + the wrapped search by the length of the search string to be able + to lazy-highlight the whole search string at point (bug#19353). + +2014-12-15 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/shr.el (shr-fold-text): Don't bug out on zero-length text. + +2014-12-14 Alan Mackenzie <acm@muc.de> + + * cus-start.el (all): Add fast-but-imprecise-scrolling. + +2014-12-14 Artur Malabarba <bruce.connor.am@gmail.com> + + * let-alist.el: Add lexical binding. + +2014-12-14 Steve Purcell <steve@sanityinc.com> (tiny change) + + * emacs-lisp/package.el (package-menu-mode): Use an extra column + for the "Version" column, to accomodate date-and-time-based versions. + +2014-12-14 Cameron Desautels <camdez@gmail.com> + + * cus-edit.el (custom-unsaved-options): New function, extracted + from `customize-unsaved'. + (custom-unsaved): Use it. + (custom-prompt-customize-unsaved-options): New function. + (Bug#19328) + +2014-12-14 Dmitry Gutov <dgutov@yandex.ru> + + * fringe.el (fringe-bitmap-p): Fix 2014-12-05 breakage. + +2014-12-14 Dmitry Gutov <dgutov@yandex.ru> + + Move ASYNC argument to the `diff' VC command to the fifth + position, for better compatibility with existing third-party code, + and document it. + + * vc/vc.el (vc-diff-internal): Pass `async' argument to the + backend `diff' command in the last position. + + * vc/vc-svn.el (vc-svn-diff): + * vc/vc-src.el (vc-src-diff): + * vc/vc-sccs.el (vc-sccs-diff): + * vc/vc-rcs.el (vc-rcs-diff): + * vc/vc-mtn.el (vc-mtn-diff): + * vc/vc-hg.el (vc-hg-diff): + * vc/vc-git.el (vc-git-diff): + * vc/vc-dav.el (vc-dav-diff): + * vc/vc-cvs.el (vc-cvs-diff): + * vc/vc-bzr.el (vc-bzr-diff): + * obsolete/vc-arch.el (vc-arch-diff): Move ASYNC argument to the end. + +2014-12-14 Paul Eggert <eggert@cs.ucla.edu> + + * emacs-lisp/cconv.el (cconv--analyze-use): + Rename from cconv--analyse-use. + (cconv--analyze-function): Rename from cconv--analyse-function. + (cconv-analyze-form): Rename from cconv-analyse-form. + +2014-12-13 Andreas Schwab <schwab@linux-m68k.org> + + * net/shr.el (shr-next-link): Don't error out at eob. + +2014-12-05 Nicolas Richard <theonewiththeevillook@yahoo.fr> + + * isearch.el (isearch-open-necessary-overlays): Open overlay + ending at point (bug#19333). + +2014-12-13 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/shr.el (shr-fold-text): New function. + (shr-show-alt-text, shr-urlify, shr-tag-img): Use it to fold long + alt/title texts. + (shr-fold-text): Inhibit state from being altered. + + * files.el (directory-files-recursively): Really check whether + files are symlinks. + (directory-name-p): New function. + (directory-files-recursively): Use it. + +2014-12-13 Artur Malabarba <bruce.connor.am@gmail.com> + + * emacs-lisp/package.el (package--list-loaded-files): New function + to list files in a given directory which correspond to already + loaded files. + (package-activate-1): Reload files given by `package--list-loaded-files'. + Fix bug#10125, bug#18443, and bug#18448. + +2014-12-13 Eric S. Raymond <esr@snark.thyrsus.com> + + * vc/vc-svn.el (vc-svn-diff): Fix bug #19312. + +2014-12-13 Michael Albinus <michael.albinus@gmx.de> * simple.el (password-word-equivalents): Add "passcode", used for numeric secrets like PINs or RSA tokens. -2014-12-10 Michael Albinus <michael.albinus@gmx.de> +2014-12-13 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-get-remote-path): Use a login shell in order to determine `tramp-own-remote-path'. -2014-12-09 Fabián Ezequiel Gallina <fgallina@gnu.org> +2014-12-13 Fabián Ezequiel Gallina <fgallina@gnu.org> * progmodes/python.el (python-shell-parse-command): Quote `python-shell-interpreter`. (Bug#19289) -2014-12-04 Stefan Monnier <monnier@iro.umontreal.ca> +2014-12-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/python.el (python-indent-line): Use `noindent' in strings. + (python-indent-levels): Document extra value. + (python-indent-calculate-indentation): Return `noindent' in strings. + (python-indent-post-self-insert-function) + (python-indent-calculate-levels): Handle new value. + +2014-12-12 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/network-stream.el (network-stream-open-starttls): No need to + check for the availability of `gnutls-available-p'. + + * files.el (directory-files-recursively): Don't follow symlinks to + other directories. + +2014-12-12 Eric S. Raymond <esr@snark.thyrsus.com> + + * vc/vc-dav.el, vc/vc-git.el, vc/vc-hg.el, vc/vc-src.el: + * vc/vc.el: latest-on-branch-p is no longer a public method. + + * vc/vc.el, vc/vc-hg.el, vc/vc-git.el, vc/vc-hooks.el: + * vc/vc-mtn.el, vc/vc-rcs.el, vc/vc-sccs.el, vc/vc-src.el: + Remove `rollback' method, to be replaced in the future by uncommit. + +2014-12-11 Michael Albinus <michael.albinus@gmx.de> + + * vc/vc-hg.el (vc-hg-state): Make FILE absolute. Handle the case + that there is empty output. + +2014-12-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eldoc.el (eldoc-documentation-function): Change default. + (eldoc-mode, eldoc-schedule-timer): Adjust to new default. + +2014-12-10 Artur Malabarba <bruce.connor.am@gmail.com> + + * let-alist.el: Add new package and macro. + +2014-12-10 Eric S. Raymond <esr@snark.thyrsus.com> + + * vc/vc-dispatcher.el, vc/vc-hooks.el, vc/vc-rcs.el: + * vc/vc-sccs.el, vc/vc.el: Righteous featurectomy of vc-keep-workfiles, + it's a shoot-self-in-foot archaism. Workfiles are always kept. + +2014-12-10 Rasmus Pank Roulund <emacs@pank.eu> + + * net/ange-ftp.el (ange-ftp-switches-ok): Disallow flags causing + trouble with ls over ftp. These flags result in ls returning no + output, causing Tramp-breakage. (bug#19192) + +2014-12-10 Andreas Schwab <schwab@suse.de> + + * files.el (file-tree-walk): Use file-name-as-directory unconditionally. + +2014-12-10 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * files.el (directory-files-recursively): + Use `file-name-all-completions' instead of `directory-files' for + greater speed. + + * net/shr.el (shr-tag-object): Don't bug out on text elements in + <object>. + +2014-12-09 Bozhidar Batsov <bozhidar@batsov.com> + + * progmodes/ruby-mode.el (auto-mode-alist): Add .rabl, Berksfile + and Puppetfile. + (ruby-toggle-string-quotes): New command that allows you to quickly + toggle between single-quoted and double-quoted string literals. + +2014-12-09 Eric S. Raymond <esr@snark.thyrsus.com> + + * vc/vc-src.el (vc-src-do-comand): Prepend -- to file argument + list, avoids problems witt names containing hyphens. + +2014-12-09 Wilson Snyder <wsnyder@wsnyder.org> + + Sync with upstream verilog-mode revision aa4b777. + * progmodes/verilog-mode.el (verilog-mode-version): Update. + (verilog-auto-end-comment-lines-re, verilog-end-block-ordered-re) + (verilog-set-auto-endcomments): Automatically comment property/ + endproperty blocks to match other similar blocks like sequence/ + endsequence, function/endfunction, etc. Reported by Alex Reed. + (verilog-set-auto-endcomments): Fix end comments for functions of + type void, etc. Detect the function- or task-name when + auto-commenting blocks that lack an explicit portlist. + Reported by Alex Reed. + (verilog-nameable-item-re): Fix nameable items that can have an + end-identifier to include endchecker, endgroup, endprogram, + endproperty, and endsequence. Reported by Alex Reed. + (verilog-preprocessor-re, verilog-beg-of-statement): + Fix indentation of property/endproperty around pre-processor + directives. Reported by Alex Reed. + (verilog-label-be): When auto-commenting a buffer, consider + auto-comments on all known keywords (not just a subset thereof). + Reported by Alex Reed. + (verilog-beg-of-statement): Fix labeling do-while blocks, bug842. + Reported by Alex Reed. + (verilog-beg-of-statement-1, verilog-at-constraint-p): + Fix hanging with many curly-bracket pairs, bug663. + (verilog-do-indent): Fix electric tab deleting form-feeds. + Note caused by indent-line-to deleting tabls pre 24.5. + (verilog-auto-output, verilog-auto-input, verilog-auto-inout) + (verilog-auto-inout-module, verilog-auto-inout-in): Doc fixes. + (verilog-read-always-signals, verilog-auto-sense-sigs) + (verilog-auto-reset): Fix AUTORESET with always_comb and always_latch, + bug844. Reported by Greg Hilton. + +2014-12-09 Alex Reed <acreed4@gmail.com> (tiny change) + + * progmodes/verilog-mode.el (verilog-no-indent-begin-re): + Fix `verilog-indent-begin-after-if' nil not honoring 'forever', + 'foreach', and 'do' keywords. + (verilog-endcomment-reason-re, verilog-beg-of-statement): + Fix labeling do-while blocks, bug842. + (verilog-backward-token): Fix indenting sensitivity lists with + named events, bug840. + +2014-12-09 Reto Zimmermann <reto@gnu.org> + + Sync with upstream vhdl mode v3.36.1. + * progmodes/vhdl-mode.el (vhdl-version, vhdl-time-stamp): Update. + (vhdl-compiler-alist): Anchor all error regexps. + (vhdl-compile-use-local-error-regexp): Change default to nil. + (vhdl-asort, vhdl-anot-head-p): Remove. + (vhdl-aput, vhdl-adelete, vhdl-aget): Simplify. + Remove optional argument of vhdl-aget and update all callers. + (vhdl-import-project): Also set `vhdl-compiler'. + +2014-12-09 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * files.el (find-files): New function. + + * net/shr.el (shr-dom-print): Don't print comments. + (shr-tag-svg): Give inline SVG images the right type. + + * net/eww.el (eww-update-header-line-format): Mark valid/invalid + certificates in the header line. + (eww-invalid-certificate, eww-valid-certificate): New faces. + +2014-12-09 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * progmodes/python.el (inferior-python-mode): + Set `comint-prompt-read-only` to `t` only locally. + +2014-12-08 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/nsm.el (nsm-check-protocol): Test for RC4 on `high'. + (nsm-format-certificate): Include more data about the connection. + (nsm-query): Fill the text to that it looks nicer. + (nsm-check-protocol): Also warn if using SSL3 or older. + +2014-12-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/gud.el (gud-gdb-completions): Remove unused var `start'. + + * obsolete/gulp.el (gulp-create-m-p-alist): Remove unused var `mnt-tm'. + + * net/tramp.el (tramp-handle-make-symbolic-link): Mark unused arg. + + * info.el (Info-mode-map): Remove left-over binding. + + * emacs-lisp/avl-tree.el: Use lexical-binding and cl-lib. + (avl-tree--root): Remove redundant defsetf. + +2014-12-08 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/nsm.el (network-security-level): Remove the detailed + description, which was already outdated, and refer the users to + the manual. + (nsm-check-protocol): Check for weak Diffie-Hellman prime bits + (bug#19153). + +2014-12-06 Andrey Kotlarski <m00naticus@gmail.com> + + * net/eww.el (eww-buffers-mode): New major mode. + (eww-list-buffers, eww-buffer-select, eww-buffer-show-next) + (eww-buffer-show-previous, eww-buffer-kill, eww-buffer-show): + New commands/functions (bug#19131). + +2014-12-08 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/gnutls.el (gnutls-negotiate): Ignore files found via + 'file-name-handler-alist' since the gnutls library can't use those + (bug#15866). + +2014-12-08 Dmitry Gutov <dgutov@yandex.ru> + + * vc/vc-hg.el (vc-hg-dir-status-files): Only include ignores files + when FILES is non-nil (bug#19304). + +2014-12-08 Eric S. Raymond <esr@snark.thyrsus.com> + + * vc/vc-arch.el: Move to obsolete directory so a test framework + won't trip over bit-rot in it. There has been no Arch snapshot + for nine years. + +2014-12-07 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww-follow-link): Revert prefix behaviour to + previous behavior. + (eww-copy-page-url): Add doc string. + +2014-12-07 Ivan Shmakov <ivan@siamics.net> + + * net/eww.el (eww): Move history recording here... + (eww-browse-url): ... from here (bug#19253). + + * net/eww.el (eww-browse-url): Use generate-new-buffer (was: + iterating over possible buffer names.) + +2014-12-07 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww-reload): Take a prefix to work locally (bug#19086). + (eww-current-buffer): Compilation fix for bug#18550 patch. + +2014-12-07 Ivan Shmakov <ivan@siamics.net> + + * net/eww.el (eww-list-histories): Restore the history in the + correct buffer (bug#18550). + +2014-12-07 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww-bookmark-prepare): Display URLs in first by + displaying shortened titles first (bug#16398). + +2014-12-07 Tom Willemse <tom@ryuslash.org> (tiny change) + + * progmodes/python.el: Recognize docstrings. + (python-docstring-at-p, python-font-lock-syntactic-face-function): + New functions. + (python-mode): Use them. + +2014-12-06 Ulf Jasper <ulf.jasper@web.de> + + * net/newst-treeview.el (newsticker--treeview-list-add-item) + (newsticker--treeview-propertize-tag): Bind tree menu to mouse-3. + (newsticker--treeview-create-groups-menu) + (newsticker--treeview-create-tree-menu): Remove. + (newsticker--treeview-tree-open-menu): New. + (newsticker-treeview-tree-click): Pass event to + `newsticker-treeview-tree-do-click'. + (newsticker-treeview-tree-do-click): Open treemenu on mouse-3. + +2014-12-05 Juri Linkov <juri@linkov.net> + + * comint.el (comint-history-isearch-search) + (comint-history-isearch-wrap): Use field-beginning instead of + comint-line-beginning-position. + (comint-send-input): Go to the end of the field instead of the end + of the line to accept whole multi-line input. + http://lists.gnu.org/archive/html/emacs-devel/2014-12/msg00305.html + +2014-12-05 Juri Linkov <juri@linkov.net> + + * minibuffer.el (minibuffer-completion-help): + Compare selected-window with minibuffer-window to check whether + completions should be displayed near the minibuffer. (Bug#17809) + http://lists.gnu.org/archive/html/emacs-devel/2014-12/msg00311.html + +2014-12-05 Michael Albinus <michael.albinus@gmx.de> + + * vc/vc-mtn.el (vc-mtn-root): + * vc/vc-svn.el (vc-svn-registered): Make FILE absolute. + +2014-12-05 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/sh-script.el (sh-smie-sh-rules): Go back to the beginning of the whole pipe when indenting an opening keyword after a |. Generalize this treatment to opening keywords like "while" (bug#18031). -2014-12-01 Stefan Monnier <monnier@iro.umontreal.ca> +2014-12-05 Stefan Monnier <monnier@iro.umontreal.ca> * simple.el (newline): Place the hook buffer-locally, to make sure it's first. @@ -266,46 +2175,340 @@ Fix handling of symbols with different syntax at beginning/end or with symbol rather than word syntax. -2014-11-30 Eli Zaretskii <eliz@gnu.org> +2014-12-05 Eli Zaretskii <eliz@gnu.org> * simple.el (line-move): If noninteractive, call line-move-1, not forward-line, since the former is compatible with line-move-visual both in terms of the column to which it moves and the return value. (Bug#19211) -2014-11-27 Stephen Berman <stephen.berman@gmx.net> +2014-12-05 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc/ediff-init.el (ediff-odd-p): Remove. + (ediff-background-face): Use cl-oddp instead. + (ediff-buffer-live-p): Make it a defsubst. + + * tooltip.el (tooltip-region-active-p): Remove. + + * net/shr.el (shr-char-breakable-p, shr-char-kinsoku-bol-p) + (shr-char-kinsoku-eol-p, shr-char-nospace-p): Use define-inline. + + * fringe.el (fringe-bitmap-p): Make it a plain function. + + * emacs-lisp/eieio-core.el: Prefer inlinable functions over macros. + (class-p, generic-p, eieio-object-p, class-abstract-p): + Make them defsubst, so as to avoid corner case problems where + the arg might be evaluated in the condition-case, or it can't be passed + to higher-order functions like `cl-some'. + +2014-12-05 Nicolas Richard <theonewiththeevillook@yahoo.fr> + + * wid-edit.el (widget-choose): Let numeric keypad work (bug#19268) + and remove old menu-related code. + +2014-12-05 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww-display-pdf): Let mailcap determine how to + display PDF files (bug#19270). + +2014-12-05 Juri Linkov <juri@linkov.net> + + Compare with the most recent window by default. + * vc/compare-w.el (compare-windows-get-window-function): New defcustom. + (compare-windows-get-recent-window) + (compare-windows-get-next-window): New functions. + (compare-windows, compare-windows-sync-default-function): + Use `compare-windows-get-window-function' instead of `next-window'. + (compare-windows): Add diff/match messages with region boundaries. + (Bug#19170) + +2014-12-04 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (filter): Remove. Use `cl-remove-if-not' or `seq-filter'. + +2014-12-04 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/shr.el (shr--extract-best-source): Ignore non-text children. + +2014-12-04 Eli Zaretskii <eliz@gnu.org> + + Implement copying of a buffer portion while preserving visual order. + * simple.el (bidi-directional-controls-chars) + (bidi-directional-non-controls-chars): New variables. + (squeeze-bidi-context-1, squeeze-bidi-context) + (line-substring-with-bidi-context) + (buffer-substring-with-bidi-context): New functions. + + * files.el (file-tree-walk): Doc fix. + +2014-12-04 Rupert Swarbrick <ruperts@broadcom.com> (tiny change) + Rüdiger Sonderfeld <ruediger@c-plusplus.net> + + * autoinsert.el (auto-insert-alist): Update C/C++ header and + program support to match more extensions. Replace non-alnum + characters when generating include guards (headers) and check for + more extensions when generating includes (programs) + (bug#19254). + +2014-12-03 Eric S. Raymond <esr@snark.thyrsus.com> + + * files.el (file-tree-walk): Fix docstring. + +2014-12-03 Karl Fogel <kfogel@red-bean.com> + + Fix bug whereby saving files hung in VC hook. + + Saving a buffer visiting a file under SVN control would hang if + the remote repository were unreachable, because the VC hooks tried + to run "svn status -u" on the file, where the "-u" tells svn to + get update information from the remote repository. + http://lists.gnu.org/archive/html/emacs-devel/2014-12/msg00174.html + + * vc/vc-svn.el (vc-svn-state): Remove optional `localp' + argument and always pass "-v" to "svn status", never "-u". + +2014-12-03 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/inline.el: Fix up copyright header. + (inline-quote, inline-const-p, inline-const-val, inline-error): + Silence compiler warnings. + (inline-letevals): Fix edebug spec. + (inline--testconst-p): Consider lambda expressions as const-p. + (inline--getconst-val): Use inline--testconst-p. + + * minibuffer.el (completion-table-dynamic): Add arg `switch-buffer' + and change default to stay in the minibuffer when called from + the minibuffer (bug#19250). + (lazy-completion-table): Use this new argument to preserve the + old behavior. + + * progmodes/elisp-mode.el (elisp--local-variables): Don't burp on + incorrect lexical elements (bug#19250). + +2014-12-03 A. N. Other <none@example.com> + + * files.el (file-tree-walk): Lisp translation of ANSI ftw(3). + +2014-12-02 Glenn Morris <rgm@gnu.org> + + * whitespace.el (whitespace-big-indent-regexp): Add :version. + +2014-12-02 Eric S. Raymond <esr@snark.thyrsus.com> + + * subr.el (filter): New macro. Because it's just silly for a Lisp + not to have this in 2014. And VC needs it. + + * vc.el: All backends: API simplification: Abolish dir-status. + It's replaced by dir-status-files. + + * vc.el: All backends: API simplification: Remove 4th + 'default-state' argument from vc-dir-status files and its backend + methods - no backend method ever set it. It was used only in the + fallback method to to set a default of 'up-to-date, though a + convoluted call chain obscured this. + + * vc-hooks.el: Bind vc-delete-file to Ctrl-x v delete. + + * vc.el (vc-expand-dirs): Now takes a second BACKEND argument, + improving behavior on directories using multiple file-oriented VCSes. + + * vc/vc.el: All backends: API simplification; clear-headers + is no longer a public method. It is now local to the one place + it's used, in the RCS steal-lock method. + +2014-12-01 Eric S. Raymond <esr@snark.thyrsus.com> + + * vc/vc.el: In all backends: API simplification; could-register + is no longer a public method. (vc-cvs.el still has a private + implementation.) + + * vc/vc.el: In all backends: API cleanup; the backend diff method + takes an explicit async flag. This eliminates a particularly ugly + global. + + * vc-bzr.el: Restore vc-bzr-state-heuristic as a private method. + VC randomly/unpredictably fails without it; cause not yet established. + +2014-12-01 Stefan Monnier <monnier@iro.umontreal.ca> + + Merge some of the differences from the standalone CC-mode. + The main change is to only use the `category' text-property only when + available. For that many calls are changed to use c-get-char-property, + c-next-single-property-change, c-sc-scan-lists, + c-sc-parse-partial-sexp, c-unmark-<->-as-paren. + + * progmodes/cc-mode.el (c-just-done-before-change): New var. + (c-basic-common-init): Initialize it. + (c-common-init): Only use mode-require-final-newline when available. + (c-before-change): Check and set c-just-done-before-change. + (c-after-change): Re-set c-just-done-before-change. + (c-advise-fl-for-region): New macro. + (lazy-lock-defer-rest-after-change, lazy-lock-defer-line-after-change) + (font-lock-after-change-function, jit-lock-after-change): + Advise if needed. + + * progmodes/cc-langs.el (c-modified-constant): New lang var. + (c-known-type-key): Don't make a list just to throw it away. + + * progmodes/cc-engine.el (c-invalidate-state-cache, c-parse-state): + Handle the case where categories are not available. + (c-record-parse-state-state, c-replay-parse-state-state): + Handle marker values. + (c-before-change-check-<>-operators): Look for the `syntax-table' + property rather than for the corresponding `category'. + (c-looking-at-decl-block): Remove unused var + `c-disallow-comma-in-<>-arglists'. + (c-forward-<>-arglist-recur): Remove unused var + `orig-record-found-types'. + + * progmodes/cc-defs.el (c-version): Bump up to 5.33. + (c-use-category): New const. + (c-next-single-property-change): New macro. + (c-region-is-active-p): Prefer region-active-p when available. + (c-search-backward-char-property): Fix old min/max typo; probably + a copy/paste error. + (c-mark-<-as-paren, c-mark->-as-paren, c-unmark-<->-as-paren): + Turn them into macros that obey c-use-category. + (c-sc-scan-lists-no-category+1+1, c-sc-scan-lists-no-category+1-1) + (c-sc-scan-lists-no-category-1+1, c-sc-scan-lists-no-category-1-1) + (c-sc-scan-lists, c-sc-parse-partial-sexp) + (c-looking-at-non-alphnumspace): New macros. + (c-sc-parse-partial-sexp-no-category): New function. + (c-emacs-features): Add `category-properties' element. + + * progmodes/cc-cmds.el (c-forward-into-nomenclature) + (c-backward-into-nomenclature): Use cc-subword if subword-mode is + not available. + (c-beginning-of-defun, c-end-of-defun, c-mark-function) + (c-indent-line-or-region): Use c-region-is-active-p. + + * progmodes/cc-bytecomp.el (cc-bytecomp-unbound-variables) + (cc-bytecomp-original-functions, cc-bytecomp-original-properties) + (cc-bytecomp-loaded-files): Re-set each time the file is loaded. + (cc-bytecomp-obsolete-var, cc-bytecomp-ignore-obsolete) + (cc-bytecomp-obsolete-fun): Delete unused functions. + + * progmodes/cc-align.el (c-lineup-respect-col-0): New function. + +2014-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/shr.el (shr-dom-print): Fix up `shr-dom-print' after the + dom.el changes. + +2014-12-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc/vc.el (vc-find-conflicted-file): Look for conflicted files in the + current "project" rather than just the current directory. + * vc/vc-git.el (vc-git-conflicted-files): Clarify in which directory + the file names make sense. + + * vc/smerge-mode.el (smerge-swap): New command. + + * vc/diff-mode.el (diff-kill-applied-hunks): New command. + +2014-12-01 Ulf Jasper <ulf.jasper@web.de> + + * net/newst-treeview.el (newsticker--treeview-item-show): + Check window liveliness before measuring its width. + + * net/newst-backend.el (newsticker--get-news-by-url-callback): + Pass correct status to `newsticker--sentinel-work'. + (newsticker--sentinel-work): Use "newsticker--download-error" as + guid in order to prevent multiple "Could not download..." + messages. Fixes bug#19166. + +2014-12-01 Ivan Shmakov <ivan@siamics.net> + + * net/eww.el (eww-render): Call `eww-after-render-hook' in the + correct buffer (bug#19225). + +2014-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/nsm.el (network-security-level): Change the default to `medium'. + + * net/eww.el (eww): Leave point in a place that doesn't cause + scrolling when displaying "Loading...". + +2014-12-01 Eric S. Raymond <esr@snark.thyrsus.com> + + * vc/vc.el, vc/vc-cvs.el, vc/vc-rcs.el, vc/vc-svn.el: The 'merge' + backend method of RCS/CVS/SVN is now 'merge-file', to contrast with + 'merge-branch'. Prompting for merge revisions is pushed down to + the back ends; this fixes a layering violation that caused bad + behavior with SVN. + + * vc/vc.el, vc-hooks.el: All backends: API simplification; + vc-stay-local-p and repository-hostname are no longer public + methods. Only the CVS and SVN backends used these, and the SVN + support was conditioned out because svn status -v is too slow. + The CVS back end retains this machinery and the vc-stay-local + configuration variable now only affects it. + +2014-12-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/inline.el: New file. + +2014-12-01 Eric S. Raymond <esr@snark.thyrsus.com> + + * vc/vc.el, vc-hooks.el: All backends: API simplification; + vc-state-heuristic is no longer a public method, having been + removed where it is redundant, unnecessary, or known buggy. + This eliminated all backends except CVS. Eliminates bug#7850. + + * vc/vc-cvs.el, vc/vc-hooks.el, vc/vc-rcs.el, vc/vc-sccs.el: + Eliminate vc-mistrust-permissions. It was only relevant to the + RCS and SCCS back ends and defaulted to t. Code now always + mistrusts permissions - by actual measurement the effect on + performance is negligible. As a side effect bug#11490 is now + irrelevant. + + * vc/vc.el, vc-hooks.el: All backends: API simplification; + vc-workfile-unchanged-p is no longer a public method (but the RCS + and SCCS back ends retain it as a private method used in state + computation). This method was redundant with vc-state and usually + implemented as a trivial call to same. Fixes the failure mode + described in bug#694. + + * vc/vc.el: All backends: API simplification; init-revision is + gone, and vc-registered functions no longer take an + initial-revision argument. + +2014-11-29 Glenn Morris <rgm@gnu.org> + + * vc/vc-src.el (vc-src, vc-src-diff-switches) + (vc-src-master-templates): Fix :version tags. + +2014-11-29 Paul Rankin <paul@tilk.co> (tiny change) + + * outline.el (outline-move-subtree-down): Refactor and improve code. + +2014-11-29 Stephen Berman <stephen.berman@gmx.net> Stefan Monnier <monnier@iro.umontreal.ca> * outline.el (outline-move-subtree-down): Make sure we can move forward to find the end of the subtree and the insertion point (bug#19102). -2014-11-27 Leonard Randall <leonard.a.randall@gmail.com> - - * textmodes/reftex-parse.el (reftex-using-biblatex-p): Make search - for comment lines non-greedy and stopping at newlines to fix stack - overflows with large files. [Backport] - -2014-11-27 Fabián Ezequiel Gallina <fgallina@gnu.org> +2014-11-29 Fabián Ezequiel Gallina <fgallina@gnu.org> * progmodes/python.el (python-shell-completion-setup-code): Use __builtin__ module (or builtins in Python 3) and catch all errors when importing readline and rlcompleter. -2014-11-26 Stephen Berman <stephen.berman@gmx.net> +2014-11-29 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el: Handle calling revert-buffer (bug#19187). (todo-revert-buffer): New function. (todo-modes-set-1): Use it as the buffer-local value of revert-buffer-function. -2014-11-26 Stephen Berman <stephen.berman@gmx.net> +2014-11-29 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el (todo-mode): If called interactively, just display a message saying to call todo-show to enter Todo mode (Bug#19112). -2014-11-24 Dmitry Gutov <dgutov@yandex.ru> +2014-11-29 Dmitry Gutov <dgutov@yandex.ru> * vc/vc-hg.el (vc-hg-dir-status-files): Include ignored files. (Bug#18579) @@ -313,23 +2516,23 @@ * vc/vc-bzr.el (vc-bzr-after-dir-status): Don't skip ignored files. (Bug#18579) -2014-11-23 Michael Albinus <michael.albinus@gmx.de> +2014-11-29 Michael Albinus <michael.albinus@gmx.de> * textmodes/makeinfo.el (makeinfo-buffer): Make it work also for remote `buffer-file-name'. -2014-11-23 Leo Liu <sdl.web@gmail.com> +2014-11-29 Leo Liu <sdl.web@gmail.com> * calendar/diary-lib.el (calendar-mark-1): Fix thinko. -2014-11-22 Fabián Ezequiel Gallina <fgallina@gnu.org> +2014-11-29 Fabián Ezequiel Gallina <fgallina@gnu.org> Set PYTHONUNBUFFERED on shell startup. * progmodes/python.el (python-shell-unbuffered): New var. (python-shell-calculate-process-environment): Use it. -2014-11-22 Michael Albinus <michael.albinus@gmx.de> +2014-11-29 Michael Albinus <michael.albinus@gmx.de> * net/tramp.el (tramp-action-password): Clean password on subsequent attempts even if there was no wrong password indication. (Bug#19047) @@ -339,7 +2542,7 @@ (tramp-open-connection-setup-interactive-shell): No need to check for nil as `tramp-get-remote-locale' return value. -2014-11-21 Eli Zaretskii <eliz@gnu.org> +2014-11-29 Eli Zaretskii <eliz@gnu.org> * vc/vc-git.el (vc-git-command, vc-git--call): Bind coding-system-for-read and coding-system-for-write to @@ -347,7 +2550,7 @@ (vc-git-previous-revision): Use "~1" instead of "^", since the latter is a special character for MS-Windows system shells. -2014-11-20 Michael Albinus <michael.albinus@gmx.de> +2014-11-29 Michael Albinus <michael.albinus@gmx.de> Improve XEmacs compatibility. @@ -370,23 +2573,91 @@ * net/tramp-sh.el (tramp-open-connection-setup-interactive-shell): Check, whether `utf-8' is a valid coding system. -2014-11-19 Eli Zaretskii <eliz@gnu.org> +2014-11-29 Eli Zaretskii <eliz@gnu.org> * vc/vc.el (vc-retrieve-tag): Doc fix. -2014-11-17 Eli Zaretskii <eliz@gnu.org> +2014-11-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * simple.el (execute-extended-command--shorter): Fix the "M-p" case + (bug#19152). + +2014-11-28 Martin Rudalics <rudalics@gmx.at> + + Fix two issues around help-window-select. (Bug#11039) (Bug#19012) + * help.el (help-window-old-frame): New variable. + (help-window-select): Default to nil (Bug#11039). + Rewrite doc-string. + (help-window-setup): When the help window appears on another + frame and `help-window-select' is non-nil, give that frame input + focus too (Bug#19012). + (with-help-window): Store selected frame in + help-window-old-frame. + +2014-11-28 Ulf Jasper <ulf.jasper@web.de> + + * net/newst-treeview.el (newsticker--treeview-load): Take care of + nil value for `newsticker-groups-filename'. + +2014-11-28 Daiki Ueno <ueno@gnu.org> + + * epa.el (epa-sign-file, epa-encrypt-file, epa-decrypt-region) + (epa-sign-region, epa-encrypt-region): + Use `epg-context-set-{passphrase,progress}-callback', instead of + `setf'. This partially reverts commit 9e48a95c (bug#19150). + Reported by José A. Romero L. + +2014-11-27 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww-restore-history): + Bind `inhibit-modification-hooks' instead of `after-change-functions'. + +2014-11-27 Ulf Jasper <ulf.jasper@web.de> + + * net/newst-backend.el (newsticker--parse-atom-1.0): + Handle embedded (x)html in summary node. + +2014-11-27 Sam Steingold <sds@gnu.org> + + * menu-bar.el (menu-bar-open): When everything else fails, + use (mouse-menu-bar-map). + +2014-11-27 Ulf Jasper <ulf.jasper@web.de> + + * net/newst-treeview.el (newsticker-groups-filename): + Change default value to nil. Point out that variable is obsolete in doc + string. + (newsticker--treeview-load): Change wording of the questions the + user is asked when `newsticker-groups-filename' is found to be + used and we offer to read and remove the groups file. (Bug#19165) + +2014-11-27 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww): Record the new URL immediately, so that if the + HTTP fetch fails, we have the right URL in the buffer. + (eww-process-text-input): Don't shorten the input field if + deleting at the last character (bug#19085). + (eww-restore-history): Inhibit change functions while restoring + the history. + (eww-process-text-input): Fix deletion at the start of the field, too. + (eww-mode): Revert mistanken removal of `buffer-disable-undo'. + (eww-process-text-input): Try to keep track of the size more reliably. + + * dom.el (dom-pp): New function. + +2014-11-27 Eli Zaretskii <eliz@gnu.org> * vc/vc-bzr.el (vc-bzr-print-log, vc-bzr-expanded-log-entry): Don't assume --long is the default for "bzr log", always specify it explicitly, in case the user defined an alias for 'log' that uses some other format. -2014-11-16 Fabián Ezequiel Gallina <fgallina@gnu.org> +2014-11-27 Fabián Ezequiel Gallina <fgallina@gnu.org> * progmodes/python.el (python-eldoc--get-doc-at-point): Strip shell output before returning. (bug#18794) -2014-11-16 Dmitry Gutov <dgutov@yandex.ru> +2014-11-27 Dmitry Gutov <dgutov@yandex.ru> Fix indentation before `!=' and after `+='. Originally reported in https://github.com/mooz/js2-mode/issues/174. @@ -394,85 +2665,764 @@ (in)equality operator a separate case. (js--continued-expression-p): Escape the second `+' in the regexp. -2014-11-16 Stefan Monnier <monnier@iro.umontreal.ca> +2014-11-27 Stefan Monnier <monnier@iro.umontreal.ca> * window.el (handle-select-window): Deactivate shift-region (bug#19003). -2014-11-15 Andreas Schwab <schwab@linux-m68k.org> +2014-11-26 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/nsm.el (nsm-new-fingerprint-ok-p): Display the certificate + when querying about new certificates. + + * net/shr.el (shr-make-table-1): dom.el changes for table rendering. + + * dom.el (dom-by-tag): Use `equal' for comparisons so that tags + can be strings. + (dom-elements): Protect against non-text nodes. + (dom-non-text-children): New function. + + * net/eww.el (eww-tag-title): Use `dom-text'. + +2014-11-26 Sam Steingold <sds@gnu.org> + + * textmodes/sgml-mode.el (sgml-validate-command): Pass -utf8 to tidy. + +2014-11-26 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww-highest-readability): More dom.el fixes. + +2014-11-26 Ulf Jasper <ulf.jasper@web.de> + + * net/newst-backend.el (newsticker--parse-generic-items): + Take care of UIDs when adding elements to cache. + +2014-11-26 Alan Mackenzie <acm@muc.de> + + Remove spurious reference to symbol category_properties. + * progmodes/cc-engine.el (c-state-pp-to-literal): Fix here. + +2014-11-26 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el: Use the new dom.el accessors throughout. + + * net/shr.el: Ditto. + + * dom.el: New file. + +2014-11-26 Glenn Morris <rgm@gnu.org> + + * arc-mode.el (archive-visit-single-files): Add :version. + +2014-11-25 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/nsm.el (nsm-format-certificate): Don't bug out on missing + elements. + (nsm-warnings-ok-p): The new version of this function always + returned nil when everything was OK. + +2014-11-25 Teodor Zlatanov <tzz@lifelogs.com> + + * net/gnutls.el (gnutls): Set :group to 'comm so it's near NSM. + + * net/nsm.el (nsm-check-tls-connection, nsm-save-host) + (nsm-warnings-ok-p): Use `gnutls-peer-status-warning-describe'. + +2014-11-20 Nicolas Richard <theonewiththeevillook@yahoo.fr> + + * emacs-lisp/byte-run.el (function-put): Match argument names to + docstring. + +2014-11-24 Sam Steingold <sds@gnu.org> + + * vc/vc-hooks.el (vc-directory-exclusion-list): + Fix a trivial typo (bug#19171). + +2014-11-24 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc/vc-hooks.el (vc-state-base-face): Don't override + mode-line-inactive. + +2014-11-24 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww-set-character-encoding): Use `read-coding-system'. + (eww-process-text-input): Inhibit read only so that input fields + don't get shortened (bug#19085). + +2014-11-24 Leo Liu <sdl.web@gmail.com> + + * emacs-lisp/macroexp.el (macroexp-let2*): New macro. + + * window.el (with-temp-buffer-window) + (with-current-buffer-window, with-displayed-buffer-window): + * emacs-lisp/cl-macs.el (cl--compiler-macro-adjoin): + * emacs-lisp/cl-lib.el (substring): + * emacs-lisp/cl-extra.el (cl-getf): Use it. + +2014-11-24 Eli Zaretskii <eliz@gnu.org> + + * isearch.el (isearch-update): Don't assume + pos-visible-in-window-p will return nil when point is hscrolled + out of view. (Bug#19157) + +2014-11-20 Andrey Kotlarski <m00naticus@gmail.com> + + * net/eww.el (eww-browse-url): Optionally create new eww buffer. + (eww-follow-link): Follow in new buffer in case of prefix + argument, open externally with double prefix (bug#19130). + +2014-11-23 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww-display-html): Decode the document-defined charset. + (eww): Pop to the *eww* buffer immediately after executing the + `M-x eww' command to avoid having buffers pop up later. + (eww-display-html): Don't pop the *eww* buffer. + (eww-display-raw): Ditto. + (eww-display-image): Ditto. + (eww-follow-link): Make going to #targets in the page work again. + +2014-11-23 Ivan Shmakov <ivan@siamics.net> + + * net/eww.el (eww-suggest-uris): New variable. + (eww-suggested-uris): New function. + (eww): Default to URL under point. + (eww-links-at-point): New function. + +2014-11-20 Mark Oteiza <mvoteiza@udel.edu> (tiny change) + + * net/eww.el (eww-add-bookmark): Fix bookmark titles. + +2014-11-17 Mark Oteiza <mvoteiza@udel.edu> (tiny change) + + * net/eww.el (eww-mode-map): Bind backtab to shr-previous-link. + +2014-11-23 Kenjiro Nakayama <nakayamakenjiro@gmail.com> + + * net/eww.el (eww-set-character-encoding): New command and keystroke. + (eww-display-raw): Use it (bug#16225). + +2014-11-23 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/nsm.el (network-security-level): Rename from + `nsm-security-level' and documented. + + * mail/smtpmail.el (smtpmail-via-smtp): Warn unless encrypted and + we're sending a password. + + * net/nsm.el: New file that implements a Network Security Manager. + + * net/network-stream.el (open-network-stream): Add a new + :warn-unless-encrypted parameter. + (network-stream-open-plain): Allow warning unless encrypted. + (network-stream-open-starttls): Call the Network Security Manager. + (network-stream-open-tls): Ditto. + +2014-11-23 Leo Liu <sdl.web@gmail.com> + + * calendar/cal-china.el (calendar-chinese-from-absolute-for-diary) + (calendar-chinese-to-absolute-for-diary) + (calendar-chinese-mark-date-pattern, diary-chinese-anniversary): + Handle leap months in Chinese calendar. (Bug#18953) + +2014-11-22 Alan Mackenzie <acm@muc.de> + + Fix error with `mark-defun' and "protected:" in C++ Mode. + Fixes: debbugs:19134. + + * progmodes/cc-cmds.el (c-where-wrt-brace-construct): Handle a + return code of (label) from c-beginning-of-decl-1. + +2014-11-22 Ulf Jasper <ulf.jasper@web.de> + + * net/newst-backend.el (newsticker--sentinel-work): + Tell `libxml-parse-xml-region' to discard comments. Fixes bug#18787. + +2014-11-22 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-sh.el (tramp-sh-handle-start-file-process) + (tramp-sh-handle-process-file): Propagate `process-environment'. + + * vc/vc-hg.el (vc-hg-state): No special handling for remote files; + Tramp propagates environment variables now. + +2014-11-22 Eric S. Raymond <esr@snark> + + * vc/vc-filewise.el: New file to isolate code used only by the + file-oriented back ends (SCCS/RCS/CVS/SRC) which should not + live in vc.el and certainly not in vc-hooks.el. + + * vc/vc-hooks.el, vc-rcs.el, vc-sccs.el: vc-name -> vc-master-name. + This is preparatory to isolating all the 'master' functions + used only by the file-oriented back ends. With this done first, + the substantive diffs will be easier to read. + +2014-11-21 Rüdiger Sonderfeld <ruediger@c-plusplus.net> + + * play/morse.el (nato-alphabet): Mark URL in docstring in a way + that is recognized by `help-mode'. + +2014-11-21 Stefan Monnier <monnier@iro.umontreal.ca> + + * desktop.el (desktop-create-buffer): Use activate-mark to set + `mark-active' (bug#19058). + +2014-11-21 Eric S. Raymond <esr@snark> + + * vc/vc-src.el (vc-src-state): Fix bug that produced spurious + nil state. + +2014-11-21 Eli Zaretskii <eliz@gnu.org> + + * vc/vc.el (vc-deduce-fileset): Support invocation from + *vc-change-log* buffer. (Bug#19084) + +2014-11-13 Matthew Leach <matthew@mattleach.net> + + * arc-mode.el (archive-visit-single-files): New. + (archive-mode): Visit file if archive contains a single file. + (Bug#1702) + +2014-11-21 Ulrich Müller <ulm@gentoo.org> + + * vc/vc.el: Fix a typo in the commentary. + +2014-11-20 Eric S. Raymond <esr@snark.thyrsus.com> + + * vc/vc-src.el, vc/vc.el: Added support for SRC. Needs more + testing and a real log-view mode. + + * vc/vc-bzr.el, vc/vc-cvs.el, vc/vc-dav.el, vc/vc-git.el: + * vc/vc-hg.el, vc/vc-mtn.el, vc/vc-rcs.el, vc/vc-sccs.el: + * vc/vc-svn.el, vc/vc.el: Remove editable argument from the backend + checkout methods; where it matters (which is only in SCCS and RCS) + files are always checked out editable. This may actually have + been dynamically true already - it looks like the vc-next-action + code evolved past visiting the other case. Tested with RCS. + + * vc/vc-arch.el, vc/vc-bzr.el, vc/vc-cvs.el, vc/vc-dav.el: + * vc/vc-git.el, vc/vc-hg.el, vc/vc-mtn.el, vc/vc-rcs.el: + * vc/vc-sccs.el, vc/vc-svn.el, vc/vc.el: Remove never-used rev + argument from the backend checkin methods. Only the RCS, SCCS, + and CVS back ends tried to do anything with it, and that code was + never exercised. Chiseling away the cruft of decades... + +2014-11-19 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww-render): Remove a no-op :title setting. + +2014-11-19 Ivan Shmakov <ivan@siamics.net> + + * net/eww.el (eww-history-limit): New variable. + (eww-save-history): Use it (bug#19105). + (eww-reload): Reload the page in the right buffer. + +2014-11-19 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww-desktop-misc-data): Use `cl-remove-duplicates'. + +2014-11-19 Ivan Shmakov <ivan@siamics.net> + + * net/eww.el (eww-desktop-remove-duplicates) + (eww-restore-desktop, eww-restore-reload-prompt): New variables. + (eww-mode): Set up desktop mode (bug#18010). + (eww-desktop-data-save, eww-desktop-data-1) + (eww-desktop-history-duplicate, eww-desktop-misc-data) + (eww-restore-desktop): New functions. + +2014-11-19 Eli Zaretskii <eliz@gnu.org> + + * vc/vc.el (vc-log-internal-common): Turn on log-view-mode in the + correct buffer. (Bug#19101) + +2014-11-19 Rüdiger Sonderfeld <ruediger@c-plusplus.net> + + * vc/vc-git.el (vc-git-diff): Use "difftool -x diff" with + `diff-switches' if `vc-git-diff-switches' is nil. (Bug#19099) + +2014-11-19 Artur Malabarba <bruce.connor.am@gmail.com> + + * ido.el (ido-bury-buffer-at-head): New command. + (ido-buffer-completion-map): Bind it to C-S-b. + +2014-11-18 Juri Linkov <juri@linkov.net> + + * simple.el (next-line-or-history-element): Wrap next-line + in with-no-warnings. + (previous-line-or-history-element): Wrap previous-line + in with-no-warnings. + +2014-11-18 Juri Linkov <juri@linkov.net> + + * progmodes/grep.el (grep-compute-defaults): + Compute grep-highlight-matches before its use. + +2014-11-18 Juri Linkov <juri@linkov.net> + + * replace.el (query-replace-from-to-separator): Turn defvar into + defcustom. Wrap char-displayable-p in ignore-errors because an + attempt to autoload char-displayable-p fails during pre-loading. + Move (propertize "\0" ... 'separator t) out of customizable part + to query-replace-read-from. + (query-replace-read-from): Call custom-reevaluate-setting on + query-replace-from-to-separator to reevaluate the separator + depending on the return value of char-displayable-p. + http://lists.gnu.org/archive/html/emacs-devel/2014-11/msg00466.html + +2014-11-18 Juri Linkov <juri@linkov.net> + + * bindings.el (minibuffer-local-map): Rebind [down] from + next-history-element to next-line-or-history-element, and [up] + from previous-history-element to previous-line-or-history-element. + + * simple.el (next-line-or-history-element) + (previous-line-or-history-element): New commands. + http://lists.gnu.org/archive/html/emacs-devel/2014-11/msg00822.html + +2014-11-18 Leo Liu <sdl.web@gmail.com> + + * emacs-lisp/nadvice.el (define-advice): New macro. + * emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression): + Add define-advice. + (lisp-font-lock-keywords-1): Add define-advice. + +2014-11-18 Daiki Ueno <ueno@gnu.org> + + * epg.el (epg-context): New slot EDIT-CALLBACK. + (epg--process-filter): Call EDIT-CALLBACK when editing a key. + (epg-reset): Reset EDIT-CALLBACK of the context. + (epg-start-edit-key): New function. + (epg-edit-key): New function. + +2014-11-18 Paul Eggert <eggert@cs.ucla.edu> + + Port new time stamp handling to Emacs 23.2. + This fix is for Gnus. Reported by Katsumi Yamaoka. + * calendar/time-date.el (time-add, time-subtract, time-less-p): + Use eval-and-compile, not eval-when-compile. + +2014-11-18 Daiki Ueno <ueno@gnu.org> + + * epg.el (epg-context-set-passphrase-callback) + (epg-context-set-progress-callback): Check if the CALLBACK + argument is a function, instead of a cons. + +2014-11-18 Daiki Ueno <ueno@gnu.org> + + * epa-file.el (epa-file-insert-file-contents) + (epa-file-write-region): Remove redundant check of + epa-pinentry-mode. + * epa.el (epa-sign-file, epa-encrypt-file, epa-decrypt-region) + (epa-sign-region, epa-encrypt-region): Remove redundant check of + epa-pinentry-mode. + +2014-11-18 Daiki Ueno <ueno@gnu.org> + + * epa-file.el (epa-file-insert-file-contents): Don't show + "*Error*" buffer if input file does not exist. + Reported by Herbert J. Skuhra. + +2014-11-18 Paul Pogonyshev <pogonyshev@gmail.com> + Rüdiger Sonderfeld <ruediger@c-plusplus.net> + + * progmodes/cc-langs.el: Support some of the new keywords in C++11. + An alternative version of the patch from bug#13871. + (c-operators): Add "alignof". + (c-primitive-type-kwds): Add "char16_t", "char32_t". + (c-type-modifier-kwds): Add "constexpr", "noexcept". + (c-modifier-kwds): Add "thread_local". + (c-constant-kwds): Add "nullptr". + +2014-11-17 Michal Nazarewicz <mina86@mina86.com> + + * textmodes/tildify.el (tildify-pattern, tildify-space-string): + New variables for specifying tildify pattern and representation of + a hard space -- a no-break space by default -- respectively. + Being buffer-local they are much easier to handle than + `tildify-string-alist' and `tildify-pattern-alist' respectively + that have been used so far. They also works better with derived + modes. + (tildify-foreach-region-function): New variable specifying + a function determining portions of buffer that should be + tildified. It allows major modes to create a filtering function + more elaborate than a set of regular expressions. Initialised to + `tildify--deprecated-ignore-evironments' by default to handle now + deprecated `tildify-ignored-environments-alist' variable. + (tildify--foreach-region): A new function that takes + `tildify-foreach-region-function' into account and calls callback + for regions of the buffer that should be tildified. + (tildify-foreach-ignore-environments): A new function which can be + partially applied and used as `tildify-foreach-region-function'. + (tildify-ignored-environments-alist, tildify-pattern) + (tildify-string-alist, tildify--pick-alist-entry): Mark as obsolete. + (tildify--find-env): Rename from `tildify-find-env' and mark as + obsolete. + (tildify--deprecated-ignore-evironments): New function, + immediately marked as obsolete, used to handle deprecated + `tildify-ignored-environments-alist'. + + * textmodes/tex-mode.el (tex-common-initialization): + Set `tildify-space-string' and `tildify-foreach-region-function' + variables in all variants of TeX mode since `tildify-string-alist' + and `tildify-ignored-environments-alist' are now empty by default. + + * nxml/nxml-mode.el (nxml-mode): Ditto in `nxml-mode'. + If encoding supports it use no-break space instead of character + entity; this changes previous default which used a numeric + reference. + + * textmodes/sgml-mode.el (sgml-mode): ditto in `sgml-mode'. + If encoding does not support no-break space, use numeric reference; + this changes previous default which used named entity (“ ”) + in HTML mode. + +2014-11-17 Ulf Jasper <ulf.jasper@web.de> + + * calendar/icalendar.el (icalendar-export-alarms): + New customizable variable. (Bug#5433) + (icalendar-export-region): Export alarms as specified in + `icalendar-export-alarms'. + (icalendar--create-ical-alarm, icalendar--do-create-ical-alarm): + New functions for exporting alarms. + +2014-11-17 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * bindings.el (search-map): Move `eww-search-words' to `M-s M-w'. + +2014-11-17 Paul Eggert <eggert@cs.ucla.edu> + + Port new time stamp handling to old Emacs and to XEmacs. + This is needed for Gnus, which copies time-date.el and which + runs on older Emacs implementations. + * calendar/time-date.el (with-decoded-time-value): + Handle 'nil' and floating-point arg more compatibly with new Emacs. + (encode-time-value, with-decoded-time-value): + Obsolete only if new Emacs. + (time-add, time-subtract, time-less-p): Define if not new Emacs. + + Improve time stamp handling, and be more consistent about it. + This implements a suggestion made in: + http://lists.gnu.org/archive/html/emacs-devel/2014-10/msg00587.html + Among other things, this means timer.el no longer needs to + autoload the time-date module. + * allout-widgets.el (allout-elapsed-time-seconds): Doc fix. + * arc-mode.el (archive-ar-summarize): + * calendar/time-date.el (seconds-to-time, days-to-time, time-since): + * emacs-lisp/timer.el (timer-relative-time, timer-event-handler) + (run-at-time, with-timeout-suspend, with-timeout-unsuspend): + * net/tramp.el (tramp-time-less-p, tramp-time-subtract): + * proced.el (proced-time-lessp): + * timezone.el (timezone-time-from-absolute): + * type-break.el (type-break-schedule, type-break-time-sum): + Simplify by using new functionality. + * calendar/cal-dst.el (calendar-next-time-zone-transition): + Do not return time values in obsolete and undocumented (HI . LO) + format; use (HI LO) instead. + * calendar/time-date.el (with-decoded-time-value): + Treat 'nil' as current time. This is mostly for XEmacs. + (encode-time-value, with-decoded-time-value): Obsolete. + (time-add, time-subtract, time-less-p): Use no-op autoloads, for + XEmacs. Define only if XEmacs, as they're now C builtins in Emacs. + * ldefs-boot.el: Update to match new time-date.el + * proced.el: Do not require time-date. + +2014-11-16 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww-mode): Make the buffer read-only. + (eww-form-text): Inhibit read-only-ness in text input fields + (bug#16476). + +2014-11-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * simple.el (execute-extended-command--shorter): Cut search here. + (execute-extended-command): Instead of here. + +2014-11-16 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * progmodes/python.el (python-mode): Avoid use of set-local to + keep Emacs 24.x compatibility. + +2014-11-16 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/shr.el (shr): Move to the new defgroup `web'. + + * net/eww.el (eww): Ditto. + + * simple.el (execute-extended-command): Don't show the help + message if the binding isn't significantly shorter than the + M-x command the user typed (bug#19013). + +2014-11-16 Ulf Jasper <ulf.jasper@web.de> + + * calendar/icalendar.el (icalendar--convert-tz-offset): + Return complete cons when offsets of standard time and daylight saving + time are equal. + (icalendar-export-region): Fix unbound variable warning. + +2014-11-16 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * progmodes/python.el (run-python): Allow CMD to be optional and + default it to a safe command, even for Windows. (bug#18596) + +2014-11-16 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * progmodes/python.el (python-shell-calculate-command): + Rename from python-shell-parse-command. Cleanup. + (run-python, run-python-internal): Use it. + (python-shell-calculate-pythonpath): Rename from + python-new-pythonpath. + (python-shell-calculate-process-environment): Use it. + (python-shell-calculate-exec-path): Add comment. + +2014-11-16 Thierry Banel <tbanelwebmin@free.fr> (tiny change) + + * calc/calc-arith.el (math-max-list, math-min-list): Fix bug + for date handling. + +2014-11-16 Andreas Schwab <schwab@linux-m68k.org> * version.el (emacs-repository-get-version): Use git rev-parse instead of git log. -2014-11-15 Fabián Ezequiel Gallina <fgallina@gnu.org> +2014-11-16 Fabián Ezequiel Gallina <fgallina@gnu.org> * progmodes/python.el (python-indent-calculate-levels): Fix indentation behavior multiline dedenter statement. (Bug#18432) -2014-11-15 Fabián Ezequiel Gallina <fgallina@gnu.org> +2014-11-16 Fabián Ezequiel Gallina <fgallina@gnu.org> * progmodes/python.el (python-indent-region): Use python-indent-line and skip special cases. (Bug#18843) -2014-11-15 Michael Albinus <michael.albinus@gmx.de> - - * vc/vc-hg.el (vc-hg-state): Disable pager. (Bug#18940) - -2014-11-15 Peder O. Klingenberg <peder@klingenberg.no> +2014-11-16 Peder O. Klingenberg <peder@klingenberg.no> * mail/emacsbug.el (report-emacs-bug): Make a better guess at envelope-from when reporting through sendmail (bug#19054). +2014-11-16 Oscar Fuentes <ofv@wanadoo.es> + + Add faces for the VC modeline state indicator. + * vc/vc-hooks.el: + (vc-state-faces, vc-state-base-face) + (vc-up-to-date-state, vc-needs-update-state) + (vc-locked-state, vc-locally-added-state) + (vc-conflict-state, vc-removed-state) + (vc-missing-state, vc-edited-state): + New faces. + (vc-default-mode-line-string): Use them + +2014-11-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/backquote.el (backquote-process): Optimize away ",'". + +2014-11-15 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww-search-words): Mention `eww-search-prefix'. + +2014-11-15 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * progmodes/python.el (python-eldoc-setup-code): Enhance string + type checks, simplify printing. (Bug#18962) + 2014-11-14 Ivan Andrus <darthandrus@gmail.com> - * progmodes/python.el (python-ffap-module-path): + * progmodes/python.el (python-shell-font-lock-kill-buffer): + (python-shell-font-lock-with-font-lock-buffer) + (python-shell-get-buffer, python-ffap-module-path): Use `derived-mode-p' instead of equality test on `major-mode'. +2014-11-14 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * progmodes/python.el (python-shell-virtualenv-root): Rename from + python-shell-virtualenv-path. + (python-shell-internal-get-process-name) + (python-shell-calculate-process-environment) + (python-shell-calculate-exec-path): Use it. + +2014-11-14 Eli Zaretskii <eliz@gnu.org> + + * bindings.el (search-map): Fix last change: don't use 'kbd' in + bindings.el, since it is not yet loaded when bindings.el is + preloaded. + +2014-11-14 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * progmodes/python.el (python-shell-completion-get-completions): + Fix previous merge. + +2014-11-14 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww-render): Don't set the title to the URL. + 2014-11-13 Ulrich Müller <ulm@gentoo.org> * version.el (emacs-repository-get-version): Call `git log' command with proper format argument (bug#19049). +2014-11-14 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * bindings.el (search-map): Bind M-s M-s to `eww-search-words'. + +2014-11-14 Kenjiro NAKAYAMA <nakayamakenjiro@gmail.com> + + * net/eww.el (eww-search-words): New command (bug#16258). + +2014-11-13 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/shr.el (shr-inhibit-images): Add a doc string. + + * net/eww.el (eww-after-render-hook): New variable. + (eww-render): Use it. + + * net/shr.el (shr-descend): Don't descend further than + `max-specpdl-size' allows (bug#16587). + (shr-depth): New variable. + (shr-warning): New variable. + +2014-11-13 Ivan Shmakov <ivan@siamics.net> + + * net/shr.el (shr-parse-base): Handle <base href=""> correctly. + (shr-expand-url): Expand absolute URLs correctly (bug#17958). + +2014-11-13 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww): Add comment to clarify. + + * net/shr.el (shr-parse-image-data): Remove blocked bits from + external SVG images. + (shr-tag-object): Display images in <object> forms (bug#16244). + (shr-tag-table): Also insert <objects> after the tables. + +2014-11-13 Michael Albinus <michael.albinus@gmx.de> + + * vc/vc-hg.el (vc-hg-state): Disable pager. (Bug#18940) + +2014-11-13 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww-form-file): Fix version number. + +2014-11-10 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww-form-file): :type isn't a valid `defface' keyword. + +2014-11-10 Kenjiro NAKAYAMA <nakayamakenjiro@gmail.com> + + * net/eww.el(eww-form-file(defface)): New defface of file upload form. + (eww-submit-file): New key map of file upload. + (eww-form-file): New file upload button and file name context. + (eww-select-file): Select file and display selected file name. + (eww-tag-input): Handle input tag of file type. + (eww-update-field): Add point offset. + (eww-submit): Add submit with multipart/form-data. + +2014-11-10 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww-render, eww-display-html, eww-setup-buffer): + Allow taking a buffer to render data in. This allows using several + eww buffers (bug#16211). + +2014-11-10 Charles Rendleman <carendle@gmail.com> (tiny change) + + * net/eww.el (eww-download-callback): Save only the file contents, + not the headers. + +2014-11-10 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww-data): New plist to store all the data relevant + to a single page, used throughout the file instead of the + variables `eww-current-url', `eww-current-dom', + `eww-current-source', and `eww-current-title'. + (eww-readable): Copy over pertinent data from the parent page. + (eww-save-history): Don't let the history grow infinitely. + + * net/eww.el: Remove `eww-next-url', `eww-previous-url', + `eww-up-url', `eww-home-url', `eww-start-url' and + `eww-contents-url' and put the data into the `eww-data' plist. + This allow restoring these values after going back in the history. + +2014-11-10 Sylvain Chouleur <sylvain.chouleur@gmail.com> (tiny change) + + Allow VTIMEZONE where daylight and standard time zones are equal. + See: http://lists.gnu.org/archive/html/emacs-devel/2014-11/msg00494.html + * calendar/icalendar.el (icalendar--convert-tz-offset): + Support timezone without daylight saving time. + 2014-11-10 Glenn Morris <rgm@gnu.org> * startup.el (command-line): Handle nil elements in load-path. +2014-11-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * help.el (view-lossage): Include the actual commands run. + +2014-11-10 Dmitry Gutov <dgutov@yandex.ru> + + * vc/vc-dir.el (vc-dir-hide-state): Also hide `ignored' items when + no state is specified. (Bug#18964) + +2014-11-09 Eric Ludlam <zappo@gnu.org> + + * emacs-lisp/eieio-custom.el (eieio-customize-object): + Set eieio-cog (current group) to g, which is an improved form of input + group. + +2014-11-09 Juri Linkov <juri@jurta.org> + + * isearch.el (isearch-message-prefix): Show "Multi-file" and + "Multi-buffer" instead of "Multi". (Bug#13592) + + * misearch.el (multi-isearch-file-list): + Autoload multi-isearch-buffer-list and multi-isearch-file-list. + (multi-isearch-end): Reset multi-isearch-buffer-list and + multi-isearch-file-list to nil. + +2014-11-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): + Don't call byte-compile-preprocess since the result will go through + cconv. + (byte-compile-output-docform): Handle uninterned `name' correctly. + * emacs-lisp/cl-macs.el (cl-define-compiler-macro): Use interned name + to circumvent byte-compiler bug. + + * emacs-lisp/macroexp.el (macroexp--expand-all): Fix typo. + (macroexp--compiler-macro): Remove left-over debug code. + + * emacs-lisp/cl-extra.el (cl-get): Silence compiler warning. + +2014-11-08 Juri Linkov <juri@jurta.org> + + * simple.el (shell-command): Use buffer-name when output-buffer is + a buffer. (Bug#18096) + +2014-11-08 Juri Linkov <juri@jurta.org> + + * minibuffer.el (minibuffer-completion-help): Compare this-command + with completion-at-point. (Bug#17809) + 2014-11-08 Glenn Morris <rgm@gnu.org> * emacs-lisp/bytecomp.el (byte-compile-report-error): Allow the argument to be a string. Due to the vague doc, it was already being used this way. -2014-11-07 Michael Albinus <michael.albinus@gmx.de> +2014-11-08 Michael Albinus <michael.albinus@gmx.de> * net/tramp.el (tramp-check-cached-permissions): Include hop in the constructed Tramp file name. (Bug#18943) -2014-11-07 Stefan Monnier <monnier@iro.umontreal.ca> +2014-11-08 Stefan Monnier <monnier@iro.umontreal.ca> * emulation/cua-base.el (cua--select-keymaps): Use region-active-p (bug#18952). - (cua-set-mark, cua--pre-command-handler-1,cua--post-command-handler-1): + (cua-set-mark, cua--post-command-handler-1): * emulation/cua-gmrk.el (cua-cancel-global-mark): Same. -2014-11-07 Michael Albinus <michael.albinus@gmx.de> +2014-11-08 Michael Albinus <michael.albinus@gmx.de> * files.el (file-name-non-special): Wrap the call of `insert-file-contents' by `unwind-protect', in order to set the buffer's file name anyway. (Bug#18891) -2014-11-07 Daiki Ueno <ueno@gnu.org> - - * epg.el (epg--list-keys-1): Ignore fields after the 15th field - (bug#18979). Reported by Hideki Saito. - -2014-10-18 Alan Mackenzie <acm@muc.de> - - Check that a "macro" found near point-min isn't a ## operator. - Fixes bug #18749. Backported from trunk, 2014-11-05. - * progmodes/cc-engine.el (c-macro-is-genuine-p): New function. - (c-beginning-of-macro): Use the above new function. - -2014-11-05 Alan Mackenzie <acm@muc.de> +2014-11-08 Alan Mackenzie <acm@muc.de> Fix wrong bound to c-font-lock-declarators. Fixes bug #18948. * progmodes/cc-fonts.el (c-font-lock-declarations): @@ -480,7 +3430,7 @@ the buffer is sometimes narrowed to less than "limit" (e.g., in the presence of macros). -2014-11-05 Michael Albinus <michael.albinus@gmx.de> +2014-11-08 Michael Albinus <michael.albinus@gmx.de> * net/tramp.el (tramp-error-with-buffer): Show connection buffer only when message appeared in minibuffer. (Bug#18891) @@ -490,180 +3440,292 @@ * net/tramp-sh.el (tramp-sh-handle-file-attributes): Return nil in case of errors. -2014-11-04 Eli Zaretskii <eliz@gnu.org> +2014-11-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): + Don't compile before eval in `eval-and-compile'. + (byte-compile-arglist-warn): Add check for defining macros after their + first use. Check call use even if the function is fboundp. + +2014-11-08 Richard Stallman <rms@gnu.org> + + * mail/rmail.el (rmail-epa-decrypt): Detect armor with line prefixes. + Check more carefully for mime-part specified character set. + Check for mime-part Content Transfer Encoding. + Notify if no armor found. + +2014-11-08 Martin Rudalics <rudalics@gmx.at> + + * faces.el (face-set-after-frame-default): Enable running + `window-configuration-change-hook'. + +2014-11-07 Juri Linkov <juri@jurta.org> + + * replace.el: History for query replace pairs. + (query-replace-defaults): Promote to a list of cons cell. Doc fix. + (query-replace-from-to-separator): New variable. + (query-replace-read-from): Let-bind query-replace-from-to-history + to a list of FROM-TO strings created from query-replace-defaults + and separated by query-replace-from-to-separator. Use it as + the history while reading from the minibuffer. Split the returned + string by the separator to get FROM and TO parts, and add them + to the history variables. + (query-replace-read-to): Add FROM-TO pairs to query-replace-defaults. + (query-replace-regexp-eval): Let-bind query-replace-defaults to nil. + http://lists.gnu.org/archive/html/emacs-devel/2014-11/msg00253.html + + * isearch.el (isearch-text-char-description): Keep characters + intact and put formatted strings with the `display' property. + +2014-11-07 Martin Rudalics <rudalics@gmx.at> + + * cus-start.el (frame-resize-pixelwise): Fix group. + (frame-inhibit-implied-resize): Add entry. + +2014-11-07 Daiki Ueno <ueno@gnu.org> + + * epa.el (epa-pinentry-mode): New user option. + (epa-sign-file, epa-encrypt-file, epa-decrypt-region) + (epa-sign-region, epa-encrypt-region): Respect epa-pinentry-mode. + * epa-file.el (epa-file-insert-file-contents) + (epa-file-write-region): Respect epa-pinentry-mode. + +2014-11-07 Daiki Ueno <ueno@gnu.org> + + * epg.el (epg--list-keys-1): Ignore fields after the 15th field + (bug#18979). Reported by Hideki Saito. + +2014-11-06 Daiki Ueno <ueno@gnu.org> + + * emacs-lisp/package.el (package--display-verify-error): New function. + (package--check-signature): Use it to display output sent to stderr. + +2014-11-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (pop): Don't call the getter twice (bug#18968). + + * emacs-lisp/macroexp.el (macroexp--expand-all): Optimize away trivial + uses of `funcall'. + +2014-11-06 Daiki Ueno <ueno@gnu.org> + + * epa.el (epa-error-buffer): New variable. + (epa-display-error): New function. + (epa-decrypt-file, epa-verify-file, epa-verify-region) + (epa-delete-keys, epa-import-keys): Display output sent to stderr. + (epa-sign-file, epa-sign-region, epa-encrypt-region) + (epa-export-keys, epa-insert-keys): Display output sent to stderr. + Use setf instead of epg-context-set-*. + * epa-file.el (epa-file-insert-file-contents): + Use epa-display-error instead of epa-display-info. Mimic the behavior + of jka-compr when decryption program is not found. + (epa-file-write-region): Use epa-display-error instead of + epa-display-info. + +2014-11-05 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc/vc.el (vc-region-history): New command. + (vc-print-log-internal): Use cl-some. + + * vc/vc-git.el (vc-git-region-history): New function. + (vc-git-region-history-mode-map) + (vc-git--log-view-long-font-lock-keywords) + (vc-git-region-history-font-lock-keywords): New vars. + (vc-git-region-history-font-lock): New function. + (vc-git-region-history-mode): New major mode. + +2014-11-05 Tassilo Horn <tsdh@gnu.org> + + * net/eww.el (subr-x): Require subr-x at compile-time because eww + uses string-trim. + +2014-11-05 Daiki Ueno <ueno@gnu.org> + + * epg.el (epg-context): Add new slot ERROR-OUTPUT. + (epg-error-output): New buffer-local variable. + (epg--start): Initialize epg-error-output. + (epg--process-filter): Record output lines sent to stderr, in + epg-error-output. + (epg-wait-for-completion): Copy epg-error-output to ERROR-OUTPUT + slot of context. + * epa-file.el (epa-file-insert-file-contents): On error, display + output sent to stderr. + (epa-file-write-region): Likewise. + +2014-11-05 Eli Zaretskii <eliz@gnu.org> * jit-lock.el (jit-lock-stealth-fontify): Be tolerant to nil being returned by load-average. -2014-11-04 Michael Albinus <michael.albinus@gmx.de> +2014-11-05 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-do-copy-or-rename-file-via-buffer): Don't use a local copy; setting `inhibit-file-name-handlers' proper might be more performant. (Bug#18751) -2014-11-04 Glenn Morris <rgm@gnu.org> +2014-11-05 Glenn Morris <rgm@gnu.org> * mail/emacsbug.el (report-emacs-bug): No longer include recent-keys in the report. (Bug#18900) +2014-11-04 Paul Eggert <eggert@cs.ucla.edu> + + * mouse.el (mouse-drag-line): Fix misspelling of "right-fringe". + +2014-11-04 Teodor Zlatanov <tzz@lifelogs.com> + + * net/eww.el (eww): Trim URL with `string-trim'. + Suggested by Vibhav Pant <vibhavp@gmail.com>. + +2014-11-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/eww.el (eww-score-readability): Don't count comments positively. + + * net/shr.el (shr-retransform-dom): Typo fix. + + * net/eww.el (eww-score-readability): Parse SVC images correctly. + (eww-display-html): Don't leave point inside forms. + + * net/shr.el: Ditto. + +2014-11-03 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/edebug.el (edebug-safe-prin1-to-string): Assume that + edebug-prin1-to-string already handles circularity. + + * emacs-lisp/byte-run.el (defun-declarations-alist): Fix compiler-macro + autoloading when specified as a lambda. + + * simple.el (execute-extended-command--last-typed): New var. + (read-extended-command): Set it. + Don't complete obsolete commands. + (execute-extended-command--shorter-1) + (execute-extended-command--shorter): New functions. + (execute-extended-command): Use them to suggest shorter names. + (indicate-copied-region, deactivate-mark): Use region-active-p. + 2014-11-03 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-do-copy-or-rename-file-via-buffer): Use a local copy of FILENAME, when it is remote. (Bug#18751) -2014-11-02 Michael Albinus <michael.albinus@gmx.de> - * net/tramp-adb.el (tramp-adb-handle-process-file): Do not raise an error when the command fails; the return code must indicate. (tramp-adb-send-command-and-check): Fix docstring. -2014-11-01 Michael Albinus <michael.albinus@gmx.de> +2014-11-03 Lars Magne Ingebrigtsen <larsi@gnus.org> - * net/tramp-cache.el (tramp-get-file-property) - (tramp-set-file-property): Check, that `tramp-cache-get-count-*' - and `tramp-cache-set-count-*' are bound. Otherwise, there might - be compiler warnings. + * net/shr.el (shr-retransform-dom): Don't ignore elements that + have no children like <br />. - * net/tramp-sh.el (tramp-get-remote-uid, tramp-get-remote-gid): - Return -1 respective "UNKNOWN", if uid or gid cannot be determined. + * net/eww.el (eww-display-html): Clear `url-queue'. + (eww-display-pdf): New function. + (eww-render): Display PDFs with `doc-view'. + (url-queue): Require `url-queue' to avoid compilation warning. + (eww-colorize-region): Remove duplicate function. + (eww-tag-body): Use `shr-colorize-region'. -2014-11-01 Eli Zaretskii <eliz@gnu.org> +2014-11-03 Yoni Rabkin <yrk@gnu.org> - * progmodes/compile.el (compilation-mode): Turn off deferred - fontifications locally. (Bug#18856) + * net/eww.el (eww-list-bookmarks): Autoload. -2014-11-01 Wolfgang Jenkner <wjenkner@inode.at> +2014-11-03 Lars Magne Ingebrigtsen <larsi@gnus.org> - * net/tramp-sh.el (tramp-send-command): Fix the case where the - remote-echo connection property is non-nil (bug#18858). + * net/shr.el (shr-retransform-dom): Allow several text sub-nodes. -2014-11-01 Michael Albinus <michael.albinus@gmx.de> + * net/eww.el (eww-display-html): The charset is called `utf-8', + not `utf8'. + (eww-readable): Decode the saved text correctly. + (eww-readable): Save the history before displaying so that we can + go back to the non-readable version. + (eww-display-html): Don't try to decode the text if we've been + passed in a pre-parsed DOM. + (eww-tag-title): Remove newlines and extra whitespace from the + displayed title. - Backport Tramp changes from trunk. +2014-11-02 Lars Magne Ingebrigtsen <larsi@gnus.org> - * net/tramp.el (tramp-methods): Tweak docstring. - (tramp-file-name-handler): Apply `cons' where appropriate. - (tramp-handle-file-accessible-directory-p): Check for - `file-readable-p' instead of `file-executable-p'. - (tramp-handle-shell-command): Use `display-buffer'. (Bug#18326) - (tramp-handle-unhandled-file-name-directory): Return "/". - (tramp-check-cached-permissions): - Use `tramp-compat-file-attributes'. - (tramp-call-process): Add new argument VEC. Adapt callees in all - tramp*.el files. + * net/eww.el (eww-readable): New command and keystroke. - * net/tramp-adb.el (tramp-adb-sh-fix-ls-output): Use `bolp'. - (tramp-adb-handle-write-region): Improve messages. - (tramp-adb-maybe-open-connection): Don't set - `tramp-current-*' variables. + * net/shr.el (shr-retransform-dom): New function. - * net/tramp-cache.el (tramp-flush-file-function): Simplify check. - Suppress debug messages. + * net/eww.el (eww-display-html): Set `eww-current-source' in the + correct buffer. + (eww-view-source): Use it. - * net/tramp-ftp.el (top): Remove special handling for URL syntax. - (tramp-ftp-file-name-handler): +2014-11-02 Ivan Shmakov <ivan@siamics.net> - * net/tramp-gvfs.el (tramp-gvfs-methods) <sftp>: Add. - (tramp-gvfs-methods-mounttracker) - (tramp-gvfs-mountlocation-signature): Check `tramp-gvfs-enabled' - during initialization. (Bug#18774) - (tramp-gvfs-handle-delete-file): Flush file properties, not - directory properties. - (tramp-gvfs-handle-file-attributes): Use `string-to-number' when - reading "unix::mode". - (tramp-gvfs-handle-file-name-all-completions): - Use "-h" option for "gvfs-ls". - (tramp-gvfs-url-file-name): Apply `cons' where appropriate. - `user' and `localname' could be nil. - (tramp-gvfs-send-command): Simplify traces. + * net/eww.el (eww): Recognize colon-delimited IPv6 addresses. + (Bug#18603). - * net/tramp-sh.el (vc-handled-backends, vc-bzr-program) - (vc-git-program, vc-hg-program): Declare. - (tramp-methods) <sftp>: Remove. It has never worked satisfactorily. - (tramp-methods) <nc>: Add new method. - (tramp-methods) <telnet>: Redirect stderr to "/dev/null". - (tramp-methods) <plink, plinkx, pscp, psftp>: Improve - `tramp-login-args'. - (tramp-default-user-alist): Add "nc". - (top): Remove completion function for "sftp". Add completion - functions for "nc" and "psftp". - (tramp-sh-handle-set-visited-file-modtime): - (tramp-sh-handle-verify-visited-file-modtime): Use `point-at-eol'. - (tramp-do-copy-or-rename-file-out-of-band): - Use cached "remote-copy-args" value, if available. (Bug#18199) - Tweak docstring. Implement support for "nc" method. - (tramp-sh-handle-expand-file-name, tramp-local-coding-commands) - (tramp-remote-coding-commands, tramp-call-local-coding-command): - Tweak docstring. - (tramp-sh-handle-start-file-process): Expand `default-directory'. - (tramp-sh-handle-write-region): Tweak error message. - (tramp-sh-handle-vc-registered): Remove backends when the remote - binary does not exist. - (tramp-open-connection-setup-interactive-shell): - Prefer utf-8 coding. (Bug#17859) - (tramp-find-inline-encoding): Do not raise an error. - (tramp-make-copy-program-file-name): Tweak docstring. Handle also - the "nc" case. Quote result also locally. - (tramp-get-remote-id): Check also for "gid". - (tramp-get-remote-python): +2014-11-02 Brian McKenna <brian@brianmckenna.org> (tiny change) - * net/tramp-smb.el (tramp-smb-handle-copy-directory) - (tramp-smb-handle-set-file-acl): Use `start-process'. - (tramp-smb-handle-insert-directory): Use progress reporter. - (tramp-smb-handle-rename-file): Flush also file properties of - FILENAME. + * net/eww.el (eww-submit): Encode empty form values as "". (Bug#17785). - * net/trampver.el: Update release number. +2014-11-02 Ivan Shmakov <ivan@siamics.net> -2014-11-01 Reuben Thomas <rrt@sc3d.org> + * net/eww.el (eww): Allow "file:/file/name" URLs. (Bug#18825). - * net/tramp.el (tramp-handle-file-symlink-p): - * net/tramp-ftp.el (tramp-ftp-file-name-handler): Remove a comment - about VMS, which we no longer support. +2014-11-02 Ivan Shmakov <ivan@siamics.net> -2014-11-01 Stefan Monnier <monnier@iro.umontreal.ca> + * net/eww.el (eww-mode-map): Remove mentions of `eww-quit'. + (Bug#18834). - * net/tramp-sh.el (tramp-sh-handle-vc-registered): Don't modify - the global vc-handled-backends (bug#18535). +2014-11-02 Eric Abrahamsen <eric@ericabrahamsen.net> -2014-11-01 Jérémy Compostella <jeremy.compostella@intel.com> - Michael Albinus <michael.albinus@gmx.de> + * emacs-lisp/eieio.el (eieio-edebug-prin1-to-string): Adjust for + use as advice. + (edebug-setup-hook): Advise `edebug-prin1-to-string'. (Bug#18897) - * net/tramp-sh.el (tramp-open-connection-setup-interactive-shell): - Reduce the amount of set environment variable commands. +2014-11-02 Stefan Monnier <monnier@iro.umontreal.ca> -2014-11-01 Paul Eggert <eggert@cs.ucla.edu> + * emacs-lisp/pp.el (pp-macroexpand-expression): Use macroexpand-1 + (bug#18821). + * progmodes/elisp-mode.el (emacs-lisp-macroexpand): Idem. - * net/tramp-sh.el (tramp-get-remote-touch): Omit unnecessary call to - current-time. +2014-11-01 Michael R. Mauger <michael@mauger.com> -2014-11-01 Emilio C. Lopes <eclig@gmx.net> + * sql.el (sql-mode-oracle-font-lock-keywords): Correct regexp + syntax, add new keywords, and parse longer keywords first. + (sql-redirect-one): Protect against empty command. + (sql-mode, sql-interactive-mode): Set `custom-mode-group' property + to SQL. (Bug#14759) - * net/tramp-sh.el (tramp-get-remote-python): Also search for - executables named "python2" or "python3". - (tramp-get-remote-uid-with-python): Use parentheses around - arguments to `print' to make it compatible with Python 3. - (tramp-get-remote-gid-with-python): Ditto. (Bug#18118) +2014-11-01 Michael R. Mauger <michael@mauger.com> -2014-10-31 Stefan Monnier <monnier@iro.umontreal.ca> + * sql.el (sql-interactive-mode, sql-stop): Correct fix for + Bug#16814 with let-bind of comint-input-ring variables around read + and save functions. - * simple.el (newline): Add assertions to try and help catch bug#18913. +2014-11-01 Michael Albinus <michael.albinus@gmx.de> - * emulation/cua-base.el (cua-delete-region): Use delete-active-region - (bug#18886). - (cua--last-deleted-region-pos, cua--last-deleted-region-text): Remove. + * net/tramp-cache.el (tramp-get-file-property) + (tramp-set-file-property): Check that `tramp-cache-get-count-*' + and `tramp-cache-set-count-*' are bound. Otherwise, there might + be compiler warnings. -2014-10-31 Eli Zaretskii <eliz@gnu.org> + * net/tramp-sh.el (tramp-get-remote-uid, tramp-get-remote-gid): + Return -1 respective "UNKNOWN", if uid or gid cannot be determined. - * Makefile.in (repo-update): Fix a typo and slightly reword - commentary. +2014-11-01 Eli Zaretskii <eliz@gnu.org> -2014-10-31 Eric S. Raymond <esr@thyrsus.com> + * progmodes/compile.el (compilation-mode): Turn off deferred + fontifications locally. (Bug#18856) - * Makefile.in: Change some production names so they're neutral - about the repository type. +2014-11-01 Wolfgang Jenkner <wjenkner@inode.at> + + * net/tramp-sh.el (tramp-send-command): Fix the case where the + remote-echo connection property is non-nil (bug#18858). -2014-10-30 Kim F. Storm <storm@cua.dk> +2014-11-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * simple.el (newline): Add assertions to try and help catch bug#18913. + + * emulation/cua-base.el (cua-delete-region): Use delete-active-region + (bug#18886). + (cua--last-deleted-region-pos, cua--last-deleted-region-text): Remove. + +2014-11-01 Kim F. Storm <storm@cua.dk> Restore cua-delete-copy-to-register-0 and M-v command (bug#18886). * delsel.el (delete-selection-save-to-register) @@ -676,96 +3738,408 @@ (cua--init-keymaps): Update binding accordingly. (cua-mode): Set delete-selection-save-to-register. +2014-11-01 Alan Mackenzie <acm@muc.de> + + Make blink-parens work with a closing template delimiter. + * progmodes/cc-cmds.el (c-electric-lt-gt): Cause a redisplay + before calling blink-paren-function, so as to apply syntax-table + properties to the ">". + +2014-11-01 Jan Djärv <jan.h.d@swipnet.se> + + * select.el (gui-get-selection): Comment: data-type ignored on NS. + +2014-10-31 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/macroexp.el (macroexpand-1): New function (bug#18821). + (macroexp--expand-all): Unrelated tweaks. + + * emacs-lisp/gv.el (gv-get): Use macroexpand-1. + +2014-10-30 Glenn Morris <rgm@gnu.org> + + * startup.el (command-line): Remove pointless attempt to avoid + statting the file-system (which expand-file-name doesn't do). + +2014-10-30 Daniel Colascione <dancol@dancol.org> + + Add "enum class" support to C++ mode. + * progmodes/cc-langs.el (c-after-brace-list-decl-kwds) + (c-after-brace-list-key): New language consts/variables. + * progmodes/cc-engine.el (c-looking-at-decl-block): + Exclude spurious match of "enum struct" from decl-block recognition. + (c-backward-colon-prefixed-type): New function. + (c-backward-over-enum-header): Call above function to extend + recognition of enum structure. + 2014-10-30 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/cc-defs.el (c--macroexpand-all): New function (bug#18845). (c-lang-defconst): * progmodes/cc-langs.el (c-make-init-lang-vars-fun): Use it. -2014-10-29 Eli Zaretskii <eliz@gnu.org> +2014-10-30 Eli Zaretskii <eliz@gnu.org> * progmodes/compile.el (compilation-start): If compilation-scroll-output is non-nil, don't force window-start of the compilation buffer to be at beginning of buffer. (Bug#18874) -2014-10-23 Tassilo Horn <tsdh@gnu.org> - - * doc-view.el (doc-view-open-text): View the document's plain text - in the current buffer instead of a new one. - (doc-view-toggle-display): Handle the case where the current - buffer contains the plain text contents of the document. - (doc-view-initiate-display): Don't switch to fallback mode if the - user wants to view the doc's plain text. [Backport] - -2014-10-23 Eli Zaretskii <eliz@gnu.org> - * startup.el (fancy-about-text): Read the entire tutorial, not just its first 256 bytes. (Bug#18760) -2014-10-23 Stefan Monnier <monnier@iro.umontreal.ca> +2014-10-30 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/bytecomp.el: Require cl-extra (bug#18804). * emacs-lisp/cl-extra.el: Add missing provide. -2014-10-22 Stefan Monnier <monnier@iro.umontreal.ca> - * emacs-lisp/bytecomp.el (byte-compile-and-folded): Optimize case where all args are copyable (bug#18767). (=, <, >, <=, >=): Re-enable the optimization. -2014-10-20 Santiago Payà i Miralta <santiagopim@gmail.com> +2014-10-29 Glenn Morris <rgm@gnu.org> + + * net/rcirc.el (rcirc-fill-column): Unbump :version. Mark :risky. + + * version.el (emacs-bzr-version, emacs-bzr-get-version): + Revert 2014-10-26 change. + +2014-10-29 Paul Eggert <eggert@cs.ucla.edu> + + Simplify use of current-time and friends. + * allout-widgets.el (allout-widgets-hook-error-handler): + * calendar/appt.el (appt-display-message): + * calendar/icalendar.el (icalendar--convert-float-to-ical): + * calendar/timeclock.el (timeclock-in, timeclock-when-to-leave) + (timeclock-last-period, timeclock-day-base): + * eshell/em-ls.el (eshell-ls-file): + * eshell/esh-util.el (eshell-parse-ange-ls): + * generic-x.el (named-database-print-serial): + * net/newst-backend.el (newsticker--get-news-by-url-callback) + (newsticker-get-news, newsticker--sentinel-work) + (newsticker--image-get, newsticker--image-sentinel): + * net/tramp-sh.el (tramp-get-remote-touch): + * progmodes/opascal.el (opascal-debug-log): + * textmodes/remember.el (remember-mail-date) + (remember-store-in-files): + * vc/vc-annotate.el (vc-annotate-display-autoscale) + (vc-default-annotate-current-time): + * vc/vc-bzr.el (vc-bzr-shelve-snapshot): + * vc/vc-cvs.el (vc-cvs-annotate-current-time): + * vc/vc-rcs.el (vc-rcs-annotate-current-time): + Omit unnecessary call to current-time. + * calendar/time-date.el (time-to-seconds) [!float-time]: + * vc/vc-annotate.el (vc-annotate-convert-time): + Use current time if arg is nil, to be compatible with float-time. + (time-date--day-in-year): New function, with most of the guts of + the old time-to-day-in-year. + (time-to-day-in-year): Use it. + (time-to-days): Use it, to avoid decoding the same time stamp twice. + * calendar/timeclock.el (timeclock-time-to-date): + Arg is now optional, like current-time-string. + (timeclock-update-mode-line): + Don't call current-time twice to get the current time stamp, + as this can lead to inconsistent results. + * completion.el (cmpl-hours-since-origin): + * ido.el (ido-time-stamp): + * vc/vc-annotate.el (vc-annotate-convert-time): + Simplify by using float-time. + * completion.el (save-completions-to-file): + Rename local var to avoid confusion. + * net/rcirc.el (rcirc-float-time): Simplify to an alias because + time-to-seconds now behaves like float-time with respect to nil arg. + * subr.el (progress-reporter-do-update): + Don't call float-time unless needed. + +2014-10-29 Leo Liu <sdl.web@gmail.com> + + * net/rcirc.el (rcirc-fill-column): Use function. + (rcirc-markup-fill): Remove adjustment. + +2014-10-28 Christopher Schmidt <ch@ristopher.com> + + * calc/calc.el (quick-calc): + * calc/calc-aent.el (calc-do-quick-calc): New argument INSERT. + +2014-10-28 Sam Steingold <sds@gnu.org> + + * net/rcirc.el (rcirc-fill-column): Allow any symbolic value for + the sake of `window-body-width' (in addition to `frame-width'). + +2014-10-26 Eric S. Raymond <esr@thyrsus.com> + + * version.el: Fix some fallback values to conform to the actual + release number. + +2014-10-25 Eric S. Raymond <esr@thyrsus.com> - * vc/vc-hg.el (vc-hg-log-graph): New var. - (vc-hg-print-log): Use it. - (vc-hg-root-log-format): Include branch name and bookmarks; ignore - graph output (bug#17515). + * Makefile.in: Change some production names so they're neutral + about the repository type. -2014-10-20 Juri Linkov <juri@jurta.org> +2014-10-25 Michael Albinus <michael.albinus@gmx.de> - * vc/diff-mode.el (diff-refine-changed): Rename from - `diff-refine-change' for consistency with `diff-changed'. - (diff-refine-change): Add obsolete face alias. (Bug#10181) + * net/tramp-gvfs.el (tramp-gvfs-methods-mounttracker) + (tramp-gvfs-mountlocation-signature): Check `tramp-gvfs-enabled' + during initialization. (Bug#18774) - * vc/smerge-mode.el (smerge-refined-changed): Rename from - `smerge-refined-change'. - (smerge-refined-change): Add obsolete face alias. +2014-10-25 Vincent Belaïche <vincentb1@users.sourceforge.net> -2014-10-20 Stefan Monnier <monnier@iro.umontreal.ca> + * ses.el (macroexp): Add require for this package, so that + function `ses--cell' gets macroexp-quote --- this change was + supposed to be in my previous commit, but left out by mistake. + (ses--cell): Do not make formula a macroexp-quote of value when + value, not formula, is *skip*. - * subr.el (call-process-shell-command, process-file-shell-command): - Make the `args' obsolete (bug#18409). - (start-process-shell-command, start-file-process-shell-command): - Use `declare'. +2014-10-24 Vincent Belaïche <vincentb1@users.sourceforge.net> -2014-10-20 Juanma Barranquero <lekktu@gmail.com> + * ses.el (macroexp): Add require for this package, so that function + `ses--cell gets macroexp-quote. + (ses--cell): Makes formula a macroexp-quote of value when formula + is nil. The rationale of this changr is to allow in the future + shorter SES files, e.g. we could have only `(ses-cell A1 1.0)' + instead of `(ses-cell A1 1.0 1.0 nil REFLIST)'. In such a case + reference list REFLIST would be re-computed after load --- thus + trading off load time against file size. - * skeleton.el (skeleton-autowrap): Mark as obsolete. Doc fix. + * emacs-lisp/package.el (package--alist-to-plist-args): + Use macroexp-quote instead of a lambda expression which has the same + content as macroexp-quote. + (macroexp): Add require for this package, so that function + `package--alist-to-plist-args' gets macroexp-quote. -2014-10-20 Glenn Morris <rgm@gnu.org> + * emacs-lisp/macroexp.el (macroexp-quote): New defun. - * dired.el (dired-read-regexp): Make obsolete. - (dired-mark-files-regexp, dired-mark-files-containing-regexp) - (dired-flag-files-regexp): - * dired-aux.el (dired-mark-read-regexp): - * dired-x.el (dired-mark-unmarked-files): Use read-regexp directly. +2014-10-24 Stefan Monnier <monnier@iro.umontreal.ca> -2014-10-20 Stefan Monnier <monnier@iro.umontreal.ca> + * term/ns-win.el (ns-store-cut-buffer-internal) + (ns-copy-including-secondary): Use gui-set-selection (bug#18816). - * progmodes/python.el (inferior-python-mode): Use add-hook. +2014-10-24 Martin Rudalics <rudalics@gmx.at> - * Makefile.in (AUTOGEN_VCS): Remove emulation/tpu-edt.el. + * mouse.el (mouse-drag-line): Don't use mouse-pixel-position. + Calculate increment from last position instead of window edge. + Add right- and bottom-divider bindings to transient map. -2014-10-20 Glenn Morris <rgm@gnu.org> +2014-10-23 Stefan Monnier <monnier@iro.umontreal.ca> - * emulation/crisp.el, emulation/tpu-edt.el, emulation/tpu-extras.el: - * emulation/tpu-mapper.el, emulation/vi.el, emulation/vip.el: - * emulation/ws-mode.el: Move to obsolete/. [Backport] + * emacs-lisp/cl-macs.el (cl-defstruct): Define an internal predicate + even if :predicate was nil, for the benefit of typep. + Record the name of the predicate for typep's use. + (cl--make-type-test): Use pcase. Obey new + cl-deftype-satisfies property. + + * epg.el: Use cl-defstruct. + (epg-make-data-from-file, epg-make-data-from-string, epg-data-file) + (epg-data-string): Define via cl-defstruct. + (epg--gv-nreverse): New macro. + (epg-context--make): New constructor (provided vi cl-defstruct). + (epg-make-context): Rewrite using it. + (epg-context-protocol, epg-context-program) + (epg-context-home-directory, epg-context-armor, epg-context-textmode) + (epg-context-include-certs, epg-context-cipher-algorithm) + (epg-context-digest-algorithm, epg-context-compress-algorithm) + (epg-context-passphrase-callback, epg-context-progress-callback) + (epg-context-signers, epg-context-sig-notations, epg-context-process) + (epg-context-output-file, epg-context-result, epg-context-operation) + (epg-context-pinentry-mode): Define using cl-defstruct. + (epg-context-set-protocol, epg-context-set-program) + (epg-context-set-include-certs, epg-context-set-cipher-algorithm) + (epg-context-set-digest-algorithm) + (epg-context-set-sig-notations, epg-context-set-process) + (epg-context-set-output-file, epg-context-set-result) + (epg-context-set-operation, epg-context-set-pinentry-mode) + (epg-context-set-compress-algorithm): Remove. Use setf instead. + (epg-context-set-armor, epg-context-set-textmode) + (epg-context-set-signers): Redefine using setf + and declare as obsolete. + (epg-context-set-passphrase-callback) + (epg-context-set-progress-callback): Use setf. + (epg-signature-notations): Rename from epg-sig-notations. + (epg-make-signature, epg-signature-status, epg-signature-key-id) + (epg-signature-validity, epg-signature-fingerprint) + (epg-signature-creation-time, epg-signature-expiration-time) + (epg-signature-pubkey-algorithm, epg-signature-digest-algorithm) + (epg-signature-class, epg-signature-version): Define vi cl-defstruct. + (epg-signature-set-status, epg-signature-set-key-id) + (epg-signature-set-validity, epg-signature-set-fingerprint) + (epg-signature-set-creation-time, epg-signature-set-expiration-time) + (epg-signature-set-pubkey-algorithm) + (epg-signature-set-digest-algorithm, epg-signature-set-class) + (epg-signature-set-version, epg-signature-set-notations): Remove. + Use setf instead. + (epg-make-new-signature, epg-new-signature-type) + (epg-new-signature-pubkey-algorithm) + (epg-new-signature-digest-algorithm, epg-new-signature-class) + (epg-new-signature-creation-time, epg-new-signature-fingerprint): + Define using cl-defstruct. + (epg-make-key, epg-key-owner-trust, epg-key-sub-key-list) + (epg-key-user-id-list): Define using cl-defstruct. + (epg-key-set-sub-key-list, epg-key-set-user-id-list): Remove. + Use setf instead. + (epg-make-sub-key, epg-sub-key-validity, epg-sub-key-capability) + (epg-sub-key-secret-p, epg-sub-key-algorithm, epg-sub-key-length) + (epg-sub-key-id, epg-sub-key-creation-time) + (epg-sub-key-expiration-time, epg-sub-key-fingerprint): Define using + cl-defstruct. + (epg-sub-key-set-fingerprint): Remove. Use setf instead. + (epg-make-user-id, epg-user-id-validity, epg-user-id-string) + (epg-user-id-signature-list): Define using cl-defstruct. + (epg-user-id-set-signature-list): Remove. Use setf instead. + (epg-make-key-signature, epg-key-signature-validity) + (epg-key-signature-pubkey-algorithm, epg-key-signature-key-id) + (epg-key-signature-creation-time, epg-key-signature-expiration-time) + (epg-key-signature-user-id, epg-key-signature-class) + (epg-key-signature-exportable-p): Define using cl-defstruct. + (epg-make-sig-notation, epg-sig-notation-name) + (epg-sig-notation-value, epg-sig-notation-human-readable) + (epg-sig-notation-critical): Define using cl-defstruct. + (epg-sig-notation-set-value): Remove. Use setf instead. + (epg-make-import-status, epg-import-status-fingerprint) + (epg-import-status-reason, epg-import-status-new) + (epg-import-status-user-id, epg-import-status-signature) + (epg-import-status-sub-key, epg-import-status-secret): Define using + cl-defstruct. + (epg-make-import-result, epg-import-result-considered) + (epg-import-result-no-user-id, epg-import-result-imported) + (epg-import-result-imported-rsa, epg-import-result-unchanged) + (epg-import-result-new-user-ids, epg-import-result-new-sub-keys) + (epg-import-result-new-signatures, epg-import-result-new-revocations) + (epg-import-result-secret-read, epg-import-result-secret-imported) + (epg-import-result-secret-unchanged, epg-import-result-not-imported) + (epg-import-result-imports): Define using cl-defstruct. + + * emacs-lisp/package.el: Require EPG during macroexpansion. + (package--check-signature, package-import-keyring): Use setf instead of + epg-context-set-home-directory. -2014-10-20 Glenn Morris <rgm@gnu.org> +2014-10-23 Stefan Monnier <monnier@iro.umontreal.ca> - * cus-start.el (history-length): Bump :version. [Backport] + * emacs-lisp/bytecomp.el (byte-compile--use-old-handlers): Change default. -2014-10-20 Stefan Monnier <monnier@iro.umontreal.ca> +2014-10-23 Leo Liu <sdl.web@gmail.com> + + * progmodes/cfengine.el (cfengine3-defun-full-re): New var. + (cfengine3-create-imenu-index): Use it and use ` ' for separation. + (cfengine3-current-defun): New function. + (cfengine3-mode): Set add-log-current-defun-function. + +2014-10-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * select.el: Use lexical-binding. + (gui-set-selection): Provide an implementation for non-GUI frames + (bug#18791). + * term/x-win.el: Use lexical-binding. + (x-clipboard-yank): Fix up missed renamings. + * term/w32-win.el (libgif-version, libjpeg-version): Silence compiler. + (w32--set-selection): Fix up var names. + * term/pc-win.el: Use lexical-binding. + (w16-selection-exists-p): Silence compiler warning. + (w16-selection-owner-p): Fix up missed renamings. + + * emacs-lisp/bytecomp.el (byte-compile-form): Remove left-over debug. + + * frame.el (frame-notice-user-settings): Fix excessive quoting. + +2014-10-22 Tassilo Horn <tsdh@gnu.org> + + * doc-view.el (doc-view-open-text): View the document's plain text + in the current buffer instead of a new one. + (doc-view-toggle-display): Handle the case where the current + buffer contains the plain text contents of the document. + (doc-view-initiate-display): Don't switch to fallback mode if the + user wants to view the doc's plain text. + (doc-view-set-doc-type): Use assoc-string instead of + assoc-ignore-case. + +2014-10-21 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (read-key): Fix clicks on the mode-line. + (set-transient-map): Return exit function. + + * mouse.el (mouse-drag-line): Use set-transient-map (bug#18015). + (mouse--down-1-maybe-follows-link): Remove unused var `this-event'. + (mouse-yank-secondary): Use gui-get-selection. + (mouse--down-1-maybe-follows-link): Use read-key. + + * xt-mouse.el: Add `event-kind' property on the fly from + xterm-mouse-translate-1 rather than statically at the outset. + +2014-10-21 Daniel Colascione <dancol@dancol.org> + + * vc/vc-dispatcher.el (vc-resynch-window): Tell view-mode not to + change window configuration when we turn it off. + +2014-10-21 Stefan Monnier <monnier@iro.umontreal.ca> + + Get rid of backend-dependent selection-handling functions for kill/yank + and make it generic instead by relying on the lower-level selection + management functions. + + * select.el (select-enable-clipboard): Rename from + gui-select-enable-clipboard. + (select-enable-primary): Move from x-win.el and rename from + x-select-enable-primary. + (gui-last-selected-text): Remove. + (gui--last-selected-text-clipboard, gui--last-selected-text-primary): + New vars. + (gui-select-text): Rewrite, based on x-win.el's old x-select-text. + (gui-select-text-alist, gui-selection-value-alist): Remove. + (x-select-request-type): Move from x-win.el. + (gui--selection-value-internal): New function, taken from x-win's + x-selection-value-internal. + (gui-selection-value): Rewrite, based on x-win.el's old x-selection-value. + (gui-set-selection-alist): Rename from gui-own-selection-alist and + extend it to handle a nil value as a "disown" request. + (gui-disown-selection-alist): Remove. + (xselect-convert-to-delete): Adjust accordingly. + (gui-set-selection): Simplify accordingly as well. Use dotimes. + + * term/x-win.el (x-last-selected-text-primary) + (x-select-enable-primary): Remove (moved to select.el). + (x-select-request-type): Move to select.el. + (x-selection-value-internal, x--selection-value): Remove functions. + (gui-selection-value, gui-select-text): Remove moethods. + (gui-set-selection): Merge own and disown methods. + + * term/w32-win.el (w32--select-text, w32--get-selection-value): + Delete function (move functionality into w32--set-selection and + w32--get-selection). + (gui-select-text, gui-selection-value): Don't define methods. + (w32--set-selection, w32--get-selection, w32--selection-owner-p): + New functions. + (gui-get-selection, gui-selection-owner-p, gui-selection-exists-p): + Use them. + (gui-selection-exists-p): Adjust to new name of C primitive. + + * term/pc-win.el (w16-get-selection-value): Add dummy argument and drop + test of gui-select-enable-clipboard, to make it usable as + a gui-get-selection method. + (gui-selection-exists-p): Adjust to new name of C primitive. + (gui-set-selection): Merge own and disown methods. + (gui-select-text, gui-selection-value): Delete methods. + (w16--select-text): Delete function. + + * term/ns-win.el (ns-get-pasteboard, ns-set-pasteboard) + (ns-selection-value): Remove functions. + (gui-select-text, gui-selection-value): Don't define method any more. + (gui-set-selection): Merge the old own and disown methods. + (gui-selection-exists-p, gui-get-selection): Adjust to new name of + underlying C primitive. + + * startup.el (command-line): Adjust now that `gui-method' expects nil + for ttys. + + * frame.el (gui-method): Use window-system rather than framep. + (gui-method-declare): The tty case is now nil rather than t. + (make-frame): Adjust accordingly. + +2014-10-21 Stefan Monnier <monnier@iro.umontreal.ca> + + * net/newst-reader.el (newsticker--image-read): Simplify. + (newsticker--icon-read): Use dolist and fix free var error. + + * imenu.el (imenu--menubar-keymap): New var. + (imenu-add-to-menubar): Set it to remember the keymap we used. + (imenu-update-menubar): Use it instead of asking lookup-key. * obsolete/cc-compat.el: Make obsolete (bug#18561). @@ -774,11 +4148,169 @@ * emacs-lisp/bytecomp.el (=, <, >, <=, >=): Don't optimize multi-arg case (bug#18767). +2014-10-21 Glenn Morris <rgm@gnu.org> + + * Merge in all changes up to version 24.4 release. + +2014-10-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/bytecomp.el (=, <, >, <=, >=): Don't optimize multi-arg + case (bug#18767). + 2014-10-20 Glenn Morris <rgm@gnu.org> - * Version 24.4 released. + * Merge in all changes up to 24.4 release. + +2014-10-20 Ulf Jasper <ulf.jasper@web.de> + + * net/newst-backend.el + (newsticker--image-download-by-url-callback): Make this function + actually work: Check status properly, then save image. + +2014-10-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * mouse.el (mouse--down-1-maybe-follows-link): Remove unused var + `this-event'. + (mouse-drag-line): Unless there's no actual mouse, use the event's + position info. + +2014-10-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * textmodes/css-mode.el (scss-mode): New major-mode. + (css-mode-syntax-table): Use d style comment, to ease the scss case. + (css-ident-re): Allow things like @-moz-keyframes. + (scss--hash-re): New const. + (css--font-lock-keywords): New function, extracted from + css-font-lock-keywords. + +2014-10-19 Ulf Jasper <ulf.jasper@web.de> + + * net/newst-backend.el: Require url-parse. + (newsticker--get-news-by-wget): Store feed name as process property. + (newsticker--sentinel): Read feed name from process property. + (newsticker--sentinel-work): Rename argument name to feed-name. + Rename variable imageurl to image-url. Pick icon url from Atom + 1.0 data. Launch download of feed icon. + (newsticker--get-icon-url-atom-1.0): New. + (newsticker--unxml) + (newsticker--unxml-node) + (newsticker--unxml-attribute): Documentation. + (newsticker--icons-dir): New. + (newsticker--image-get): New arguments FILENAME and DIRECTORY. + Use `url-retrieve' if `newsticker-retrieval-method' is 'intern. + (newsticker--image-download-by-wget): New. Use process properties + for storing informations. + (newsticker--image-sentinel): Read informations from process properties. + (newsticker--image-save) + (newsticker--image-remove) + (newsticker--image-download-by-url) + (newsticker--image-download-by-url-callback): New. + (newsticker-opml-export): Handle url list entries containing a + function instead of an url string. + + * net/newst-reader.el (newsticker-html-renderer): Whitespace. + (newsticker--print-extra-elements) + (newsticker--do-print-extra-element): + Documentation (newsticker--image-read): Optionally limit image height. + Use imagemagick if possible. + (newsticker--icon-read): New. + + * net/newst-treeview.el (newsticker--treeview-item-show): Limit height of feed logo. + (newsticker--treeview-tree-expand): Use feed icons in treeview. + (newsticker--tree-widget-icon-create): New. Set the tree widget icon. + (newsticker--tree-widget-leaf-icon): Use feed icon. + +2014-10-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eieio-opt.el (eieio-lambda-arglist): Remove. + Use help-function-arglist instead. + + * emacs-lisp/eieio-core.el (eieio-compiled-function-arglist): Remove. + (eieio--with-scoped-class): Use `declare'. + (eieio-defclass): Remove compatibility code. + (no-method-definition, no-next-method, inconsistent-class-hierarchy) + (invalid-slot-type, unbound-slot, invalid-slot-name): Use define-error. + +2014-10-18 Jan Djärv <jan.h.d@swipnet.se> + + * cus-start.el (x-gtk-whole-detached-tool-bar): Remove. + + * term/x-win.el (x-gtk-stock-map): Add icon names suggested as + replacements to stock names before stock names in a list. + Cdr may be a list, each name is tried in turn until one is found. + +2014-10-18 Alan Mackenzie <acm@muc.de> + + Check that a "macro" found near point-min isn't a ## operator. + Fixes bug #18749. + * progmodes/cc-engine.el (c-macro-is-genuine-p): New function. + (c-beginning-of-macro): Use the above new function. + +2014-10-18 Teodor Zlatanov <tzz@lifelogs.com> + + * net/gnutls.el (gnutls-negotiate): Don't use cl-mapcan; pass + correct data to `gnutls-boot' (Bug#18664). + Reported by Toke Høiland-Jørgensen <toke@toke.dk>. + +2014-10-18 Michal Nazarewicz <mina86@mina86.com> + + * whitespace.el (whitespace-style, whitespace-big-indent) + (whitespace-big-indent-regexp, whitespace-style-value-list) + (whitespace-toggle-option-alist, whitespace-interactive-char) + (whitespace-toggle-options) + (global-whitespace-toggle-options, whitespace-help-text) + (whitespace-style-face-p, whitespace-color-on): Add a 'big-indent + style to `whitespace-mode' to indicate that the line indentation + is too deep. By default, 32 SPACEs or four TABs are considered + too many but `whitespace-big-indent-regexp' can be configured. + +2014-10-17 Michal Nazarewicz <mina86@mina86.com> + + * textmodes/tildify.el (tildify--pick-alist-entry): Rename from + tildify-mode-alist. + +2014-10-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eieio.el: Use lexical-binding drop non-GV fallback. + (defclass, defgeneric, defmethod): Add doc-string position. + (with-slots): Require cl-lib. + + * emacs-lisp/eieio-core.el: Use lexical-binding and cl-lib. + (list-of): New type. + (eieio--typep): Remove. + (eieio-perform-slot-validation): Use cl-typep instead. + + * emacs-lisp/eieio-base.el: Use lexical-binding and cl-lib. + + * emacs-lisp/cl-macs.el (cl--make-type-test): Avoid ((lambda ..) ..). -2014-10-15 Alan Mackenzie <acm@muc.de> +2014-10-16 Alan Mackenzie <acm@muc.de> + + Trigger showing when point is in the "periphery" of a line or just + inside a paren. + * paren.el (show-paren-style, show-paren-delay) + (show-paren-priority, show-paren-ring-bell-on-mismatch): + Remove superfluous :group specifications. + (show-paren-when-point-inside-paren) + (show-paren-when-point-in-periphery): New customizable variables. + (show-paren-highlight-openparen): Make into a defcustom. + (show-paren--unescaped-p, show-paren--categorize-paren) + (show-paren--locate-near-paren): New defuns. + (show-paren--default): Refaactor and trigger on more paren + positions. + (show-paren-function): Small consequential changes. + +2014-10-16 Tom Tromey <tom@tromey.com> + + * files.el (auto-mode-alist): Use javascript-mode for .jsm + (bug #18719). + +2014-10-16 Eli Zaretskii <eliz@gnu.org> + + * international/characters.el (bracket-type): Force pre-loading of + uni-brackets.el. + +2014-10-16 Alan Mackenzie <acm@muc.de> * cus-edit.el (custom-command-apply): Specify the return value in the doc string. @@ -787,23 +4319,43 @@ 2014-10-15 Stefan Monnier <monnier@iro.umontreal.ca> - * emacs-lisp/lisp.el (lisp--local-variables-1): Handle `quote'. - Backported (bug#18688). + * emacs-lisp/eldoc.el (global-eldoc-mode): Enable by default. + Remove incorrect handling of eldoc-print-after-edit. + (eldoc-message-commands, eldoc-last-data): Use defvar. + * loadup.el (emacs-lisp/eldoc): Load it. + + * progmodes/m4-mode.el (m4-syntax-propertize): New var. + (m4-mode): Use it. + (m4--quoted-p): New function. + (m4-font-lock-keywords): Don't handle #..\n comments any more. + (m4-mode-syntax-table): Use punctuation syntax (according to m4 manual) + for most special characters. + + * progmodes/compile.el (compilation--previous-directory): Simplify. + (compilation-next-error): Ensure the parse before we look at + compilation-message property. + +2014-10-15 Eli Zaretskii <eliz@gnu.org> -2014-10-14 Eli Zaretskii <eliz@gnu.org> + * simple.el (what-cursor-position): + * descr-text.el (describe-char): Update to support the new bidi + characters. * emacs-lisp/tabulated-list.el (tabulated-list-mode): Force bidi-paragraph-direction to 'left-to-right'. This fixes buffer-menu display when the first buffer happens to start with R2L letter. -2014-10-13 Glenn Morris <rgm@gnu.org> +2014-10-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/elisp-mode.el (elisp--local-variables-1): + Handle quoted expressions (bug#18688). - * emacs-lisp/authors.el (authors-aliases, authors-fixed-case) - (authors-obsolete-files-regexps): Additions. - (authors-no-scan-regexps): New constant. - (authors-no-scan-file-p): New function. - (authors): Respect authors-no-scan-file-p. +2014-10-14 Jérémy Compostella <jeremy.compostella@intel.com> + Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-sh.el (tramp-open-connection-setup-interactive-shell): + Reduce the amount of set environment variable commands. 2014-10-12 Fabián Ezequiel Gallina <fgallina@gnu.org> @@ -811,17 +4363,67 @@ * progmodes/python.el (python-shell-completion-get-completions): Fix import case regexp. -2014-10-10 Stefan Monnier <monnier@iro.umontreal.ca> +2014-10-12 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/bat-mode.el (bat-font-lock-keywords): Fix \\<_ typo (bug#18622). Reported by Arni Magnusson <arnima@hafro.is>. * progmodes/prolog.el (prolog-electric--underscore): Same. +2014-10-12 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-sh.el (tramp-get-remote-id): Check also for "gid". + +2014-10-11 Jan Djärv <jan.h.d@swipnet.se> + + * cus-start.el (all): Add missing ns and boolean to + ns-use-fullscreen-animation. + +2014-10-11 Leo Liu <sdl.web@gmail.com> + + * progmodes/cfengine.el (cfengine3-defuns, cfengine3-vartypes): + Use strings. + (cfengine3-create-imenu-index): New function. + (cfengine3-mode): Use it for `imenu-create-index-function'. + (cfengine-auto-mode): Improve and prefer cfengine3-mode when + buffer is empty. + +2014-10-11 Jan Djärv <jan.h.d@swipnet.se> + + * cus-start.el (all): Add ns-use-fullscreen-animation. + +2014-10-11 Glenn Morris <rgm@gnu.org> + + * calendar/diary-lib.el (diary-display-function): + Drop support for deprecated nil and list forms. + (diary-list-entries): Update for the above. + * calendar/cal-x.el (calendar-dedicate-diary): Simplify accordingly. + +2014-10-10 Leo Liu <sdl.web@gmail.com> + + * window.el (temp-buffer-window-show): Make BUFFER a required arg. + (Bug#18656) + +2014-10-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * select.el (gui-selection-exists-p-alist): New method. + * menu-bar.el (menu-bar-edit-menu, clipboard-yank): + * simple.el (deactivate-mark): Use it. + * term/x-win.el (gui-selection-exists-p): + * term/w32-win.el (gui-selection-exists-p): + * term/pc-win.el (gui-selection-exists-p): + * term/ns-win.el (gui-selection-exists-p): Provide a backend instance. + +2014-10-10 Glenn Morris <rgm@gnu.org> + + * info.el (Info-fontify-maximum-menu-size): Bump to 400k. (Bug#16227) + Fix :type. Allow t to mean no limit. + (Info-fontify-node): Handle Info-fontify-maximum-menu-size = t. + 2014-10-09 Glenn Morris <rgm@gnu.org> * frame.el (display-monitor-attributes-list): Doc tweaks. -2014-10-08 Eli Zaretskii <eliz@gnu.org> +2014-10-09 Eli Zaretskii <eliz@gnu.org> * faces.el (display-grayscale-p): Mention in the doc string that the argument can be either a display name or a frame. @@ -834,20 +4436,284 @@ be either a display name or a frame. Improve the docs of the monitor attributes. (Bug#18636) -2014-10-06 Martin Rudalics <rudalics@gmx.at> +2014-10-09 Martin Rudalics <rudalics@gmx.at> * term.el (term-window-width): Subtract 1 from the width when any fringe has zero width, not just the right fringe. (Bug#18601) +2014-10-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * frame.el (make-frame): Use t rather than nil for `w' (bug#18653). + +2014-10-08 Leo Liu <sdl.web@gmail.com> + + * emacs-lisp/cl-extra.el (cl-fresh-line): New function. + +2014-10-08 Glenn Morris <rgm@gnu.org> + + * calendar/cal-x.el (calendar-dedicate-diary): + Drop support for recently deleted aliases. + +2014-10-08 Leo Liu <sdl.web@gmail.com> + + * progmodes/cfengine.el (cfengine3-make-syntax-cache): + Always return a syntax. Replace call-process-shell-command with + process-file. Ensure cfengine-mode-syntax-functions-regex is + always set. Ensure cache when cfengine-cf-promises fails. + (Bug#18620) + +2014-10-07 Glenn Morris <rgm@gnu.org> + + * font-lock.el (font-lock-fontify-buffer): Fix interactive-only markup. + +2014-10-07 Wilson Snyder <wsnyder@wsnyder.org> + + Sync with upstream verilog-mode revision c075a492. + * progmodes/verilog-mode.el (verilog-mode-version): Bump. + (verilog-menu): Add AUTOINSERTLAST. + (verilog-no-indent-begin-re): When `verilog-indent-begin-after-if' + is nil, fix indenting initial/final to match always statements, bug825. + Reported by Tim Clapp. + (verilog-extended-complete-re): Fix indentation of DPI-C imports, + bug557. Reported by ZeDong Mao and Jason Forkey. + (verilog-read-decls): Fix parsing typed interfaces. + Fix AUTOINOUTMODPORT missing types. Reported by Stephan Bourduas. + (verilog-auto-arg-ports): Fix verilog-auto-arg-format single. + (verilog-auto-output-every): Add regexp to AUTOOUTPUTEVERY, bug793. + Reported by Pierre-David Pfister. + (verilog-auto-insert-lisp): Doc fix. + (verilog-auto-insert-last, verilog-auto): Add AUTOINSERTLAST to + allow post-AUTO user fixups, bug826. Reported by Dennis Muhlestein. + (verilog-sk-ovm-class, verilog-sk-uvm-object) + (verilog-sk-uvm-component): Fix missing string keyword in class + skeletons, bug824. Reported by eldad faruhi. + +2014-10-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * term/w32-win.el: Move all code from 32-common-fns.el here. + (gui-select-text, gui-selection-value): Use w32 handlers in the w32 + console as well (bug#18629). + * w32-common-fns.el: Remove. + * loadup.el: Don't load w32-common-fns.el. + * w32-fns.elc: Don't require w32-common-fns. + + * icomplete.el: Move Iswitchb autoload here. Much simpler. + * obsolete/iswitchb.el (iswitchb-mode): Use normal autoload cookie. + Remove redundant obsolescence thingy. + * loadup.el: Don't load obsolete/loaddefs.el. + * Makefile.in (obsolete-autoloads): Remove. + (AUTOGENEL): Remove obsolete/loaddefs.el. + +2014-10-06 Glenn Morris <rgm@gnu.org> + + * Makefile.in (obsolete-autoloads): Write to a separate file, + to workaround autoloads bug. (Bug#17407) + (AUTOGENEL): Add obsolete/loaddefs.el. + * loadup.el: Load obsolete/loaddefs.el if present. + * subr.el (do-after-load-evaluation): + Don't warn about obsolete/loaddefs.el. + + * menu-bar.el (menu-bar-games-menu): Remove landmark. + It has zero relationship to a game. + +2014-10-06 Leo Liu <sdl.web@gmail.com> + + * imenu.el (imenu): Re-write for clarity. + +2014-10-06 Glenn Morris <rgm@gnu.org> + + Remove calendar code obsolete since at least version 23.1. + * calendar/cal-bahai.el (calendar-absolute-from-bahai) + (calendar-print-bahai-date, calendar-bahai-prompt-for-date) + (calendar-goto-bahai-date, list-bahai-diary-entries) + (mark-bahai-calendar-date-pattern, mark-bahai-diary-entries) + (insert-bahai-diary-entry, insert-monthly-bahai-diary-entry) + (insert-yearly-bahai-diary-entry): + * calendar/cal-china.el (chinese-calendar-time-zone) + (chinese-calendar-location-name) + (chinese-calendar-daylight-time-offset) + (chinese-calendar-standard-time-zone-name) + (chinese-calendar-daylight-time-zone-name) + (chinese-calendar-daylight-savings-starts) + (chinese-calendar-daylight-savings-ends) + (chinese-calendar-daylight-savings-starts-time) + (chinese-calendar-daylight-savings-ends-time) + (chinese-calendar-celestial-stem) + (chinese-calendar-terrestrial-branch) + (calendar-absolute-from-chinese, calendar-print-chinese-date) + (calendar-goto-chinese-date): + * calendar/cal-coptic.el (calendar-absolute-from-coptic) + (calendar-print-coptic-date, coptic-prompt-for-date) + (calendar-goto-coptic-date, calendar-absolute-from-ethiopic) + (calendar-print-ethiopic-date, calendar-goto-ethiopic-date): + * calendar/cal-french.el (calendar-absolute-from-french) + (calendar-print-french-date, calendar-goto-french-date): + * calendar/cal-hebrew.el (diary-sabbath-candles-minutes) + (calendar-absolute-from-hebrew, calendar-print-hebrew-date) + (hebrew-calendar-yahrzeit, calendar-goto-hebrew-date) + (holiday-rosh-hashanah-etc, holiday-hanukkah) + (holiday-passover-etc, holiday-tisha-b-av-etc) + (list-hebrew-diary-entries, mark-hebrew-calendar-date-pattern) + (mark-hebrew-diary-entries, insert-hebrew-diary-entry) + (insert-monthly-hebrew-diary-entry) + (insert-yearly-hebrew-diary-entry, list-yahrzeit-dates) + (diary-omer, diary-yahrzeit, diary-rosh-hodesh, diary-parasha) + (diary-sabbath-candles): + * calendar/cal-islam.el (calendar-absolute-from-islamic) + (calendar-print-islamic-date, calendar-goto-islamic-date) + (list-islamic-diary-entries, mark-islamic-calendar-date-pattern) + (mark-islamic-diary-entries, insert-islamic-diary-entry) + (insert-monthly-islamic-diary-entry) + (insert-yearly-islamic-diary-entry): + * calendar/cal-iso.el (calendar-absolute-from-iso) + (calendar-print-iso-date, calendar-iso-read-args) + (calendar-goto-iso-date, calendar-goto-iso-week): + * calendar/cal-julian.el (calendar-absolute-from-julian) + (calendar-print-julian-date, calendar-goto-julian-date) + (calendar-absolute-from-astro, calendar-print-astro-day-number) + (calendar-goto-astro-day-number): + * calendar/cal-mayan.el (calendar-print-mayan-date) + (calendar-next-haab-date, calendar-previous-haab-date) + (calendar-next-tzolkin-date, calendar-previous-tzolkin-date) + (calendar-next-calendar-round-date) + (calendar-previous-calendar-round-date) + (calendar-absolute-from-mayan-long-count) + (calendar-goto-mayan-long-count-date): + * calendar/cal-move.el (scroll-calendar-left) + (scroll-calendar-right, scroll-calendar-left-three-months) + (scroll-calendar-right-three-months): + * calendar/cal-persia.el (calendar-absolute-from-persian) + (calendar-print-persian-date, persian-prompt-for-date) + (calendar-goto-persian-date): + * calendar/cal-x.el (calendar-after-frame-setup-hooks): + * calendar/calendar.el (view-diary-entries-initially) + (mark-diary-entries-in-calendar, calendar-today-face) + (diary-face, holiday-face, view-calendar-holidays-initially) + (mark-holidays-in-calendar, initial-calendar-window-hook) + (today-visible-calendar-hook, today-invisible-calendar-hook) + (hebrew-diary-entry-symbol, islamic-diary-entry-symbol) + (bahai-diary-entry-symbol, american-date-diary-pattern) + (european-date-diary-pattern, european-calendar-display-form) + (american-calendar-display-form, holidays-in-diary-buffer) + (all-hebrew-calendar-holidays, all-christian-calendar-holidays) + (all-islamic-calendar-holidays, all-bahai-calendar-holidays) + (fancy-diary-buffer, increment-calendar-month) + (extract-calendar-month, extract-calendar-day) + (extract-calendar-year, exit-calendar, calendar-date-is-legal-p) + (mark-visible-calendar-date, calendar-version): + * calendar/diary-lib.el (diary-button-face, sexp-diary-entry-symbol) + (diary-display-hook, list-diary-entries-hook) + (mark-diary-entries-hook, nongregorian-diary-listing-hook) + (nongregorian-diary-marking-hook, print-diary-entries-hook) + (abbreviated-calendar-year, number-of-diary-entries) + (view-other-diary-entries, add-to-diary-list) + (include-other-diary-files, simple-diary-display) + (fancy-diary-display, print-diary-entries, mark-diary-entries) + (mark-sexp-diary-entries, mark-included-diary-files) + (mark-calendar-days-named, mark-calendar-month) + (mark-calendar-date-pattern, sort-diary-entries) + (list-sexp-diary-entries, make-diary-entry, insert-diary-entry) + (insert-weekly-diary-entry, insert-monthly-diary-entry) + (insert-yearly-diary-entry, insert-anniversary-diary-entry) + (insert-block-diary-entry, insert-cyclic-diary-entry) + (fancy-diary-font-lock-keywords, fancy-diary-display-mode): + * calendar/holidays.el (general-holidays, oriental-holidays) + (local-holidays, other-holidays, hebrew-holidays) + (christian-holidays, islamic-holidays, bahai-holidays) + (solar-holidays, list-calendar-holidays) + (check-calendar-holidays, mark-calendar-holidays) + (filter-visible-calendar-holidays): + * calendar/lunar.el (calendar-phases-of-moon, phases-of-moon) + (diary-phases-of-moon): Remove obsolete aliases. + * calendar/cal-menu.el (cal-menu-load-hook): Remove obsolete hook. + * calendar/cal-x.el (calendar-one-frame-setup) + (calendar-only-one-frame-setup, calendar-two-frame-setup): + Remove obsolete functions. + (cal-x-load-hook): Remove obsolete hook. + * calendar/calendar.el (european-calendar-style): + Remove obsolete variable. + (calendar-date-style): No longer consult european-calendar-style. + * calendar/calendar.el (european-calendar, american-calendar): + Remove obsolete commands. + * calendar/calendar.el (calendar-for-loop): Remove obsolete macro. + * calendar/diary-lib.el (diary-face): Remove obsolete variable. + (diary-font-lock-date-forms, diary-fancy-font-lock-keywords): + Use the face `diary' instead of the variable `diary-face'. + * calendar/holidays.el (hebrew-holidays-1, hebrew-holidays-2) + (hebrew-holidays-3, hebrew-holidays-4): Remove obsolete variables. + * calendar/icalendar.el (icalendar--date-style): Remove function. + Replace all uses with calendar-date-style. + * textmodes/remember.el (calendar-date-style): Declare. + (remember-diary-convert-entry): + No longer consult european-calendar-style. + 2014-10-05 Leo Liu <sdl.web@gmail.com> * imenu.el (imenu-default-goto-function): Fix typo. +2014-10-04 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/ntlm.el (ntlm-build-auth-request): + Add NTLM2 Session support. (Bug#15603) + +2014-10-04 Glenn Morris <rgm@gnu.org> + + * apropos.el (apropos-symbols-internal): + Avoid error with non-symbol properties. (Bug#18337#16) + + * startup.el (command-line): + Handle altered user-emacs-directory in load-path warning. (Bug#18512) + +2014-10-04 Martin Rudalics <rudalics@gmx.at> + + * window.el (window-full-height-p): Make it behave correctly for + minibuffer window. + (window-current-scroll-bars): Fix code. + (fit-frame-to-buffer): Use window-scroll-bar-height instead of + window-scroll-bars. + * frame.el (frame-current-scroll-bars): Fix doc-string. + * scroll-bar.el (toggle-horizontal-scroll-bar): New command. + +2014-10-04 Mark Oteiza <mvoteiza@udel.edu> (tiny change) + + * files.el (auto-mode-alist): Use sh-mode for .zsh files. (Bug#18488) + 2014-10-04 Glenn Morris <rgm@gnu.org> * frame.el (frame-monitor-attributes) (display-monitor-attributes-list): Doc fixes. +2014-10-04 Stefan Monnier <monnier@iro.umontreal.ca> + + Merge trivially safe differences from standalone CC-mode. + * progmodes/cc-mode.el (c-initialize-cc-mode): Don't quote a symbol + just to then pass it to `symbol-value'. + (prog-mode): Provide fallback definition, if needed. + * progmodes/cc-langs.el: Always load `cl'. Don't load `cl-lib'. + Remove "cl-" prefix accordingly. + * progmodes/cc-fonts.el (c-font-lock-invalid-string): Use integerp or + characterp depending on the type of characters. + (c-font-lock-enum-tail): Remove unused var `start'. + * progmodes/cc-engine.el: Load CL at compile-time. + (c-declare-lang-variables): Use mapcan. + (c-append-to-state-cache): Remove unused var `ce+1'. + (c-parse-state-state): Make buffer-local. + (c-ssb-lit-begin): Remove unused var `pps-end-pos'. + (c-just-after-func-arglist-p): Remove unused var `end'. + * progmodes/cc-defs.el: Load cc-fix if delete-dups is undefined. + (c-<-as-paren-syntax, c->-as-paren-syntax): Move definition earlier. + (c-make-keywords-re): Use delete-dups. + (c-get-current-file): Avoid file-name-base. + * progmodes/cc-cmds.el (c-electric-lt-gt): Remove unused var + `close-paren-inserted'. + * progmodes/cc-awk.el (c-forward-sws): Remove unused declaration. + + * progmodes/python.el: Avoid building unneeded markers. + (python-font-lock-keywords, python-indent-dedent-line) + (python-fill-paren, python-shell-completion-complete-or-indent): + Prefer point over point-marker. + (inferior-python-mode): Remove redundant completion settings. + 2014-10-03 Dmitry Gutov <dgutov@yandex.ru> * vc/vc-svn.el (vc-svn-ignore-completion-table): Implement. @@ -864,56 +4730,557 @@ similarly to Rogers's 2010-06-16 change for the remote case (bug#18605). -2014-10-01 Glenn Morris <rgm@gnu.org> +2014-10-03 Stefan Monnier <monnier@iro.umontreal.ca> + + New gui-selection-value consolidating x-selection-value. + * select.el (gui-selection-value-alist): New method. + (gui-selection-value): New function. + (x-selection-value): Make it an obsolete alias. + * simple.el (interprogram-paste-function): Default to + gui-selection-value. + * w32-common-fns.el (w32-get-selection-value): Simplify. + (x-selection-value): Remove alias. + (interprogram-paste-function): Don't set. + (gui-selection-value): Define for w32. + * term/x-win.el (gui-selection-value): Define for x. + (x--selection-value): Rename from x--selection-value. + (interprogram-paste-function): Don't set. + * term/pc-win.el (w16-get-selection-value): Simplify. + (msdos-initialize-window-system): Don't set + interprogram-paste-function. + (gui-selection-value): Define for pc. + * term/ns-win.el (x-selection-value): Remove. + (gui-selection-value): Define for ns, instead. + * term/common-win.el (x-setup-function-keys): Don't set + interprogram-paste-function. + * obsolete/mouse-sel.el (mouse-sel-get-selection-function): + Use gui-selection-value. + +2014-10-02 David Raynes <rayners@gmail.com> (tiny change) + + * term/ns-win.el: Add functions to ns frame, not x frame (bug#18614). + +2014-10-02 Stefan Monnier <monnier@iro.umontreal.ca> + + * obsolete/lucid.el (read-number): Remove, redundant. + * obsolete/cl-compat.el (cl-floor, cl-ceiling, cl-round, cl-truncate): + Remove, broken. + +2014-10-02 Glenn Morris <rgm@gnu.org> * emacs-lisp/package.el (package-import-keyring): Create gnupg directory private. (Bug#17625#155) -2014-10-01 Stefan Monnier <monnier@iro.umontreal.ca> +2014-10-02 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/python.el (python-shell-completion-get-completions): Use python-shell--prompt-calculated-input-regexp from the process buffer (bug#18582). Don't assume that `line' comes from the process buffer. +2014-10-02 Stefan Monnier <monnier@iro.umontreal.ca> + + * frame.el: Use lexical-binding (bug#18598). + (make-frame): Use t rather than nil for tty's window-system. + * startup.el (command-line): Use gui-method. + + Consolidate management/ownership of selections. + * select.el (gui-get-selection-alist): New method. + (gui-get-selection): Use it. Rename from x-get-selection. + (x-get-selection): Define as obsolete alias. + (x-get-clipboard): Mark obsolete. + (gui-get-primary-selection): New function. + (x-get-selection-value): Mark obsolete. + (gui-own-selection-alist, gui-disown-selection-alist) + (gui-selection-owner-p-alist): New methods. + (gui-set-selection): Use them. Rename from x-set-selection. + (x-set-selection): Define as obsolete alias. + (gui--valid-simple-selection-p): Rename from + x-valid-simple-selection-p. + * w32-common-fns.el (gui-own-selection, gui-disown-selection) + (gui-selection-owner-p, gui-get-selection): Define for w32. + (w32-get-selection-value): Rename from x-get-selection-value. + Use the new gui-last-selected-text. + * term/x-win.el (x-get-selection-value): Remove. + (x-clipboard-yank): Declare obsolete. + (gui-own-selection, gui-disown-selection, gui-get-selection) + (gui-selection-owner-p): Define for x. + * term/w32-win.el (w32-win-suspend-error): Rename from + x-win-suspend-error. + * term/pc-win.el (w16-get-selection-value): Rename from + x-get-selection-value. + (w16-selection-owner-p): Rename from x-selection-owner-p. + (gui-own-selection, gui-disown-selection, gui-get-selection) + (gui-selection-owner-p): Define for pc. + (w16--select-text): New function. + * term/ns-win.el (gui-own-selection, gui-disown-selection) + (gui-get-selection, gui-selection-owner-p): Define for ns. + * term.el (term-mouse-paste): + * mouse.el (mouse-yank-primary): Use gui-get-primary-selection. + +2014-10-02 H. Dieter Wilhelm <dieter@duenenhof-wilhelm.de> + + * calc/calc-help.el (calc-describe-thing): Quote strings + which could look like regexps. + +2014-10-01 Stefan Monnier <monnier@iro.umontreal.ca> + + Consolidate x-select-text. + * frame.el (gui-method, gui-method-define, gui-method-declare) + (gui-call): New macros. + (gui-method--name): New function. + (frame-creation-function-alist): Use gui-method-declare. + (make-frame): Use gui-method. + * select.el (gui-select-enable-clipboard): Rename from + x-select-enable-clipboard and move here. + (x-select-enable-clipboard): Define as obsolete alias. + (gui-last-selected-text): New var, to replace x-last-selected-text. + (gui-select-text): New GUI method. + (gui-select-text): New function. + (x-select-text): Define as obsolete alias. + * term/common-win.el (x-select-enable-clipboard, x-select-text): + Move to select.el. + * simple.el (interprogram-cut-function): Change default to + x-select-text. + (interprogram-paste-function): Change default to `ignore'. + * w32-common-fns.el (interprogram-cut-function): Don't modify. + * term/x-win.el (interprogram-cut-function): Don't modify. + (gui-select-text): Add method for x. + * term/w32-win.el (gui-select-text): Add method for w32. + * term/pc-win.el (x-last-selected-text): Remove, use + gui-last-selected-text instead. + (msdos-initialize-window-system): Don't set interprogram-cut-function. + (gui-select-text): Add method for pc. + * term/ns-win.el (ns-last-selected-text): Remove, use + gui-last-selected-text instead. + (gui-select-text): Add method for ns. + (x-setup-function-keys): Don't change interprogram-cut-function. + * loadup.el ("startup"): Load after "frame". + * subr.el (package--builtin-versions, package--description-file): + Move from startup.el. + * startup.el (package--builtin-versions, package--description-file): + Move to subr.el. + (handle-args-function-alist, window-system-initialization-alist): + Use gui-method-declare. + (command-line): Use gui-method. + +2014-10-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (alist-get): New accessor. + * emacs-lisp/gv.el (alist-get): Provide expander. + * winner.el (winner-remember): + * tempo.el (tempo-use-tag-list): + * progmodes/gud.el (minor-mode-map-alist): + * international/mule-cmds.el (define-char-code-property): + * frameset.el (frameset-filter-params): + * files.el (dir-locals-set-class-variables): + * register.el (get-register, set-register): + * calc/calc-yank.el (calc-set-register): Use it. + * ps-print.el (ps-get, ps-put, ps-del): Mark as obsolete. + * tooltip.el (tooltip-set-param): Mark as obsolete. + (tooltip-show): Use alist-get instead. + * ses.el (ses--alist-get): Remove. Use alist-get instead. + +2014-10-01 Ulf Jasper <ulf.jasper@web.de> + + * net/newst-backend.el: Remove Time-stamp. Rename variable + `newsticker--download-logos' to `newsticker-download-logos' and + make it customizable. + (newsticker--sentinel-work): Move xml-workarounds to function + `newsticker--do-xml-workarounds', call unless libxml-parser is + used. Allow single quote in regexp for encoding. + Use libxml-parser if available, else fall back to `xml-parse-region'. + Take care of possibly missing namespace prefixes (like "RDF" + instead of "rdf:RDF") when checking xml nodes and attributes (as + libxml correctly removes the prefixes). Always use Atom 1.0 as + fallback feed type. Rename `newsticker--download-logos' to + `newsticker-download-logos' + (newsticker--unxml, newsticker--unxml-node) + (newsticker--unxml-attribute): New. + (newsticker--parse-atom-1.0): Call `unxml' in case that embedded + HTML code has become part of the xml parse tree. + (newsticker--parse-rss-1.0, newsticker--parse-rss-2.0): Take care + of possibly missing namespace prefixes. + (newsticker--parse-generic-items): Code formatting. Typo. + (newsticker--images-dir): Add trailing slash. + (newsticker--image-get): Fix error message. + + * net/newst-plainview.el: Remove Time-stamp. + + * net/newst-reader.el: Remove Time-stamp. + (newsticker-download-logos): Rename variable + `newsticker--download-logos' to `newsticker-download-logos' and + make it customizable. + (newsticker--print-extra-elements): Add optional parameter + 'htmlish for using html markup. Amend list of ignored elements. + (newsticker--do-print-extra-element): Add parameter 'htmlish for + using html markup. + + * net/newst-ticker.el: Remove Time-stamp. + + * net/newst-treeview.el (newsticker--treeview-item-show): Use html + for formatting extra elements. + + * net/newsticker.el: Remove Time-stamp, Version. + (newsticker-version): Make obsolete. + 2014-09-30 Leonardo Nobrega <leonobr@gmail.com> (tiny change) * progmodes/python.el (python-fill-paren): Don't inf-loop at EOB (bug#18462). -2014-09-27 Stefan Monnier <monnier@iro.umontreal.ca> +2014-09-30 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/package.el (package-check-signature): Default to nil if GPG is not available. (package-refresh-contents): Don't mess with the keyring if we won't check the signatures anyway. -2014-09-18 Kan-Ru Chen <kanru@kanru.info> +2014-09-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * ses.el (ses--row, ses--col): New dyn-scoped vars, to replace row&col. + (ses-center, ses-center-span): Use them. + (ses-print-cell): Bind them while calling the printer. + (row, col, maxrow, maxcol): Don't declare as dynamically scoped. + (ses-dorange): Revert last change. + (ses-calculate-cell): Don't bind row&col dynamically while evaluating + the formula. + (ses-set-cell): Avoid `eval'. + (ses--time-check): Rename it from ses-time-check and turn it into + a macro. + + * ses.el (ses-setup): Don't assume modifying the iteration var of + dotimes affects the iteration (bug#18191). + +2014-09-30 Vincent Belaïche <vincentb1@users.sourceforge.net> + + * ses.el (ses-calculate-cell): Bind row and col dynamically to + their values with 'cl-progv'. + (ses-dorange): Bind row, col, maxrow and maxcol dynamically to + their values with 'cl-progv', also use non-interned symbols for + row, minrow, maxrow, mincol and maxcol. + (maxrow maxcol): New defvar, to make the compiler happy. + +2014-09-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * minibuffer.el (completion-at-point): Emit warning for ill-behaved + completion functions. + +2014-09-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * ses.el (ses--letref): Quote value before it gets re-evaluated. + +2014-09-28 Thien-Thi Nguyen <ttn@gnu.org> + + Font-lock `cl-flet*', too. + * emacs-lisp/lisp-mode.el (lisp-cl-font-lock-keywords-2): + Add "flet*" to intermediate var `cl-lib-kw'. + +2014-09-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * epg-config.el (epg-gpg-program): Use the plain program names rather + than their absolute file name. + + * subr.el (track-mouse): New macro. + * emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form): + Remove track-mouse case. + * emacs-lisp/bytecomp.el (byte-compile-track-mouse): Remove. + +2014-09-27 Leo Liu <sdl.web@gmail.com> + + * progmodes/elisp-mode.el (elisp--eldoc-last-data): Use defvar. + + * emacs-lisp/eldoc.el (eldoc-mode): Fix thinko. + +2014-09-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/pcase.el (pcase--split-match, pcase--app-subst-match): + Handle the case where `match' is :pcase--succeed or :pcase--fail + (bug#18554). + + Introduce global-eldoc-mode. Move Elisp-specific code to elisp-mode.el. + * emacs-lisp/eldoc.el (global-eldoc-mode): New minor mode. + (eldoc-schedule-timer): Obey it. + (eldoc-documentation-function): Default to nil. + (eldoc-mode): Don't enable if eldoc-documentation-function is not set. + (eldoc-documentation-function-default, eldoc-get-fnsym-args-string) + (eldoc-highlight-function-argument, eldoc-get-var-docstring) + (eldoc-last-data-store, eldoc-docstring-first-line) + (eldoc-docstring-format-sym-doc, eldoc-fnsym-in-current-sexp) + (eldoc-beginning-of-sexp, eldoc-current-symbol) + (eldoc-function-argstring): Move to elisp-mode.el. + (eldoc-symbol-function): Remove, unused. + * progmodes/elisp-mode.el: New file. Rename all "eldoc-*" to "elisp--*". + (elisp-completion-at-point): Rename from lisp-completion-at-point. + (elisp--preceding-sexp): Rename from preceding-sexp. + * loadup.el: Load new file progmodes/elisp-mode. + * ielm.el (inferior-emacs-lisp-mode): Set eldoc-documentation-function. + * emacs-lisp/lisp.el (lisp--local-variables-1, lisp--local-variables) + (lisp--local-variables-completion-table, lisp--expect-function-p) + (lisp--form-quoted-p, lisp--company-doc-buffer) + (lisp--company-doc-string, lisp--company-location) + (lisp-completion-at-point): Move to elisp-mode.el. + * emacs-lisp/lisp-mode.el (lisp--mode-syntax-table): New syntax-table, + extracted from emacs-lisp-mode-syntax-table. + (emacs-lisp-mode-abbrev-table, emacs-lisp-mode-syntax-table): Move to + elisp-mode.el. + (lisp-imenu-generic-expression): Add comments to document what comes + from which Lisp dialect. + (emacs-lisp-mode-map, emacs-lisp-byte-compile) + (emacs-lisp-byte-compile-and-load, emacs-lisp-mode-hook) + (emacs-lisp-mode, emacs-list-byte-code-comment-re) + (emacs-lisp-byte-code-comment) + (emacs-lisp-byte-code-syntax-propertize, emacs-lisp-byte-code-mode) + (lisp-interaction-mode-map, lisp-interaction-mode) + (eval-print-last-sexp, last-sexp-setup-props) + (last-sexp-toggle-display, prin1-char, preceding-sexp) + (eval-last-sexp-1, eval-last-sexp-print-value) + (eval-last-sexp-fake-value, eval-sexp-add-defvars, eval-last-sexp) + (eval-defun-1, eval-defun-2, eval-defun): Move to elisp-mode.el. + +2014-09-26 Paul Eggert <eggert@cs.ucla.edu> + + * progmodes/grep.el (grep-regexp-alist): Use more-accurate regexp. + Do not match file names that end in '/', as they cannot be 'grep' + hits nowadays. This prevents confusion when 'grep -r' reports a + match in a file whose basename is ':12345:'. Conversely, do not + require exactly the same sequence of spaces and tabs after both + colons, and allow spaces or tabs before the second colon, as per + the POSIX spec for 'grep' output. + +2014-09-26 Leo Liu <sdl.web@gmail.com> + + Add cl-parse-integer based on parse-integer (Bug#18557) + * calendar/parse-time.el (parse-time-digits): Remove. + (digit-char-p, parse-integer) Moved to cl-lib.el. + (parse-time-tokenize, parse-time-rules, parse-time-string): + Use cl-parse-integer. + + * emacs-lisp/cl-extra.el (cl-parse-integer): New function. + + * emacs-lisp/cl-lib.el (cl-digit-char-table): New var. + (cl-digit-char-p): New function. + +2014-09-25 Juri Linkov <juri@jurta.org> + + * vc/add-log.el (change-log-next-buffer): Don't create an empty + buffer "ChangeLog" when the current buffer doesn't match ChangeLog.[0-9]. + Return the current buffer if no files match the default pattern + ChangeLog.[0-9]. Signal "end of multi" when file is nil. (Bug#18547) + +2014-09-25 Stefan Monnier <monnier@iro.umontreal.ca> + + * net/tramp-sh.el (tramp-sh-handle-vc-registered): Don't modify + the global vc-handled-backends (bug#18535). + +2014-09-24 Stefan Monnier <monnier@iro.umontreal.ca> + + * find-cmd.el (find-cmd): Use grep's `find-program' (bug#18518). + Suggested by <lompik@voila.fr>. + +2014-09-24 Ulf Jasper <ulf.jasper@web.de> + + * net/newst-treeview.el (newsticker--treeview-do-get-node-by-id): + Rename from `newsticker--treeview-do-get-node'. + (newsticker--treeview-get-node-by-id): + Rename from `newsticker--treeview-get-node'. + (newsticker--treeview-buffer-init) + (newsticker--treeview-buffer-init): Disable buffer undo. + (newsticker--treeview-unfold-node): Adapt to modified + `newsticker--group-find-parent-group'. + (newsticker--group-do-find-group): + Rename from `newsticker--group-do-find-group-for-feed'. + Now works for both, groups and feeds. + (newsticker--group-find-parent-group): + Rename from `newsticker--group-find-group-for-feed'. + Now works for both, groups and feeds. + (newsticker--group-do-get-parent-group) + (newsticker--group-get-parent-group): Remove. + (newsticker-group-add-group): Change interactive prompts. + (newsticker-group-add-group): Finally jump to added group. + (newsticker-group-delete-group): Finally jump to current feed. + (newsticker--group-do-rename-group, newsticker-group-rename-group) + (newsticker--get-group-names, newsticker--group-names): New. + (newsticker-group-move-feed): Finally jump to moved feed. + (newsticker-group-shift-feed-down, newsticker-group-shift-feed-up) + (newsticker-group-shift-group-down) + (newsticker-group-shift-group-up, newsticker--group-shift): New. + (newsticker-treeview-mode-map): New keybindings for new shift commands. + + * net/newst-backend.el (newsticker--item-list) + (newsticker--item-position, newsticker--prev-message) + (newsticker--scrollable-text): Move to newst-ticker.el. + + * net/newst-ticker.el (newsticker--item-list) + (newsticker--item-position, newsticker--prev-message) + (newsticker--scrollable-text): Move from newst-backend.el. + +2014-09-22 Kan-Ru Chen <kanru@kanru.info> * window.el (fit-window-to-buffer): When counting buffer width, count the whole visible buffer. Correctly convert the body-height to pixel size for window-text-pixel-size (Bug#18498). -2014-09-14 Glenn Morris <rgm@gnu.org> +2014-09-22 Sam Steingold <sds@gnu.org> + + * progmodes/sql.el (sql-product-alist): Improve the Vertica entry. + (sql-execute): Use `special-mode'. + +2014-09-22 Stefan Monnier <monnier@iro.umontreal.ca> + + Add pcase-defmacro, as well as `quote' and `app' patterns. + * loadup.el: Increase max-lisp-eval-depth when macroexpanding macroexp. + * emacs-lisp/pcase.el: Allow (F . ARGS) in `app' patterns. + (pcase--funcall, pcase--eval): New functions. + (pcase--u1): Use them for guard, pred, let, and app. + (\`): Use the new feature to generate better code for vector patterns. + * emacs-lisp/pcase.el: Use pcase-defmacro to handle backquote. + (pcase--upat): Remove. + (pcase--macroexpand): Don't hardcode handling of `. + (pcase--split-consp, pcase--split-vector): Remove. + (pcase--split-equal): Disregard ` since it's expanded away. + (pcase--split-member): Optimize for quote rather than for `. + (pcase--split-pred): Optimize for quote rather than for `. + (pcase--u1): Remove handling of ` (and of `or' and `and'). + Quote non-selfquoting values when passing them to `eq'. + Drop `app's let-binding if the variable is not used. + (pcase--q1): Remove. + (`): Define as a pattern macro. + * emacs-lisp/pcase.el (pcase--match): New smart-constructor function. + (pcase--expand pcase--q1, pcase--app-subst-match): Use it. + (pcase--macroexpand): Handle self-quoting patterns here, expand them to + quote patterns. + (pcase--split-match): Don't hoist or/and here any more. + (pcase--split-equal): Optimize quote patterns as well as ` patterns. + (pcase--flip): New helper macro. + (pcase--u1): Optimize the memq case directly. + Don't handle neither self-quoting nor and/or patterns any more. + * emacs-lisp/pcase.el (pcase-defmacro): New macro. + (pcase--macroexpand): New function. + (pcase--expand): Use it. + * emacs-lisp/pcase.el (pcase--app-subst-match, pcase--app-subst-rest): + New optimization functions. + (pcase--u1): Add support for `quote' and `app'. + (pcase): Document them in the docstring. + +2014-09-22 Stefan Monnier <monnier@iro.umontreal.ca> + + Use lexical-bindin in Ibuffer. + * ibuffer.el (ibuffer-do-toggle-read-only): `arg' is unused. + (ibuffer-compile-format): Simplify. + (ibuffer-clear-summary-columns): Simplify. + * ibuf-ext.el (ibuffer-generate-filter-groups): Don't use the third + elem of dotimes when we don't refer to the iteration var from it. + (ibuffer-toggle-sorting-mode): Avoid add-to-list. + * ibuf-macs.el (define-ibuffer-column, define-ibuffer-op): + Silence byte-compiler. + +2014-09-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * font-lock.el (font-lock-compile-keyword): Don't confuse a lambda + expression for a list. + + * emacs-lisp/bytecomp.el (byte-compile-lambda): Don't add fundoc usage + for functions with no arguments. + + * mpc.el (mpc-data-directory): Use locate-user-emacs-file. + (mpc-volume-refresh): Make sure the corresponding header-line is updated. + +2014-09-17 Tom Willemse <tom@ryuslash.org> (tiny change) + + * simple.el (clone-indirect-buffer): Mention the return value + (bug#18478). + + * progmodes/prog-mode.el (prog-mode-hook): Replace reference to + Text mode in docstring (bug#18464). + +2014-09-21 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/perl-mode.el (perl-syntax-propertize-function): + Accept underscores in identifiers after "sub" (bug#18502). + +2014-09-21 Tassilo Horn <tsdh@gnu.org> + + * textmodes/reftex-sel.el (reftex-select-label-mode) + (reftex-select-bib-mode, reftex-insert-docstruct): Derive modes + from special-mode (instead of fundamental-mode) and propertize + with font-lock-face instead of just face. (Bug#18496) + + * textmodes/reftex-toc.el (reftex-toc-mode, reftex-toc): Ditto. + +2014-09-19 Dmitry Gutov <dgutov@yandex.ru> + + * emacs-lisp/lisp.el (lisp-completion-at-point): Only calculate + `table-etc' when `end' is non-nil. + (lisp-completion-at-point): Move `end' back if it's after quote. + If in comment or string, only complete when after backquote. + (Bug#18265) + (lisp-completion-at-point): Don't use + `lisp--local-variables-completion-table' in the + `lisp--form-quoted-p' case. + +2014-09-19 Dmitry Gutov <dgutov@yandex.ru> + + * emacs-lisp/lisp.el (lisp--expect-function-p) + (lisp--form-quoted-p): New functions. + (lisp-completion-at-point): Use them to see if we're completing a + variable reference, a function name, or just any symbol. + http://lists.gnu.org/archive/html/emacs-devel/2014-02/msg00229.html + +2014-09-18 Ivan Kanis <ivan@kanis.fr> + + * net/shr.el, net/eww.el: Don't override `shr-width', but + introduce a new variable `shr-internal-width'. This allows users + to specify a width themselves. + +2014-09-18 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * image-mode.el (image-toggle-display-image): If we have a + `fit-width' or a `fit-height', don't limit the size of the image + to the window size, because that doesn't preserve the aspect ratio. + * image-mode.el: Move defvars earlier to avoid a byte-compilation + warning. + +2014-09-17 Reuben Thomas <rrt@sc3d.org> + + * progmodes/js.el: Add interpreter-mode-alist support for various + JavaScript interpreters. + +2014-09-17 Paul Eggert <eggert@cs.ucla.edu> + + Don't assume 'grep' supports GREP_OPTIONS. + The GREP_OPTIONS environment variable is planned to be marked + obsolescent in GNU grep, due to problems in its use, so stop + relying on it. + * progmodes/grep.el (grep-highlight-matches): Document this. + (grep-process-setup): Do not set GREP_OPTIONS. + (grep-compute-defaults): Use an explicit --color option if supported. + +2014-09-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * msb.el (msb--make-keymap-menu, msb-menu-bar-update-buffers): + Don't add outdated key-shortcut cache (bug#18482). + +2014-09-15 Glenn Morris <rgm@gnu.org> * image.el (image-multi-frame-p): Fix thinko - do not force a delay if none was specified. (Bug#18334) -2014-09-12 Kan-Ru Chen <kanru@kanru.info> +2014-09-15 Kan-Ru Chen <kanru@kanru.info> * window.el (fit-window-to-buffer): Doc fix. -2014-09-10 Ivan Shmakov <ivan@siamics.net> (tiny change) +2014-09-15 Ivan Shmakov <ivan@siamics.net> * desktop.el (desktop-create-buffer): Check that buffers are still live before burying them (bug#18373). -2014-09-09 Glenn Morris <rgm@gnu.org> +2014-09-15 Glenn Morris <rgm@gnu.org> * calendar/diary-lib.el (diary-list-entries): Restore 24.3 display behavior. (Bug#18381) -2014-09-09 Eli Zaretskii <eliz@gnu.org> +2014-09-15 Eli Zaretskii <eliz@gnu.org> * mouse.el (mouse-drag-line): On text-mode frames, count the mode line and header line as 1 pixel. This fixes the 1-"pixel" (row) @@ -921,25 +5288,251 @@ avoids moving mode line up when the mouse click is on the modeline and no drag is attempted. +2014-09-14 Daniel Colascione <dancol@dancol.org> + + * register.el (insert-register): Change default interactive + insertion mode. + +2014-09-14 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-cache.el (tramp-flush-file-function): Simplify check. + Suppress debug messages. + + * net/tramp.el (tramp-file-name-handler): + * net/tramp-gvfs.el (tramp-gvfs-url-file-name): Apply `cons' where + appropriate. + +2014-09-13 Christopher Schmidt <ch@ristopher.com> + + * calendar/calendar.el (calendar-update-mode-line): + Do not overwrite mode-line-format if calendar-mode-line-format is + nil. (Bug#18467) + +2014-09-13 Leo Liu <sdl.web@gmail.com> + + * emacs-lisp/pcase.el (pcase--dontwarn-upats): New var. + (pcase--expand): Use it. + (pcase-exhaustive): New macro. (Bug#16567) + + * emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-2): + Add pcase-exhaustive. + +2014-09-13 Eli Zaretskii <eliz@gnu.org> + + * mail/rmailmm.el (rmail-mime-insert-html): Decode the HTML part + using the specified transfer-encoding, if any, or 'undecided'. + (rmail-mime-render-html-shr): Bind shr-width to nil, so lines are + broken at the window margin. + +2013-12-27 Ken Olum <kdo@cosmos.phy.tufts.edu> + + Support rendering of HTML parts in Rmail (bug#4258). + * mail/rmailmm.el (rmail-mime-process): Handle text/html + separately from other text/ types. Suppress tagline for + multipart body. + (rmail-mime-parse): Don't change visibility of tagline here. + (rmail-mime-set-bulk-data, rmail-mime-insert-bulk): + Handle text/html specially. + (rmail-mime-render-html-function,rmail-mime-prefer-html): New variables. + (rmail-mime-insert-html, rmail-mime-render-html-shr) + (rmail-mime-render-html-lynx): New functions. + (rmail-mime-fix-inserted-faces): New function. + (rmail-mime-process-multipart): Find the best part to show + following rmail-mime-prefer-html if set. + (rmail-mime-searching): New variable. + (rmail-search-mime-message): Bind rmail-mime-searching to + suppress rendering while searching. + +2014-09-12 Sam Steingold <sds@gnu.org> + + * progmodes/sql.el (sql-product-alist): Add vertica. + (sql-vertica-program, sql-vertica-options) + (sql-vertica-login-params, sql-comint-vertica, sql-vertica): + New functions and variables to support Vertica. + Inspired by code by Roman Scherer <roman@burningswell.com>. + +2014-09-11 Paul Eggert <eggert@cs.ucla.edu> + + * ses.el (ses-file-format-extend-parameter-list): Rename from + ses-file-format-extend-paramter-list, to correct a misspelling. + All uses changed. + +2014-09-10 Alan Mackenzie <acm@muc.de> + + CC Mode: revert recent changes and fix bug 17463 (cc-langs.elc + gets loaded at run-time). + * progmodes/cc-langs.el (c-no-parens-syntax-table): Rename the + c-lang-const to c-make-no-parens-syntax-table and correct the + logic. + (c-no-parens-syntax-table): Correct the logic of the + c-lang-defvar. + +2014-09-10 Stefan Monnier <monnier@iro.umontreal.ca> + + CC-mode: Set open-paren-in-column-0-is-defun-start to nil; + plus misc cleanup. + * progmodes/cc-mode.el (c-basic-common-init): + Set open-paren-in-column-0-is-defun-start. + (adaptive-fill-first-line-regexp, font-lock-syntactic-keywords): + Remove declarations, unused. + (run-mode-hooks): Remove declaration. + (font-lock-defaults): Use plain `defvar' to declare. + (c-run-mode-hooks): Test existence of run-mode-hooks with fboundp. + * progmodes/cc-langs.el (c-filter-ops): Avoid `setq'. + (c-make-mode-syntax-table): Don't micro-optimize. + (c-keywords, c-keyword-member-alist): Simplify. + (c-kwds-lang-consts): Don't eval at compile-time. + (c-primary-expr-regexp): Comment out unused vars. + * progmodes/cc-fonts.el (c-font-lock-context): Declare at top-level. + (c-font-byte-compile): New var. + (c--compile): New function. Use it instead of `byte-compile'. + (c-cpp-matchers): Quote the value returned by + `c-make-syntactic-matcher' in case it's not self-evaluating. + (c-basic-matchers-before): Avoid a plain MATCHER as keyword, wrap it in + parentheses instead (in case MATCHER happens to be a list). + (c-font-lock-enum-tail): Remove unused var `start'. + (c-font-lock-objc-methods): Silence byte-compiler warnings. + * progmodes/cc-engine.el (c-syntactic-re-search-forward): Sink an `if' + test into an argument. + * progmodes/cc-defs.el (c-point, c-major-mode-is, c-put-char-property) + (c-get-char-property): Don't use `eval' just to unquote a constant. + (c-use-extents): Remove. Use (featurep 'xemacs), compiled + more efficiently. + (c-put-char-property-fun): Don't call `byte-compile' by hand. + (c-clear-char-property, c-clear-char-properties): Check that `property' + is a quoted constant. + (c-emacs-features): Remove `infodock', `syntax-properties', and + `pps-extended-state' (never used), `8-bit' and `1-bit' (use (featurep + 'xemacs) instead). Use `with-temp-buffer' and let-bind vars after + changing buffer, so we don't have to setq them again afterwards. + (c-lang-const): Remove redundant symbolp assertions. + (c-find-assignment-for-mode): Use `or'. + * Makefile.in (compile-one-process): Remove cc-mode dependency. + +2014-09-09 Sam Steingold <sds@gnu.org> + + * progmodes/sql.el (sql-default-directory): Fix type annotation. + +2014-09-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/cc-awk.el: Remove unneeded cc-bytecomp use. + Change doc comments into docstrings. + * Makefile.in: Remove cc-awk dependency. + +2014-09-08 Sam Steingold <sds@gnu.org> + + * progmodes/sql.el (sql-send-line-and-next): New command, + bound to C-c C-n. + (sql-show-sqli-buffer): Display the buffer instead of its name and + bind the command to C-c C-z. + (sql-default-directory): New user option. + (sql-product-interactive): Bind `default-directory' to it to + enable remote connections using Tramp. + (sql-set-sqli-buffer): Call `sql-product-interactive' when no + suitable buffer is available. + 2014-09-08 Glenn Morris <rgm@gnu.org> * calendar/calendar.el (calendar-basic-setup): + Fix calendar-view-holidays-initially-flag and fancy display. + * calendar/diary-lib.el (diary-live-p): Doc fix. + + * calendar/calendar.el (calendar-basic-setup): Avoid clobbering calendar with diary. (Bug#18381) -2014-09-05 Stefan Monnier <monnier@iro.umontreal.ca> +2014-09-08 Stefan Monnier <monnier@iro.umontreal.ca> * vc/vc-dir.el (vc-dir-update): Don't burp in corner case. -2014-09-04 Lars Ljung <lars@matholka.se> (tiny change) +2014-09-08 Lars Ljung <lars@matholka.se> (tiny change) * isearch.el (isearch-yank-word-or-char): Obey superword-mode as well (bug#18400). -2014-09-04 Eli Zaretskii <eliz@gnu.org> +2014-09-08 Eli Zaretskii <eliz@gnu.org> * subr.el (posn-actual-col-row): Doc fix. (Bug#18385) -2014-09-02 Stefan Monnier <monnier@iro.umontreal.ca> +2014-09-06 Leo Liu <sdl.web@gmail.com> + + * emacs-lisp/pcase.el (pcase): Doc fix. + (pcase--split-vector): New function. + (pcase--q1): Support vector qpattern. (Bug#18327) + +2014-09-05 Sam Steingold <sds@gnu.org> + + * textmodes/tex-mode.el (tex-print-file-extension): New user + option. + (tex-print): Use it instead of the hard-coded string. + +2014-09-05 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-sh.el (tramp-sh-handle-start-file-process): + Expand `default-directory'. + +2014-09-05 Martin Rudalics <rudalics@gmx.at> + + * scroll-bar.el (horizontal-scroll-bars-available-p): + New function. + (horizontal-scroll-bar-mode): Rewrite using + horizontal-scroll-bars-available-p. + * menu-bar.el (menu-bar-showhide-scroll-bar-menu): Rewrite using + horizontal-scroll-bars-available-p. + +2014-09-05 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (call-process-shell-command, process-file-shell-command): + Make the `args' obsolete (bug#18409). + (start-process-shell-command, start-file-process-shell-command): + Use `declare'. + +2014-09-05 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-forms.el (math-normalize-hms): Do a better check for + "negative" hms forms. + +2014-09-04 Rasmus Pank Roulund <emacs@pank.eu> + + * vc/vc-git.el (vc-git-conflicted-files): Fix bug when git status + returns nil (bug#18391). + +2014-09-04 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eldoc.el (eldoc-function-argstring): Don't strip + terminating paren (bug#18352). + (eldoc-last-data-store): Return cached data. + (eldoc-get-var-docstring): Avoid setq. + (eldoc-get-fnsym-args-string): Clarify data flow. + +2014-09-04 Thierry Volpiatto <thierry.volpiatto@gmail.com> + + * emacs-lisp/eldoc.el (eldoc-highlight-function-argument): Handle the + case where we're currently providing part of the &rest arg after some + &key args, as in define-ibuffer-op (bug#18048). + +2014-09-03 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/which-func.el (which-func-ff-hook): Obey pre-existing + buffer-local setting of which-func-mode. + (which-func-mode): Use defvar-local. + (which-function-mode): Don't reset which-func-mode in each buffer since + it might have been set by someone else. + (which-func-update-ediff-windows): Check which-function-mode. + +2014-09-03 Martin Rudalics <rudalics@gmx.at> + + * frame.el (frame-initialize): Remove horizontal-scroll-bars + from frame-initial-frame-alist. + * scroll-bar.el (previous-horizontal-scroll-bar-mode) + (horizontal-scroll-bar-mode-explicit) + (set-horizontal-scroll-bar-mode, get-horizontal-scroll-bar-mode) + (toggle-horizontal-scroll-bar): Remove. + (horizontal-scroll-bar-mode): Remove defcustom. + (horizontal-scroll-bar-mode): Fix doc-string. + (scroll-bar-toolkit-scroll) + (scroll-bar-toolkit-horizontal-scroll): Add doc-strings stubs. + +2014-09-03 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/package.el (package-generate-description-file): Properly quote the arguments (bug#18332). Change second arg. @@ -952,7 +5545,7 @@ * progmodes/gud.el (gud-gdb-completion-at-point): Add hack (bug#18282). (gud-gdb-completions): Remove obsolete workaround. -2014-09-02 Eli Zaretskii <eliz@gnu.org> +2014-09-03 Eli Zaretskii <eliz@gnu.org> * subr.el (posn-col-row): Revert the change from commit 2010-11-13T21:07:58Z!eliz@gnu.org, which @@ -961,89 +5554,339 @@ introduced an off-by-one error in the reported row when there is a header line. (Bug#18384) -2014-09-01 Fabián Ezequiel Gallina <fgallina@gnu.org> +2014-09-03 Fabián Ezequiel Gallina <fgallina@gnu.org> * progmodes/python.el (python-indent-post-self-insert-function): Avoid electric colon at beginning-of-defun. (Bug#18228) -2014-09-01 Glenn Morris <rgm@gnu.org> +2014-09-03 Glenn Morris <rgm@gnu.org> * tutorial.el (tutorial--display-changes): - Fix 2014-07-29 change. (Bug#18382) + Fix 2014-08-01 change. (Bug#18382) -2014-08-29 Ken Brown <kbrown@cornell.edu> +2014-09-03 Ken Brown <kbrown@cornell.edu> * startup.el (fancy-splash-frame): Extend the fix for Bug#16014 to the Cygwin-w32 build. (Bug#18347) -2014-08-28 Glenn Morris <rgm@gnu.org> +2014-09-03 Glenn Morris <rgm@gnu.org> * tar-mode.el (tar--extract, tar-extract): Avoid permanently disabling undo in extracted buffers. (Bug#18344) -2014-08-27 Michael Albinus <michael.albinus@gmx.de> +2014-09-03 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/sh-script.el (sh-font-lock-quoted-subshell): Try to better + handle multiline elements (bug#18380). + +2014-09-01 Eli Zaretskii <eliz@gnu.org> + + * ls-lisp.el (ls-lisp-use-string-collate) + (ls-lisp-UCA-like-collation): New defcustoms. + (ls-lisp-string-lessp): Use them to control sorting by file + names. (Bug#18051) + (ls-lisp-version-lessp): New function. + (ls-lisp-handle-switches): Use it to implement the -v switch of + GNU ls. + (ls-lisp--insert-directory): Mention the -v switch in the doc string. + +2014-08-31 Christoph Scholtes <cschol2112@gmail.com> + + * ibuffer.el: Replace mode-specific quit function with + `quit-window' via `special-mode'. + (ibuffer-mode-map): Use keybindings from special-mode-map instead + of local overrides. + (ibuffer): Don't store previous windows configuration. + Let `quit-window' handle restoring. + (ibuffer-quit): Remove function. Use `quit-window' instead. + (ibuffer-restore-window-config-on-quit): Remove variable. + (ibuffer-prev-window-config): Remove variable. + +2014-08-29 Michael Heerdegen <michael_heerdegen@web.de> + + * emacs-lisp/easy-mmode.el (define-minor-mode): Use mode function + name instead of variable name in hook docstring. (Bug#18349) + +2014-08-29 Martin Rudalics <rudalics@gmx.at> + + * window.el (display-buffer-at-bottom): Prefer bottom-left + window to other bottom windows. Reuse a bottom window if it + shows the buffer already. Suggested by Juri Linkov + <juri@jurta.org> in discussion of (Bug#18181). + +2014-08-29 Leo Liu <sdl.web@gmail.com> + + * files.el (minibuffer-with-setup-hook): Allow (:append FUN) to + append to minibuffer-setup-hook. (Bug#18341) + +2014-08-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/cc-defs.el: Expose c-lanf-defconst's expressions to the + byte-compiler. + (lookup-syntax-properties): Silence byte-compiler. + (c-lang-defconst): Quote the code with `lambda' rather than with + `quote'. + (c-lang-const): Avoid unneeded setq. + (c-lang-constants-under-evaluation): Add docstring. + (c-lang--novalue): New constant. + (c-find-assignment-for-mode): Use it instead of c-lang-constants. + (c-get-lang-constant): Same here. + Get the mode's value using `funcall' now that the code is quoted + with `lambda'. + +2014-08-28 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-handle-shell-command): Use `display-buffer'. + (Bug#18326) + +2014-08-28 Martin Rudalics <rudalics@gmx.at> - * emacs-lisp/authors.el (authors-aliases): Addition. + * scroll-bar.el (scroll-bar-horizontal-drag-1): Handle new + interpretation of `portion-whole'. + +2014-08-28 Michael Albinus <michael.albinus@gmx.de> * net/tramp-adb.el: Spell author name correctly. -2014-08-27 João Távora <joaotavora@gmail.com> +2014-08-28 João Távora <joaotavora@gmail.com> * net/shr.el (shr-expand-url): Plain expand-file-name is not enough; use url-expand-file-name. (Bug#18310) -2014-08-25 Glenn Morris <rgm@gnu.org> +2014-08-28 Glenn Morris <rgm@gnu.org> * emulation/cua-rect.el (cua--highlight-rectangle): Avoid error at point-min. (Bug#18309) -2014-08-18 Stefan Monnier <monnier@iro.umontreal.ca> +2014-08-28 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/python.el (python-shell-prompt-detect): Remove redundant executable-find (bug#18244). * simple.el (self-insert-uses-region-functions): Defvar. -2014-08-13 Leo Liu <sdl.web@gmail.com> +2014-08-28 Glenn Morris <rgm@gnu.org> + + * subr.el (remq): Revert 2014-08-25 doc change (not always true). + +2014-08-27 Dmitry Antipov <dmantipov@yandex.ru> + + * startup.el (normal-top-level): Now use internal--top-level-message. + +2014-08-26 Dmitry Antipov <dmantipov@yandex.ru> + + * startup.el (normal-top-level): Use top-level-message. + +2014-08-25 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/shr.el (shr-copy-url): Encode copied URL to avoid getting + URLs containing spaces and the like. + +2014-08-25 Christoph Scholtes <cschol2112@gmail.com> + + * subr.el (remq): Fix docstring (Bug#18253). + +2014-08-25 Christoph Scholtes <cschol2112@gmail.com> + + * replace.el (query-replace): Fix typo in docstring (Bug#18320). + +2014-08-24 Alan Mackenzie <acm@muc.de> + + Handle C++11's "auto" and "decltype" constructions. + * progmodes/cc-engine.el (c-forward-type): Enhance to recognise + and return 'decltype. + (c-forward-decl-or-cast-1): New let variables backup-kwd-sym, + prev-kwd-sym, new-style-auto. Enhance to handle the new "auto" + keyword. + * progmodes/cc-fonts.el (c-font-lock-declarations): Handle the + "decltype" keyword. + (c-font-lock-c++-new): Handle "decltype" constructions. + * progmodes/cc-langs.el (c-auto-ops, c-auto-ops-re): + New c-lang-defconsts/defvars. + (c-haskell-op, c-haskell-op-re): New c-lang-defconsts/defvars. + (c-typeof-kwds, c-typeof-key): New c-lang-defconsts/defvars. + (c-typeless-decl-kwds): Append "auto" onto the C++ value. + (c-not-decl-init-keywords): Also exclude c-typeof-kwds from value. + + Make ">>" act as double template ender in C++ Mode. (Bug#11386) + * progmodes/cc-langs.el (c->-op-cont-tokens): New lang-const split + off from c->-op-cont-re. + (c->-op-cont-tokens): Change to use the above. + (c->-op-without->-cont-regexp): New lang-const. + * progmodes/cc-engine.el (c-forward-<>-arglist-recur): + Use c->-op-without->-cont-regexp in place of c->-op-cont-tokens. + + +2014-08-23 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-fonts.el (c-font-lock-declarators): Fix infinite + loop, bug #18306. The bug was introduced on 2014-08-02. + +2014-08-21 Eli Zaretskii <eliz@gnu.org> + + * textmodes/texnfo-upd.el (texinfo-specific-section-type): + Don't recognize a Top node if there are other sectioning commands + earlier in the Texinfo file. This fixes a bug in + texinfo-make-menu and avoids inflooping in + texinfo-all-menus-update when they are invoked on texinfo.texi. + +2014-08-21 Martin Rudalics <rudalics@gmx.at> + + * window.el (window--side-window-p): New function. + (split-window, window-splittable-p): Use window--side-window-p to + determine whether WINDOW can be split (Bug#18304). + * calendar/calendar.el (calendar-basic-setup): Fix one call of + `window-splittable-p' and add another (Bug#18304). + +2014-08-20 Sam Steingold <sds@gnu.org> + + * progmodes/python.el (python-new-pythonpath): Extract from + `python-shell-calculate-process-environment'. + +2014-08-18 Thierry Volpiatto <thierry.volpiatto@gmail.com> + + * emacs-lisp/eldoc.el (eldoc-highlight-function-argument): Add support + for &key args (bug#18048). + +2014-08-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eldoc.el (eldoc-argument-case): Obsolete and change default. + (eldoc-function-argstring-format): Remove. + (eldoc-function-argstring): Always return upcase args. + Use help-make-usage. Don't add parens. + (eldoc-get-fnsym-args-string): Don't obey eldoc-argument-case since + it's too late to do it right (bug#18048). + +2014-08-18 Eli Zaretskii <eliz@gnu.org> + + * scroll-bar.el (scroll-bar-horizontal-drag-1) + (scroll-bar-toolkit-horizontal-scroll): When determining the + paragraph direction, use the buffer of the window designated in + the event. + +2014-08-16 Andreas Schwab <schwab@linux-m68k.org> + + * vc/diff-mode.el (diff-fixup-modifs): Handle empty line in + context of unified diff. + +2014-08-16 Paul Eggert <eggert@cs.ucla.edu> + + Add dependencies to fix loaddefs race during parallel builds. + Without this, for example, 'make -j bootstrap' can fail and report + "Opening input file: no such file or directory, + .../lisp/calendar/diary-loaddefs.el ... recipe for target + 'calendar/hol-loaddefs.el' failed", where the hol-loaddefs.el rule + got confused because diary-loaddefs.el was being built in parallel. + * Makefile.in ($(CAL_DIR)/diary-loaddefs.el): + Depend on $(CAL_DIR)/cal-loaddefs.el. + ($(CAL_DIR)/hol-loaddefs.el): Depend on $(CAL_DIR)/diary-loaddefs.el. + +2014-08-16 Martin Rudalics <rudalics@gmx.at> + + * scroll-bar.el (scroll-bar-horizontal-drag-1): Use cdr of + portion-whole for scrolling right-to-left text. + +2014-08-15 Leo Liu <sdl.web@gmail.com> * speedbar.el (speedbar-generic-list-tag-p): Allow special elements from imenu. -2014-08-11 Glenn Morris <rgm@gnu.org> +2014-08-15 Glenn Morris <rgm@gnu.org> * subr.el (with-output-to-temp-buffer): Doc fix; from elisp manual. +2014-08-13 Jan Nieuwenhuizen <janneke@gnu.org> + + * progmodes/compile.el (compilation-error-regexp-alist-alist): + Add Guile regexpses. + +2014-08-13 Jan Nieuwenhuizen <janneke@gnu.org> + + * progmodes/gud.el (guiler): New function. Starts the Guile REPL; + add Guile debugger support for GUD. + +2014-08-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * obsolete/mouse-sel.el (mouse-sel-mode): Use add/remove-function. + (mouse-sel--ignore): New function. + (mouse-sel-has-been-enabled, mouse-sel-original-bindings) + (mouse-sel-original-interprogram-cut-function) + (mouse-sel-original-interprogram-paste-function): Remove. + +2014-08-13 Eric S. Raymond <esr@thyrsus.com> + + * vc/vc-git.el (vc-git-resolve-when-done): New function. + Call "git add" when there are no longer conflict markers. + +2014-08-13 Rüdiger Sonderfeld <ruediger@c-plusplus.de> + + * vc/vc-git.el (vc-git-find-file-hook): New function. + Adds support for calling smerge (and resolve) on a conflicted file. + (vc-git-conflicted-files): New function. + Useful in itself and a step towards better smerge support. + +2014-08-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * mpc.el (mpc-reorder): Don't bother splitting the "active" elements + to the first part if they're the same as the selection. + +2014-08-12 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * image-mode.el (image-transform-reset): New command and menu item. + (image-mode-map): Rearrange the menu items to put presumably more + obscure items at the end. + +2014-08-12 Juri Linkov <juri@jurta.org> + + * vc/vc-annotate.el (vc-annotate-background-mode): + Use `with-demoted-errors' instead of `ignore-errors'. (Bug#18189) + +2014-08-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * files.el (out-of-memory-warning-percentage): Turn it off by default. + +2014-08-11 Sam Steingold <sds@gnu.org> + + * textmodes/sgml-mode.el (sgml-validate-command): Set depending on + the presence of known validators (tidy, (o)nsgmls). + +2014-08-11 Ulf Jasper <ulf.jasper@web.de> + + Newsticker: introduce `newsticker-treeview-date-format'. (Bug#17227) + * net/newst-treeview.el (newsticker-treeview-date-format): New. + (newsticker--treeview-list-add-item): + Use `newsticker-treeview-date-format'. + +2014-08-11 Glenn Morris <rgm@gnu.org> + * files.el (basic-save-buffer-2): Revert 2013-01-31 change, which chose coding system for writing before backing up, since it causes a more serious problem than the one it solves. (Closes Bug#18141, reopens Bug#13522.) -2014-08-10 Martin Rudalics <rudalics@gmx.at> +2014-08-11 Martin Rudalics <rudalics@gmx.at> - * window.el (window-total-size): Make doc-string more - self-contained. - -2014-08-09 Martin Rudalics <rudalics@gmx.at> + * window.el (window-total-size): Make doc-string more self-contained. * window.el (display-buffer-below-selected): Restore original behavior if buffer is already displayed in the window below the selected one (Bug#18181). -2014-08-08 Stefan Monnier <monnier@iro.umontreal.ca> +2014-08-11 Stefan Monnier <monnier@iro.umontreal.ca> * mouse.el (mouse--down-1-maybe-follows-link): Don't convert the down event (bug#18212). -2014-08-08 Eli Zaretskii <eliz@gnu.org> +2014-08-11 Eli Zaretskii <eliz@gnu.org> * info.el (info): Doc fix. -2014-08-07 Stefan Monnier <monnier@iro.umontreal.ca> +2014-08-11 Stefan Monnier <monnier@iro.umontreal.ca> * info.el (Info-mode-map): Override a global down-mouse-2 binding (bug#18212). -2014-08-05 Eli Zaretskii <eliz@gnu.org> +2014-08-11 Eli Zaretskii <eliz@gnu.org> * simple.el (default-line-height): A floating-point value of line-spacing means a fraction of the default frame font's height, @@ -1052,37 +5895,220 @@ (window-screen-lines): Use window-inside-pixel-edges for determining the window height in pixels. (Bug#18195) -2014-07-29 Eli Zaretskii <eliz@gnu.org> +2014-08-11 Grégoire Jadi <daimrod@gmail.com> + + * leim/quail/latin-post.el: Transform " __" into " _". (Bug#18023) + +2014-08-10 Ulf Jasper <ulf.jasper@web.de> + + Enumerate evaluated sexp diary entries (Bug#7911). + * calendar/icalendar.el (icalendar-export-sexp-enumerate-all) + (icalendar-export-sexp-enumeration-days): New. + (icalendar-export-region): Now `icalendar--convert-to-ical' + returns a cons cell or a list of cons cells. + (icalendar--convert-to-ical): Take care of + `icalendar-export-sexp-enumerate-all'. Return (a list of) cons cells. + (icalendar--convert-ordinary-to-ical) + (icalendar--convert-weekly-to-ical, icalendar--convert-yearly-to-ical) + (icalendar--convert-block-to-ical, icalendar--convert-block-to-ical) + (icalendar--convert-float-to-ical, icalendar--convert-cyclic-to-ical) + (icalendar--convert-anniversary-to-ical): Return cons cell. + (icalendar--convert-sexp-to-ical): Enumerate evaluated sexp + entries. Return (list of) cons cells. + +2014-08-09 Juri Linkov <juri@jurta.org> + + * vc/vc-annotate.el (vc-annotate-background-mode): Add :set + to reevaluate `vc-annotate-color-map'. (Bug#18189) + +2014-08-09 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-fonts.el (c-font-lock-declarators): Remove check + for top-level that can cause unacceptable slow-down in scrolling. + See email Subject: Huge {...} blocks in C/C++ again, from Dmitry + Antipov from 2013-10-14 in emacs-devel. + +2014-08-08 Rüdiger Sonderfeld <ruediger@c-plusplus.de> + + * ibuffer.el (ibuffer-mode-map): Use toggle button for + `ibuffer-auto-mode' menu entry. + (ibuffer-mode-hook): Add `ibuffer-auto-mode' customization option. + +2014-08-08 Matthias Meulien <orontee@gmail.com> + + * progmodes/prog-mode.el (prog-mode-hook): Make customizable. + (Bug#16394) + +2014-08-07 Martin Rudalics <rudalics@gmx.at> + + * window.el (window--min-size-1): Explicitly set WINDOW arg in + calls of window-min-pixel-height and window-min-pixel-width. + +2014-08-07 Reuben Thomas <rrt@sc3d.org> + + * progmodes/ada-mode.el: + * net/tramp.el (tramp-handle-file-symlink-p): + * net/tramp-ftp.el (tramp-ftp-file-name-handler): Remove a comment + about VMS, which we no longer support. + * progmodes/ada-xref.el (ada-xref-current): Remove mention of VMS, + and fix a FIXME, using convert-standard-filename in place of + removed ada-convert-file-name. + +2014-08-07 Eli Zaretskii <eliz@gnu.org> + + * files.el (auto-mode-alist): Remove support for VMS from a pattern. + +2014-08-07 Reuben Thomas <rrt@sc3d.org> + + Refer to MS-DOS using the same name everywhere. + * arc-mode.el, files.el, frame.el: ``MS-DOG'', ``MSDOG'' and + ``msdog'' become ``MS-DOS''. + +2014-08-07 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): + Use cached "remote-copy-args" value, if available. (Bug#18199) + +2014-08-07 Leo Liu <sdl.web@gmail.com> + + * help.el (temp-buffer-setup-hook,temp-buffer-show-hook): + Revert change on 2014-03-22. + +2014-08-06 Ulf Jasper <ulf.jasper@web.de> + + * calendar/icalendar.el (icalendar--diarytime-to-isotime) + (icalendar--convert-ordinary-to-ical): Allow for missing minutes + (Bug#13750). + + +2014-08-05 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * image-mode.el (image-toggle-display-image): Always rescale images + to not be bigger than the current window. + +2014-08-05 Eric Brown <brown@fastmail.fm> (tiny change) + + * net/eww.el (eww-bookmarks-directory): New variable. + (eww-write-bookmarks): Use it. + (eww-read-bookmarks): Ditto. + +2014-08-05 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/shr.el (shr-copy-url): Also copy the image URL. + +2014-08-05 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-cache.el (tramp-flush-file-function): Suppress function + also for Tramp working buffers. + +2014-08-04 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * progmodes/python.el: Fix completions inside (i)pdb. + (python-shell-completion-pdb-string-code): Make obsolete. + (python-shell-completion-get-completions): + Use python-shell-completion-string-code resending setup code + continuously for (i)pdb. + +2014-08-04 Paul Eggert <eggert@cs.ucla.edu> + + * rect.el (rectangle--default-line-number-format): Rename + from misspelled rectange--default-line-number-format (Bug#18045). + All uses changed. + +2014-08-03 Paul Eggert <eggert@cs.ucla.edu> + + Don't mishandle year-9999 dates (Bug#18176). + * calendar/parse-time.el (parse-time-rules): + Allow years up to most-positive-fixnum. + * calendar/time-date.el (date-to-time): + Pass "Specified time is not representable" errors through. + +2014-08-02 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * progmodes/python.el: Completion code cleanups. + (python-shell-completion-get-completions): Detect and send import + statements directly to completion function. + (python-shell-completion-at-point): Simplify prompt calculation + and import vs input completion logic. + +2014-08-02 Alan Mackenzie <acm@muc.de> + + Fix confusion in C++ file caused by comma in "= {1,2},". + Bug #17756. + * progmodes/cc-engine.el (c-beginning-of-statement-1): In checking + for a statement boundary marked by "}", check there's no "=" + before the "{". + (c-guess-basic-syntax CASE 9B): Call c-beginning-of-statement with + non-nil `comma-delim' argument. + * progmodes/cc-fonts.el (c-font-lock-declarators): Parse an + initializer expression more accurately. + + Correct loop termination condition in c-syntactic-skip-backward. + * progmodes/cc-engine.el (c-syntactic-skip-backward): Correct for + the situation where, after moving back out of a literal, + skip-chars-backward doesn't move further, yet checks have still to + be done. + +2014-08-01 Eli Zaretskii <eliz@gnu.org> * tutorial.el (tutorial--display-changes): Accept punctuation characters before the key binding. (Bug#18146) -2014-07-28 Stephen Berman <stephen.berman@gmx.net> +2014-07-31 Fabián Ezequiel Gallina <fgallina@gnu.org> - * doc-view.el (doc-view-open-text): Don't require that the - document is saved in a file (e.g., email attachment). + * progmodes/python.el: Shell output capture enhancements. + (python-shell-accept-process-output): New function. + (inferior-python-mode) + (python-shell-send-setup-code): Use it. -2014-07-27 Eli Zaretskii <eliz@gnu.org> +2014-07-30 Christophe Deleuze <christophe.deleuze@free.fr> (tiny change) + + * calendar/icalendar.el (icalendar--decode-isodatetime): + Use actual current-time-zone when converting to local time. (Bug#15408) + +2014-07-29 Martin Rudalics <rudalics@gmx.at> + + * window.el (window--state-put-2): Handle horizontal scroll + bars, if present. + +2014-07-29 Rüdiger Sonderfeld <ruediger@c-plusplus.de> + + * menu-bar.el (menu-bar-update-buffers): Update item list format + in `buffers-menu' to confirm with changes to `get_keyelt' + (r117463). (Bug#18016) + +2014-07-28 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * progmodes/python.el (inferior-python-mode): Make input prompts + read-only. + +2014-07-28 Emilio C. Lopes <eclig@gmx.net> + + * net/tramp-sh.el (tramp-get-remote-python): Also search for + executables named "python2" or "python3". + (tramp-get-remote-uid-with-python): Use parentheses around + arguments to `print' to make it compatible with Python 3. + (tramp-get-remote-gid-with-python): Ditto. (Bug#18118) + +2014-07-28 Eli Zaretskii <eliz@gnu.org> * window.el (window--pixel-to-total): Use FRAME's root window, not that of the selected frame. (Bug#18112, Bug#16674) -2014-07-27 Andreas Schwab <schwab@linux-m68k.org> +2014-07-28 Andreas Schwab <schwab@linux-m68k.org> * textmodes/tex-mode.el (tex-font-lock-verb): Doc fix. (Bug#18117) -2014-07-27 Fabián Ezequiel Gallina <fgallina@gnu.org> +2014-07-28 Fabián Ezequiel Gallina <fgallina@gnu.org> * progmodes/python.el (inferior-python-mode): Doc fix. -2014-07-25 Stephen Berman <stephen.berman@gmx.net> +2014-07-28 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el (todo-edit-item--next-key): If next key is not a character, ignore it instead of raising an error. -2014-07-25 Stephen Berman <stephen.berman@gmx.net> - * calendar/todo-mode.el: Fix handling of marked items and make minor code improvements. (todo-edit-item): If there are marked items, ensure user can only @@ -1096,7 +6122,7 @@ (todo-edit-item--header, todo-edit-item--diary-inclusion) (todo-item-done): Use it. -2014-07-25 Glenn Morris <rgm@gnu.org> +2014-07-28 Glenn Morris <rgm@gnu.org> * files.el (toggle-read-only): Re-add basic doc-string. * vc/vc-hooks.el (vc-toggle-read-only): Tweak obsolescence mesage. @@ -1105,11 +6131,183 @@ Replace missing `switch-to-prolog' with `run-prolog'. (switch-to-prolog): Define as (obsolete) alias, as in 23.4. -2014-07-22 Stephen Berman <stephen.berman@gmx.net> +2014-07-28 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el (todo-set-top-priorities): Fix overwriting of file-wide setting when changing category-wide setting. +2014-07-28 Stephen Berman <stephen.berman@gmx.net> + + * doc-view.el (doc-view-open-text): Don't require that the + document is saved in a file (e.g., email attachment). + +2014-07-28 Fabián Ezequiel Gallina <fgallina@gnu.org> + + Parse completion input in a iPython friendly way. (Bug#18084) + * progmodes/python.el + (python-shell-completion-at-point): Rename from + python-shell-completion-complete-at-point. + (inferior-python-mode): Use it. + (python-completion-at-point): Rename from + python-completion-complete-at-point. Parse input up to first + backward occurrence of whitespace, open-paren, close-paren or + string delimiter. + (python-mode): Use it. + +2014-07-28 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * progmodes/python.el + (python-shell-with-shell-buffer): New macro. + (python-shell-font-lock-get-or-create-buffer) + (python-shell-font-lock-kill-buffer) + (python-shell-font-lock-with-font-lock-buffer) + (python-shell-font-lock-cleanup-buffer) + (python-shell-font-lock-toggle): Use it. + (python-shell-font-lock-turn-on) + (python-shell-font-lock-turn-off): Use it. Make command. + +2014-07-28 Fabián Ezequiel Gallina <fgallina@gnu.org> + + Grab all Python process output before inferior-python-mode hooks. + * progmodes/python.el (inferior-python-mode): + Call accept-process-output and sit-for to ensure all output for process + has been received before running hooks. + (python-shell-internal-get-or-create-process): + Cleanup accept-process-output and sit-for calls. + +2014-07-28 Fabián Ezequiel Gallina <fgallina@gnu.org> + + More robust shell startup and code setup. + * progmodes/python.el (python-shell-make-comint): + Remove accept-process-output call. + (python-shell-get-buffer): Return current buffer if major-mode is + inferior-python-mode. + (python-shell-get-or-create-process): Use it. + (python-shell-send-setup-code): Send all setup code in one string, + output success message and accept-process-output. + +2014-07-27 Eli Zaretskii <eliz@gnu.org> + + * scroll-bar.el (scroll-bar-toolkit-horizontal-scroll): + Add rudimentary support for bidirectional text. + +2014-07-27 Martin Rudalics <rudalics@gmx.at> + + * frame.el (frame-notice-user-settings): Rewrite using + frame-initial-frame-tool-bar-height. + * menu-bar.el (menu-bar-horizontal-scroll-bar) + (menu-bar-no-horizontal-scroll-bar): New functions. + (menu-bar-showhide-scroll-bar-menu): Add bindings for horizontal + scroll bars. + * scroll-bar.el (scroll-bar-lines) + (set-horizontal-scroll-bar-mode) + (get-horizontal-scroll-bar-mode, horizontal-scroll-bar-mode) + (scroll-bar-horizontal-drag-1, scroll-bar-horizontal-drag) + (scroll-bar-toolkit-horizontal-scroll): New functions. + (horizontal-scroll-bar-mode) + (previous-horizontal-scroll-bar-mode) + (horizontal-scroll-bar-mode-explicit): New variables. + (horizontal-scroll-bar-mode): New option. + (toggle-horizontal-scroll-bar): Do something. + (top-level): Bind horizontal-scroll-bar mouse-1. + * startup.el (tool-bar-originally-present): Remove variable. + (command-line): Don't set tool-bar-originally-present. + * window.el (window-min-height): Update doc-string. + (window--dump-frame): Dump horizontal scroll bar values. + (window--min-size-1): Handle minibuffer window separately. + Count in margins and horizontal scroll bar. Return safe value + iff IGNORE equals 'safe. + (frame-windows-min-size): New function (used by frame resizing + routines). + (fit-frame-to-buffer, fit-window-to-buffer): Count in horizontal + scroll bars. + (window--sanitize-window-sizes): New function. + (window-split-min-size): Remove. + (split-window): Count divider-width. Don't use + `window-split-min-size' any more. Reword error messages. + Sanitize windows sizes after splitting. + +2014-07-27 Thien-Thi Nguyen <ttn@gnu.org> + + Use `defvar-local' more. + * progmodes/hideshow.el + (hs-c-start-regexp, hs-block-start-regexp) + (hs-block-start-mdata-select, hs-block-end-regexp) + (hs-forward-sexp-func, hs-adjust-block-beginning): ...here; + remove corresponding `make-variable-buffer-local' top-level calls. + +2014-07-27 Fabián Ezequiel Gallina <fgallina@gnu.org> + + Cleanup error signals. (Bug#18067) + * progmodes/python.el + (python-indent-shift-left): Use user-error instead. + (python-shell-prompt-detect): Use lwarn with python group. + (python-completion-complete-at-point) + (python-eldoc--get-doc-at-point): Don't signal error. + +2014-07-27 Fabián Ezequiel Gallina <fgallina@gnu.org> + + Support for packages in Python shell. (Bug#13570) + * progmodes/python.el (python-shell--package-depth): New var. + (python-shell-package-enable): New command. + (python-util-list-directories, python-util-list-files) + (python-util-list-packages): New functions. + +2014-07-27 Fabián Ezequiel Gallina <fgallina@gnu.org> + + Faster comint output. (Bug#16875) + * progmodes/python.el: + (python-comint-output-filter-function): Make obsolete. + (python-comint-postoutput-scroll-to-bottom): New function. + (inferior-python-mode): Set comint-output-filter-functions to a + minimum. + +2014-07-27 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * progmodes/python.el (python-shell-font-lock-post-command-hook): + Safeguard current point and undo history. + +2014-07-26 Fabián Ezequiel Gallina <fgallina@gnu.org> + + Robust shell syntax highlighting. (Bug#18084, Bug#16875) + * progmodes/python.el: + (python-shell-prompt-input-regexps): Add iPython block prompt. + (python-shell-output-syntax-table): Delete var. + (python-shell-font-lock-with-font-lock-buffer): New macro. + (python-shell-font-lock-get-or-create-buffer) + (python-shell-font-lock-kill-buffer) + (python-shell-font-lock-cleanup-buffer) + (python-shell-font-lock-post-command-hook) + (python-shell-font-lock-turn-off): New functions. + (python-shell-font-lock-turn-on): New function. + (inferior-python-mode): Use it. + (python-shell-font-lock-toggle): New command. + (python-shell-font-lock-enable): Rename from + python-shell-enable-font-lock. + (run-python-internal): Use it. + (python-shell-font-lock-comint-output-filter-function): New function. + (python-shell-comint-end-of-output-p): New function. + (python-shell-output-filter): Use it. + (python-util-comint-last-prompt): New function. + (python-util-text-properties-replace-name): New function. + +2014-07-25 Glenn Morris <rgm@gnu.org> + + * vc/ediff-init.el (ediff-toggle-read-only-function): + * vc/ediff-util.el (ediff-toggle-read-only): + Replace obsolete toggle-read-only with read-only-mode. + +2014-07-24 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-cache.el (tramp-flush-file-function): Wrap the code + with `save-match-data'. (Bug#18095) + +2014-07-21 Vincent Belaïche <vincentb1@users.sourceforge.net> + + * ses.el (ses-truncate-cell): Use cl-progv instead of eval in + order to ensure that row and col are lexically bound inside the + evaluated sexp. + 2014-07-21 Glenn Morris <rgm@gnu.org> * progmodes/hideif.el (hide-ifdef-mode-submap): @@ -1124,19 +6322,15 @@ * progmodes/hideif.el (hide-ifdef-toggle-outside-read-only): Doc fixes re toggle-read-only. -2014-07-20 Fabián Ezequiel Gallina <fgallina@gnu.org> +2014-07-21 Fabián Ezequiel Gallina <fgallina@gnu.org> * progmodes/python.el: Add comment about pipe buffering and solutions for missing/delayed output in inferior Python shells. (Bug#17304) -2014-07-20 Fabián Ezequiel Gallina <fgallina@gnu.org> - * progmodes/python.el (python-mode): Don't set mode-require-final-newline. (Bug#17990) -2014-07-20 Fabián Ezequiel Gallina <fgallina@gnu.org> - Make python.el work with IPython automatically. (Bug#15510) * progmodes/python.el: (python-shell-completion-setup-code): New value supporting iPython. @@ -1147,14 +6341,10 @@ (python-shell-prompt-output-regexps): Add safeguard for ipdb. (python-shell-output-filter): Fix comment typo. -2014-07-19 Fabián Ezequiel Gallina <fgallina@gnu.org> - Fix Python shell prompts detection for remote hosts. * progmodes/python.el (python-shell-prompt-detect): Replace call-process with process-file and make it more robust. -2014-07-17 Fabián Ezequiel Gallina <fgallina@gnu.org> - Autodetect Python shell prompts. (Bug#17370) * progmodes/python.el: (python-shell-interpreter-interactive-arg) @@ -1171,9 +6361,9 @@ (python-shell-prompt-detect) (python-shell-prompt-validate-regexps): New functions. (python-shell-prompt-set-calculated-regexps): New function. - (inferior-python-mode): Use it. Also honor overridden + (inferior-python-mode): Use it. Also honor overriden python-shell-interpreter and python-shell-interpreter-args. - (python-shell-make-comint): Honor overridden + (python-shell-make-comint): Honor overriden python-shell-interpreter and python-shell-interpreter-args. (python-shell-get-or-create-process): Make it testable by allowing to call run-python non-interactively. @@ -1182,34 +6372,72 @@ (python-shell-prompt-output-regexp) (python-shell-prompt-pdb-regexp): Use it as defcustom :safe. +2014-07-21 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/smie.el (smie-config--guess-1): Split from + smie-config--guess. + (smie-config--guess): Use it. + + * emacs-lisp/edebug.el: Use nadvice. + (edebug-original-read): Remove. + (edebug--read): Rename from edebug-read and add `orig' arg. + (edebug-uninstall-read-eval-functions) + (edebug-install-read-eval-functions): Use nadvice. + (edebug-read-sexp, edebug-read-storing-offsets, edebug-read-symbol) + (edebug-read-and-maybe-wrap-form1, edebug-instrument-callee) + (edebug-read-string, edebug-read-function): Use just `read'. + (edebug-original-debug-on-entry): Remove. + (edebug--debug-on-entry): Rename from edebug-debug-on-entry and add + `orig' arg. + (debug-on-entry): Override with nadvice. + + * mouse.el (tear-off-window): Rename from mouse-tear-off-window since + it also makes sense to bind it to a non-mouse event. + + * vc/vc-bzr.el (vc-bzr-shelve): Make it operate on fileset. + +2014-07-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * xt-mouse.el (xterm-mouse-event): Don't assume last-click is non-nil + (bug#18015). + + * rect.el (rectangle--string-preview): Don't assume there + a non-nil default (bug#17984). + 2014-07-16 Glenn Morris <rgm@gnu.org> * desktop.el (after-init-hook): Disable startup frame restoration in non-graphical situations. (Bug#17693) -2014-07-14 Glenn Morris <rgm@gnu.org> - * vc/vc-dispatcher.el (vc-log-edit): Do set up the log buffer if it was "empty", or used for a different set of files. (Bug#17884) -2014-07-13 Eli Zaretskii <eliz@gnu.org> +2014-07-16 Eli Zaretskii <eliz@gnu.org> * bindings.el (mode-line-remote): If default-directory is not a string, don't call file-remote-p on it; instead state in the help-echo that it is nil. (Bug#17986) +2014-07-14 Daniel Colascione <dancol@dancol.org> + + * progmodes/cc-langs.el: Change comments from `cl-macroexpand-all' + to `macroexpand-all' + + * progmodes/cc-defs.el (c-lang-defconst-eval-immediately): + Use `macroexpand-all' instead of `cl-macroexpand-all'. + 2014-07-12 Paul Eggert <eggert@cs.ucla.edu> Fix bug: C-x v v discarded existing log message (Bug#17884). * vc/vc-dispatcher.el (vc-log-edit): Don't clobber an already-existing log message. -2014-07-10 Glenn Morris <rgm@gnu.org> +2014-07-12 Glenn Morris <rgm@gnu.org> * vc/log-edit.el (log-edit-changelog-entries): Check for a visited-but-never-saved ChangeLog. -2014-07-09 Stefan Monnier <monnier@iro.umontreal.ca> +2014-07-12 Stefan Monnier <monnier@iro.umontreal.ca> * vc/log-edit.el (log-edit-changelog-entries): Don't both visiting a non-existing file (bug#17970). @@ -1217,10 +6445,9 @@ * faces.el (face-name): Undo last change. (x-resolve-font-name): Don't call face-name (bug#17956). -2014-07-09 Fabián Ezequiel Gallina <fgallina@gnu.org> - - Fix dedenters and electric colon handling. (Bug#15163) +2014-07-12 Fabián Ezequiel Gallina <fgallina@gnu.org> + Fix dedenters and electric colon handling. (Bug#15163) * progmodes/python.el (python-rx-constituents): Add dedenter and block-ender. (python-indent-dedenters, python-indent-block-enders): Delete. @@ -1237,36 +6464,62 @@ (python-info-dedenter-opening-block-positions) (python-info-dedenter-statement-p): New functions. -2014-07-08 Stefan Monnier <monnier@iro.umontreal.ca> +2014-07-11 Dmitry Antipov <dmantipov@yandex.ru> + + * files.el (out-of-memory-warning-percentage): New defcustom. + (warn-maybe-out-of-memory): Use it. + +2014-07-11 Michael Albinus <michael.albinus@gmx.de> + + * subr.el (read-passwd): Use `read-hide-char' if non-nil. Bind it + when calling `read-string'. (Bug#17839) + +2014-07-10 Eli Zaretskii <eliz@gnu.org> + + * files.el (warn-maybe-out-of-memory): Fix the wording of the + warning. + +2014-07-10 Dmitry Antipov <dmantipov@yandex.ru> + + * files.el (warn-maybe-out-of-memory): New function. + (find-file-noselect): Use it. + +2014-07-09 Sam Steingold <sds@gnu.org> + + * progmodes/cperl-mode.el (cperl-block-p): Treat the perl keyword + `constant' like `bless', `return' &c + +2014-07-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * rect.el (apply-on-rectangle): Check forward-line really moved to the + next line. + +2014-07-09 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/sh-script.el (sh-smie-sh-rules): Don't align with a && in the middle of a line (bug#17896). -2014-07-08 Juri Linkov <juri@jurta.org> +2014-07-09 Juri Linkov <juri@jurta.org> * startup.el (command-line): Append displaying the warning about the errors in the init file to the end of `after-init-hook'. (Bug#17927) -2014-07-08 Juri Linkov <juri@jurta.org> - - * faces.el (face-name): Return input arg `face' as is + * faces.el (face-name): Return input arg `face' as-is when it's not a symbol. (x-resolve-font-name): Don't check if the face is a symbol. (Bug#17956) -2014-07-08 Juri Linkov <juri@jurta.org> - * facemenu.el (list-colors-print): In help-echo format use %.2f instead of %d because now HSV values are floating-point components between 0.0 and 1.0. -2014-07-06 Glenn Morris <rgm@gnu.org> +2014-07-09 Glenn Morris <rgm@gnu.org> * emulation/cua-rect.el (cua--activate-rectangle): Avoid setting cua--rectangle to nil. (Bug#17877) -2014-07-06 Stephen Berman <stephen.berman@gmx.net> +2014-07-09 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el: Fix wrong-type-argument error when marking multiple consecutive items. @@ -1277,7 +6530,7 @@ (todo-mark-category): Don't try to mark the empty line between the todo and done items sections. -2014-07-05 Stefan Monnier <monnier@iro.umontreal.ca> +2014-07-09 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/edebug.el (edebug-eval-defun): Print result using proper Lisp quoting (bug#17934). @@ -1285,7 +6538,7 @@ * progmodes/ruby-mode.el (ruby-mode-variables): Don't meddle with require-final-newline since prog-mode already took care of it (bug#17947). -2014-07-04 Stephen Berman <stephen.berman@gmx.net> +2014-07-09 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el: Fix two bugs. Shorten Commentary and refer to the Todo mode Info manual. Update the comment on @@ -1294,57 +6547,167 @@ (todo-filter-items): Reorder a let-bound variable to avoid a wrong-type-argument error on canceling the file choice dialog. -2014-07-04 Stefan Monnier <monnier@iro.umontreal.ca> +2014-07-09 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/octave.el (inferior-octave-mode): Set comint-input-ring-size to a number (bug#17912). -2014-07-03 Juri Linkov <juri@jurta.org> +2014-07-09 Juri Linkov <juri@jurta.org> * desktop.el (desktop-minor-mode-table): Add `defining-kbd-macro' and `isearch-mode' associated with nil. (Bug#17849) -2014-07-02 Juri Linkov <juri@jurta.org> +2014-07-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * linum.el (linum--face-height): New function (bug#17813). + (linum-update-window): Use it to adjust margin to linum's width. + + * leim/quail/sisheng.el (sisheng-list): Don't bother with-case-table. + * eshell/em-smart.el (eshell-smart-scroll-window): + Use with-selected-window. + + * xt-mouse.el (xterm-mouse-translate-1): Intern drag event (bug#17894). + Remove also pointless window&mark manipulation. + + * progmodes/perl-mode.el: Use syntax-ppss; fix one indentation case. + (perl-indent-line): Use syntax-ppss to detect we're in a doc-section. + (perl-continuation-line-p): Don't skip over anything else than labels. + Return the previous char. + (perl-calculate-indent): Use syntax-ppss instead of parse-start + and update callers accordingly. For continuation lines, check the + the case of array hashes. + (perl-backward-to-noncomment): Make it non-interactive. + (perl-backward-to-start-of-continued-exp): Rewrite. + +2014-07-08 Sam Steingold <sds@gnu.org> + + * progmodes/inf-lisp.el (lisp-eval-paragraph, lisp-eval-form-and-next): + New user commands. + +2014-07-08 Juri Linkov <juri@jurta.org> + + * vc/vc-annotate.el (vc-annotate-background-mode): New defcustom. + (vc-annotate-color-map): Use less saturated colors (20%) for + background-mode. + (vc-annotate-very-old-color): Add default value for background-mode. + (vc-annotate-background): Set default value to nil since now text on + the default backgrounds should be legible in light and dark modes. + (vc-annotate-lines): Use `vc-annotate-background-mode'. Doc fix. + (Bug#17808) + +2014-07-08 Juri Linkov <juri@jurta.org> + + * simple.el (transpose-chars): Don't move point into read-only area. + (Bug#17829) + +2014-07-08 Juri Linkov <juri@jurta.org> + + * window.el (with-displayed-buffer-window): New macro. + (with-temp-buffer-window, with-current-buffer-window): + Use `macroexp-let2' to evaluate and bind variables + in the same order as macro arguments. + (display-buffer--action-function-custom-type): + Add `display-buffer-below-selected' and `display-buffer-at-bottom'. + + * minibuffer.el (minibuffer-completion-help): Replace + `with-output-to-temp-buffer' with `with-displayed-buffer-window' + with actions that display *Completions* at-bottom when called + from the minibuffer, or below-selected in a normal buffer. + Associate `window-height' with `fit-window-to-buffer'. + Let-bind `pop-up-windows' to nil. + + * dired.el (dired-mark-pop-up): Use `with-displayed-buffer-window' + instead of `with-current-buffer-window'. (Bug#17809) + +2014-07-07 Luke Lee <luke.yx.lee@gmail.com> + + * progmodes/hideif.el (hide-ifdef-env): Change to global. + (hide-ifdef-env-backup): New variable. + (hide-ifdef-expand-reinclusion-protection, hide-ifdef-header-regexp): + New customizable variables. + (hif-clear-all-ifdef-defined): New defun. + (hif-merge-ifdef-region, hide-ifdef-region-internal, hide-ifdef-region) + (hif-show-ifdef-region): Merge hidden regions to prevent continuous "...". + (hif-tokenize): Fix for MS-DOS/Win EOL style. + (hif-endif-to-ifdef, hif-make-range, hif-find-range, hif-possibly-hide): + Fix bug to hide the correct #elif region(s). + (hif-range-elif): New defun. + (hif-recurse-level): New var. + (hif-evaluate-region, hif-evaluate-macro): New defun. + (hide-ifdef-guts): Prevent reinclusion protected C/C++ headers from + fully hidden. + (hide-ifdef-define, hide-ifdefs, hide-ifdef-block, show-ifdef-block): + Better interaction. + +2014-07-04 Michael Albinus <michael.albinus@gmx.de> + + * net/dbus.el (dbus-peer-handler): New defun. + (dbus-register-service): Register it. (Bug#17858) + (dbus-managed-objects-handler): Fix docstring. + +2014-07-04 Phil Sainty <psainty@orcon.net.nz> + + * emacs-lisp/lisp.el (narrow-to-defun-include-comments): New var. + (narrow-to-defun): New arg include-comments, defaulting to it + (bug#16328). + +2014-07-03 Stefan Monnier <monnier@iro.umontreal.ca> + + * rect.el (rectangle--highlight-for-redisplay): Don't pass `orig' with + different calling convention to rectangle--unhighlight-for-redisplay. + +2014-07-03 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-call-process): Handle error strings. + + * net/tramp-adb.el (tramp-adb-sh-fix-ls-output): Use `bolp'. + + * net/tramp-sh.el (tramp-sh-handle-set-visited-file-modtime) + (tramp-sh-handle-verify-visited-file-modtime): Use `point-at-eol'. + + * net/trampver.el: Update release number. + +2014-07-03 Juri Linkov <juri@jurta.org> * desktop.el (desktop-save): Rename arg `auto-save' to `only-if-changed'. Doc fix. (Bug#17873) -2014-07-02 Stefan Monnier <monnier@iro.umontreal.ca> +2014-07-03 Stefan Monnier <monnier@iro.umontreal.ca> * mouse.el (mouse-yank-primary, mouse-yank-secondary): Use insert-for-yank (bug#17271). -2014-07-02 Leo Liu <sdl.web@gmail.com> +2014-07-03 Leo Liu <sdl.web@gmail.com> * emacs-lisp/pp.el (pp-eval-expression, pp-eval-last-sexp): Support lexical-binding. -2014-07-01 Stefan Monnier <monnier@iro.umontreal.ca> +2014-07-03 Stefan Monnier <monnier@iro.umontreal.ca> * vc/log-edit.el (log-edit-goto-eoh): New function. (log-edit--match-first-line): Use it (bug#17861). -2014-07-01 Glenn Morris <rgm@gnu.org> +2014-07-03 Glenn Morris <rgm@gnu.org> * vc/log-edit.el (log-edit-hook): Add missing :version. -2014-07-01 Fabián Ezequiel Gallina <fgallina@gnu.org> +2014-07-03 Fabián Ezequiel Gallina <fgallina@gnu.org> * progmodes/python.el (python-indent-post-self-insert-function): Enhancements to electric indentation behavior inside - parens. (Bug#17658) + parens. (Bug#17658) -2014-07-01 Stefan Monnier <monnier@iro.umontreal.ca> +2014-07-03 Stefan Monnier <monnier@iro.umontreal.ca> * ps-def.el (ps-generate-postscript-with-faces1): Don't mess with buffer-invisibility-spec (bug#17867). -2014-06-29 Andreas Schwab <schwab@linux-m68k.org> +2014-07-03 Andreas Schwab <schwab@linux-m68k.org> * vc/vc-git.el (vc-git-checkin): When operating on the whole tree pass "-a". -2014-06-29 Glenn Morris <rgm@gnu.org> +2014-07-03 Glenn Morris <rgm@gnu.org> * cus-edit.el (help): * finder.el (finder-known-keywords): @@ -1357,36 +6720,163 @@ * progmodes/idlwave.el (idlwave): Update url-link for custom group. (idlwave-mode): Doc URL update. -2014-06-27 Stephen Berman <stephen.berman@gmx.net> +2014-07-01 Juri Linkov <juri@jurta.org> + + * man.el: Display man pages immediately and use process-filter + to format them asynchronously. + (Man-width): Doc fix. + (man): Doc fix. + (Man-start-calling): Use `with-selected-window' to get + `frame-width' and `window-width'. + (Man-getpage-in-background): Call `Man-notify-when-ready' + immediately after creating a new buffer. Call `Man-mode' and set + `mode-line-process' in the created buffer. Set process-filter to + `Man-bgproc-filter' in start-process branch. In call-process branch + call either `Man-fontify-manpage' or `Man-cleanup-manpage'. + Use `Man-start-calling' inside `with-current-buffer'. + (Man-fontify-manpage): Don't print messages. Fix boundary condition. + (Man-cleanup-manpage): Don't print messages. + (Man-bgproc-filter): New function. + (Man-bgproc-sentinel): Add `save-excursion' to keep point when + user moved it during asynchronous formatting. Move calls of + `Man-fontify-manpage' and `Man-cleanup-manpage' to + `Man-bgproc-filter'. Move the call of `Man-mode' to + `Man-getpage-in-background'. Use `quit-restore-window' + instead of `kill-buffer'. Use `message' instead of `error' + because errors are caught by process sentinel. + (Man-mode): Move calls of `Man-build-page-list', + `Man-strip-page-headers', `Man-unindent', `Man-goto-page' to + `Man-bgproc-sentinel'. Doc fix. (Bug#2588, bug#5054, bug#9084, bug#17831) + + * man.el (Man-bgproc-sentinel): Use `Man-page-from-arguments' + for the message about the man page cleaned up. + +2014-07-01 Mario Lang <mlang@delysid.org> + + * net/gnutls.el (gnutls-negotiate): Prevent destructive modification of + cosutomization option `gnutls-verify-error'. + +2014-07-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * simple.el (deactivate-mark, set-mark-command, handle-shift-selection): + Don't keep transient-mark-mode buffer-local when not needed (bug#6316). + + * xt-mouse.el (turn-on-xterm-mouse-tracking-on-terminal) + (turn-off-xterm-mouse-tracking-on-terminal): Don't burp if the terminal + is suspended (bug#17857). + +2014-07-01 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-sh.el (tramp-open-connection-setup-interactive-shell): + Prefer utf-8 coding. (Bug#17859) + +2014-06-30 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * emacs-lisp/subr-x.el (string-reverse): Define as obsolete alias + for `reverse'. + +2014-06-30 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/autoload.el (autoload-ensure-writable): New variable. + (autoload-ensure-default-file): Maybe make existing output writable. + * Makefile.in (AUTOGEN_VCS): Remove. + (autoloads): Use autoload-ensure-writable rather than AUTOGEN_VCS. + +2014-06-30 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * emacs-lisp/subr-x.el (string-reverse): Use `reverse'. + +2014-06-30 Fabián Ezequiel Gallina <fgallina@gnu.org> + + New if-let, when-let, thread-first and thread-last macros. + + * emacs-lisp/subr-x.el + (internal--listify, internal--check-binding) + (internal--build-binding-value-form, internal--build-binding) + (internal--build-bindings): New functions. + (internal--thread-argument, thread-first, thread-last) + (if-let, when-let): New macros. + +2014-06-30 Grégoire Jadi <daimrod@gmail.com> + + * net/rcirc.el (rcirc-buffer-process): Restore previous + behaviour. (Bug#17772) + +2014-06-29 Alan Mackenzie <acm@muc.de> + + Don't call c-parse-state when c++-template-syntax-table is active. + * progmodes/cc-engine.el (c-guess-continued-construct CASE G) + (c-guess-basic-syntax CASE 5D.3): Rearrange so that + c-syntactic-skip-backwards isn't called with the pertinent syntax table. + +2014-06-28 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el (todo-set-top-priorities): Fix logic to account for file-wide setting of todo-top-priorities-overrides. Make code a bit cleaner. -2014-06-27 Leo Liu <sdl.web@gmail.com> - - * calc/calc.el (math-bignum): Handle most-negative-fixnum. (Bug#17556) - -2014-06-27 Glenn Morris <rgm@gnu.org> +2014-06-28 Glenn Morris <rgm@gnu.org> * net/eww.el (eww-mode) <eww-current-title>: Make local. (Bug#17860) -2014-06-26 Stephen Berman <stephen.berman@gmx.net> +2014-06-28 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el (todo-prefix-overlays): If there is no category-wide setting of todo-top-priorities-overrides, check for a file-wide setting and fontify accordingly. -2014-06-26 Glenn Morris <rgm@gnu.org> +2014-06-28 Glenn Morris <rgm@gnu.org> * subr.el (read-passwd): Warn about batch mode. (Bug#17839) +2014-06-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/hideif.el: Use lexical-binding. Fix up cl-lib usage. + +2014-06-28 K. Handa <handa@gnu.org> + + Fix Bug#17739. + + * composite.el: Setup composition-function-table for dotted circle. + (compose-gstring-for-dotted-circle): New function. + + * international/characters.el: Add category "^" to all + non-spacing characters. + +2014-06-28 Glenn Morris <rgm@gnu.org> + + * Makefile.in (doit): Remove force rule. + (custom-deps, finder-data, autoloads, update-subdirs) + (compile-one-process): PHONY targets do not need force rules. + + * Makefile.in (compile-main, compile, compile-always): + No need to explicitly pass variables to ourself in recursive calls. + +2014-06-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * files.el (minibuffer-with-setup-hook): Evaluate the first arg eagerly. + +2014-06-26 Glenn Morris <rgm@gnu.org> + + * Makefile.in (update-authors): Update for moved authors.el. + +2014-06-26 Leo Liu <sdl.web@gmail.com> + + * skeleton.el (skeleton-end-hook): Default to nil and move the + work to skeleton-insert. (Bug#17850) + +2014-06-26 Dmitry Antipov <dmantipov@yandex.ru> + + * calc/calc-alg.el (math-beforep): + * progmodes/cc-guess.el (c-guess-view-reorder-offsets-alist-in-style): + Simplify because string-lessp can accept symbols as args. + 2014-06-26 Daiki Ueno <ueno@gnu.org> * emacs-lisp/package.el (package--check-signature): If package-check-signature is allow-unsigned, don't signal error when we can't verify signature because of missing public key - (backport for bug#17625). + (bug#17625). 2014-06-26 Glenn Morris <rgm@gnu.org> @@ -1396,7 +6886,7 @@ * emacs-lisp/authors.el (authors-valid-file-names) (authors-renamed-files-alist): Additions. -2014-06-25 Leo Liu <sdl.web@gmail.com> +2014-06-26 Leo Liu <sdl.web@gmail.com> * textmodes/picture.el (picture-set-tab-stops): * ruler-mode.el (ruler-mode-mouse-add-tab-stop) @@ -1407,12 +6897,12 @@ * indent.el (indent-accumulate-tab-stops): New function. -2014-06-25 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-26 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/package.el (package-list-unsigned): New var (bug#17625). (package-desc-status): Obey it. -2014-06-25 Stephen Berman <stephen.berman@gmx.net> +2014-06-26 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el: Fix two bugs. (todo-insert-item--basic): If user cancels item insertion to @@ -1421,12 +6911,12 @@ (todo-set-item-priority): After selecting category, instead of moving point to top, which extends an active region, restore it. -2014-06-25 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-26 Stefan Monnier <monnier@iro.umontreal.ca> * help-fns.el (describe-function-1): Check file-name is a string before calling help-fns--autoloaded-p (bug#17564). -2014-06-24 Juri Linkov <juri@jurta.org> +2014-06-26 Juri Linkov <juri@jurta.org> * desktop.el (desktop-auto-save-enable) (desktop-auto-save-disable): New functions. @@ -1434,7 +6924,7 @@ (desktop-read): Disable the autosave before loading the desktop, and enable afterwards. (Bug#17351) -2014-06-24 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-26 Stefan Monnier <monnier@iro.umontreal.ca> Fix some indentation problem with \; and pipes (bug#17842). * progmodes/sh-script.el (sh-mode-syntax-table): Set syntax of ;|&. @@ -1444,17 +6934,102 @@ (sh-smie-rc-forward-token, sh-smie-rc-backward-token): Use them. (sh-smie-sh-rules): Fix indentation of a pipe at BOL. -2014-06-24 Eli Zaretskii <eliz@gnu.org> +2014-06-26 Glenn Morris <rgm@gnu.org> - * international/fontset.el (script-representative-chars): - Add representative characters for scripts added in Unicode 7.0. - (otf-script-alist): Synchronize with the latest registry of OTF - script tags. + * emacs-lisp/find-func.el (find-function-C-source-directory): + Use file-accessible-directory-p. + + * ps-samp.el: Make it slightly less awful. + (ps-rmail-mode-hook, ps-gnus-article-prepare-hook, ps-vm-mode-hook): + (ps-gnus-summary-setup, ps-info-mode-hook): Use [print] key. + Only set local values. + (ps-article-subject, ps-article-author): Use standard functions + like mail-fetch-field. + (ps-info-file, ps-info-node): Use match-string. + (ps-jts-ps-setup, ps-jack-setup): Remove, merging into... + (ps-samp-ps-setup): ... new function. + + * progmodes/idlw-shell.el (idlwave-shell-make-temp-file): + Optimize away code unneeded on any modern Emacs. + + * emacs-lisp/authors.el: Move to ../admin. + + * emacs-lisp/ert.el (ert-summarize-tests-batch-and-exit): New. + +2014-06-26 Luke Lee <luke.yx.lee@gmail.com> + + * progmodes/hideif.el (hif-string-to-number): Fix return value bug. + (hif-simple-token-only, hif-tokenize): Comment in detail mainly for + performance enhancements. + (hif-parse-if-exp): Rename to `hif-parse-exp'. Enhance for macro + expansion. + (hif-factor, hif-string-concatenation, intern-safe): Support string + concatenation and argumented macro expansion. + (hif-if-valid-identifier-p, hif-define-operator, hif-flatten) + (hif-expand-token-list, hif-get-argument-list, hif-define-macro) + (hif-delimit, hif-macro-supply-arguments, hif-invoke, hif-canonicalize) + (hif-canonicalize-tokens, hif-place-macro-invocation) + (hif-parse-macro-arglist): Mostly new functions for supporting + argumented macro expansion. + (hif-string-concatenation, hif-stringify, hif-token-concat) + (hif-token-stringification, hif-token-concatenation): + Stringification and concatenation. + (hif-find-next-relevant): Fix comments. + (hif-ifdef-to-endif, hif-looking-at-elif, hif-hide-line): Bug fix for + some cases involving #elif. + (hif-find-define, hif-add-new-defines): New functions for automatically + scanning of defined symbols. + (hide-ifdef-guts): Fix for defined symbol auto scanning. + (hide-ifdef-undef): Fix behavior to match CPP. + +2014-06-25 Glenn Morris <rgm@gnu.org> + + * Makefile.in ($(lisp)/progmodes/cc-defs.elc) + ($(lisp)/progmodes/cc-fonts.elc, $(lisp)/progmodes/cc-langs.elc) + ($(lisp)/progmodes/cc-vars.elc): Drop hand-written deps on non-cc + files. They are not relevant to the original issue (bug#1004), + and cause unnecessary recompilation (bug#2151). - * international/characters.el (char-script-table): Update for - scripts added and codepoint ranges changed in Unicode 7.0. +2014-06-25 Stefan Monnier <monnier@iro.umontreal.ca> -2014-06-23 Leo Liu <sdl.web@gmail.com> + * play/landmark.el: Use lexical-binding and avoid `intangible'. + (landmark--last-pos): New var. + (landmark--intangible-chars): New const. + (landmark--intangible): New function. + (landmark-mode, landmark-move): Use it. + (landmark-mode): Remove properties. + (landmark-plot-square, landmark-point-square, landmark-goto-xy) + (landmark-cross-qtuple): + Don't worry about `intangible' any more. + (landmark-click, landmark-point-y): Same; and don't assume point-min==1. + (landmark-init-display): Don't set `intangible' and `point-entered'. + (square): Remove. Inline it instead. + (landmark--distance): Rename from `distance'. + (landmark-calc-distance-of-robot-from): Rename from + calc-distance-of-robot-from. + (landmark-calc-smell-internal): Rename from calc-smell-internal. + +2014-06-25 Dmitry Antipov <dmantipov@yandex.ru> + + * files.el (dir-locals-find-file, file-relative-name): + * info.el (Info-complete-menu-item): + * minibuffer.el (completion-table-subvert): Prefer string-prefix-p + to compare-strings to avoid out-of-range errors. + * subr.el (string-prefix-p): Adjust to match strict range + checking in compare-strings. + +2014-06-24 Leonard Randall <leonard.a.randall@gmail.com> (tiny change) + + * textmodes/reftex-parse.el (reftex-using-biblatex-p): Make search + for comment lines non-greedy and stopping at newlines to fix stack + overflows with large files. + +2014-06-24 Eli Barzilay <eli@barzilay.org> + + * calculator.el (calculator-last-input): Drop 'ascii-character property + lookup. + +2014-06-24 Leo Liu <sdl.web@gmail.com> * align.el (align-adjust-col-for-rule): Unbreak due to defaulting tab-stop-list to nil. (Bug#16381) @@ -1464,23 +7039,73 @@ (indent-rigidly-right-to-tab-stop, tab-to-tab-stop) (move-to-tab-stop): Change callers. -2014-06-22 Eli Zaretskii <eliz@gnu.org> +2014-06-24 Eli Zaretskii <eliz@gnu.org> * skeleton.el (skeleton-insert): Yet another fix of the doc string wrt behavior of \n as the first/last element of a skeleton. -2014-06-22 Michael Albinus <michael.albinus@gmx.de> +2014-06-24 Michael Albinus <michael.albinus@gmx.de> * net/tramp-adb.el (tramp-adb-handle-process-file): * net/tramp-sh.el (tramp-sh-handle-process-file): * net/tramp-smb.el (tramp-smb-handle-process-file): Do not raise the output buffer when DISPLAY is non-nil. (Bug#17815) -2014-06-21 Glenn Morris <rgm@gnu.org> +2014-06-24 Glenn Morris <rgm@gnu.org> * play/landmark.el (landmark-move-down, landmark-move-up): Fix 2007-10-20 change - preserve horizontal position. +2014-06-23 Sam Steingold <sds@gnu.org> + + * simple.el (kill-append): Remove undo boundary depending on ... + (kill-append-merge-undo): New user option. + +2014-06-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * simple.el (handle-shift-selection, exchange-point-and-mark) + (activate-mark): Set transient-mark-mode buffer-locally (bug#6316). + (transient-mark-mode): Use&set the global value. + * mouse.el (mouse-set-region-1, mouse-drag-track): Idem. + * emulation/edt.el (edt-emulation-off): Save&restore the global + transient-mark-mode setting. + * obsolete/pc-select.el (pc-selection-mode): Use the + transient-mark-mode function. + +2014-06-23 Eli Zaretskii <eliz@gnu.org> + + * international/fontset.el (script-representative-chars): + Add representative characters for scripts added in Unicode 7.0. + (otf-script-alist): Synchronize with the latest registry of OTF + script tags. + + * international/characters.el (char-script-table): Update for + scripts added and codepoint ranges changed in Unicode 7.0. + +2014-06-23 Eli Barzilay <eli@barzilay.org> + + * calculator.el (calculator-standard-displayer): Fix bug in use of + `calculator-groupize-number'. + (calculator-funcall): Fix broken `cl-flet' use by moving it into the + `eval' code, so it works in v24.3.1 too. + (calculator-last-input): Comment to clarify purpose. + +2014-06-22 Mario Lang <mlang@delysid.org> + + * textmodes/rst.el (rst-comment-region): From from -> from. + + * net/tramp-adb.el (tramp-adb-send-command-and-check): And and -> and. + +2013-06-22 Dmitry Antipov <dmantipov@yandex.ru> + + * electric.el (electric-layout-post-self-insert-function): + * emacs-lisp/ert.el (ert--insert-infos): + * obsolete/vi.el (vi-set-mark): + * term.el (term-handle-scroll): + * textmodes/bibtex.el (bibtex-fill-field, bibtex-fill-entry): + * wid-edit.el (widget-editable-list-value-create): + Prefer point-marker to copy-marker of point. + 2014-06-21 Fabián Ezequiel Gallina <fgallina@gnu.org> Fix completion retrieval parsing (bug#17209). @@ -1503,7 +7128,7 @@ * skeleton.el (skeleton-insert): Doc fix. -2014-06-20 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-21 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/smie.el (smie-config--guess): Fix typo. (smie-config-guess): Use smie-config-local so the rules are obeyed @@ -1512,18 +7137,18 @@ * mouse.el (mouse-drag-line): Don't re-add to unread-comment-events, since it's already done inside the loop (bug#17819). -2014-06-20 Martin Rudalics <rudalics@gmx.at> +2014-06-21 Martin Rudalics <rudalics@gmx.at> * mouse.el (mouse-drag-line): Re-remove code initially removed on 2013-03-09 and inadvertently reintroduced on 2013-11-30 (Bug#17819). -2014-06-20 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-21 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/sh-script.el (sh-smie-sh-rules): For { after &&, don't align with the surrounding parent (bug#17721). -2014-06-20 Eli Zaretskii <eliz@gnu.org> +2014-06-21 Eli Zaretskii <eliz@gnu.org> * textmodes/texinfo.el (texinfo-mode): Set skeleton-end-newline locally to nil. @@ -1532,70 +7157,299 @@ local setting of skeleton-end-newline by adding an explicit \n to the skeletons where appropriate. (Bug#17801) -2014-06-20 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-21 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/smie.el (smie--hanging-eolp-function): New var. (smie-indent--hanging-p): Use it. * progmodes/sh-script.el (sh-set-shell): Set it (bug#17621). -2014-06-20 Leo Liu <sdl.web@gmail.com> +2014-06-21 Leo Liu <sdl.web@gmail.com> * simple.el (read-quoted-char): Don't let help chars pop up help buffer. (Bug#16617) -2014-06-19 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-21 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/sh-script.el (sh-smie-sh-rules): Use same rule for && as for | (bug#17621). -2014-06-18 Stefan Monnier <monnier@iro.umontreal.ca> + * xt-mouse.el (xterm-mouse--read-event-sequence-1000): + Drop unknown events instead of burping. - * xt-mouse.el (xterm-mouse-translate-1): Fix last change (bug#17776). - (xterm-mouse--read-event-sequence-1000): Drop unknown events instead of - burping. - -2014-06-18 Eli Zaretskii <eliz@gnu.org> +2014-06-21 Eli Zaretskii <eliz@gnu.org> * term/w32-win.el (dynamic-library-alist): Support giflib 5.1.0 and later. (Bug#17790) -2014-06-18 Juri Linkov <juri@jurta.org> +2014-06-21 Juri Linkov <juri@jurta.org> * dired.el (dired-mark-pop-up): Let-bind display-buffer-mark-dedicated to `soft'. (Bug#17554) -2014-06-17 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-21 Stefan Monnier <monnier@iro.umontreal.ca> * delsel.el (electric-newline-and-maybe-indent): Mark it as well (bug#17737). -2014-06-16 Dmitry Gutov <dgutov@yandex.ru> +2014-06-21 Dmitry Gutov <dgutov@yandex.ru> * progmodes/ruby-mode.el (ruby-font-lock-keywords): Don't fontify `!' in `!~' with `font-lock-negation-char-face'. (Bug#17732) -2014-06-15 Michael Albinus <michael.albinus@gmx.de> +2014-06-21 Michael Albinus <michael.albinus@gmx.de> * net/dbus.el (dbus-call-method): Push only non D-Bus events into `unread-command-events'. -2014-06-14 Glenn Morris <rgm@gnu.org> +2014-06-19 William Xu <william.xwl@gmail.com> + + * progmodes/hideif.el (hif-string-to-number): Don't return float for + hex integer constants (bug#17807). + +2014-06-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * international/mule-util.el (truncate-string-ellipsis): New var. + (truncate-string-to-width): Use it. + +2014-06-19 Robert Brown <robert.brown@gmail.com> (tiny change) + + * emacs-lisp/lisp-mode.el (lisp-string-after-doc-keyword-p): New fun. + (lisp-string-in-doc-position-p): New function, extracted from + lisp-font-lock-syntactic-face-function. + (lisp-font-lock-syntactic-face-function): Use them (bug#9130). + +2014-06-19 Grégoire Jadi <daimrod@gmail.com> + + * net/rcirc.el (rcirc-omit-mode): Fix recenter error. (Bug#17769) + +2014-06-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * play/bubbles.el (bubbles--initialize, bubbles--show-scores) + (bubbles--game-over): Don't add `intangible' properties since they + didn't work anyway. + +2014-06-18 Juri Linkov <juri@jurta.org> + + * vc/ediff-init.el (ediff-current-diff-Ancestor) + (ediff-fine-diff-Ancestor, ediff-even-diff-A, ediff-even-diff-B) + (ediff-even-diff-C, ediff-even-diff-Ancestor, ediff-odd-diff-A) + (ediff-odd-diff-B, ediff-odd-diff-C, ediff-odd-diff-Ancestor): + Add `min-colors 88' version with removed black/white foregrounds. + (Bug#10181) + +2014-06-18 Juri Linkov <juri@jurta.org> + + * vc/diff-mode.el (diff-changed): Empty face definition to use + `diff-removed' and `diff-added' on tty as well. (Bug#10181) + (diff-context): Use darker color on light background and + lighter color on dark background. + +2014-06-18 Juri Linkov <juri@jurta.org> + + * vc/diff-mode.el (diff-refine-changed): Rename from + `diff-refine-change' for consistency with `diff-changed'. + (diff-refine-change): Add obsolete face alias. (Bug#10181) + + * vc/smerge-mode.el (smerge-refined-changed): Rename from + `smerge-refined-change'. + (smerge-refined-change): Add obsolete face alias. + +2014-06-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * rect.el (rectangle-preview): New custom. + (rectangle): New group. + (rectangle--pos-cols): Add `window' argument. + (rectangle--string-preview-state, rectangle--string-preview-window): + New vars. + (rectangle--string-flush-preview, rectangle--string-erase-preview) + (rectangle--space-to, rectangle--string-preview): New functions. + (string-rectangle): Use them. + (rectangle--inhibit-region-highlight): New var. + (rectangle--highlight-for-redisplay): Obey it. Make sure + `apply-on-region' uses the point-crutches of the right window. + Use :align-to rather than multiple spaces. + +2014-06-16 Andrea Rossetti <andrea.rossetti@gmail.com> (tiny change) + + * ruler-mode.el (ruler-mode-window-col) + (ruler-mode-mouse-set-left-margin) + (ruler-mode-mouse-set-right-margin): Fix calculation of column + from mouse position (Bug#17768). + +2014-06-16 Ron Schnell <ronnie@driver-aces.com> + + * play/dunnet.el (dun-doassign): Fix bug where UNIX variable assignment + without varname or rhs causes crash. + (dun-ftp): Fix bug where blank ftp password is allowed, making it + impossible to win endgame. + (dun-unix-verbs): Add ssh as alias to rlogin, because nobody knows what + rlogin is anymore. + (dun-help): Bump version number; update contact info. + +2014-06-15 Eli Barzilay <eli@barzilay.org> + + * calculator.el (calculator-prompt, calculator-remove-zeros) + (calculator-mode-hook, calculator-operators, calculator-stack) + (calculator-mode): Tweak docstring. + (calculator-user-operators): Tweak docstring, fix a bug in the last + example. + (calculator-displayer): `std' case has an optional boolean. + (calculator-displayers): Use the new boolean to group in decimal mode. + (calculator-mode-map, calculator, calculator-message) + (calculator-op-arity, calculator-add-operators) + (calculator-string-to-number, calculator-displayer-prev) + (calculator-displayer-next, calculator-remove-zeros) + (calculator-eng-display, calculator-number-to-string) + (calculator-update-display, calculator-last-input) + (calculator-clear-fragile, calculator-digit, calculator-decimal) + (calculator-exp, calculator-saved-move, calculator-clear) + (calculator-copy, calculator-put-value, calculator-help) + (calculator-expt, calculator-truncate): Minor code improvements. + (calculator-need-3-lines): New function pulling out code from + `calculator'. + (calculator-get-display): Rename from `calculator-get-prompt', and + improved. + (calculator-push-curnum): Rename from `calculator-curnum-value', and + extended for all uses of it. All callers changed. + (calculator-groupize-number): New utility for splitting a number into + groups. + (calculator-standard-displayer): Improve code, new optional argument to + use comma-split groups, make second argument optional too to use with + 'left/'right inputs. All callers changed. + (calculator-reduce-stack-once): New utility, doing the meat of what + `calculator-reduce-stack' used to do, much improved (mostly using + `pcase' for conciseness and clarity). + (calculator-reduce-stack): Now doing just the reduction loop using + `calculator-reduce-stack-once'. + (calculator-funcall): Improve code, make it work in v24.3.1 too. + (calculator-last-input): Improve code, remove some old cruft. + (calculator-quit): Kill `calculator-buffer' in electric mode too. + (calculator-integer-p): Remove. + (calculator-fact): Improve code, make it work on non-integer values + too (using truncated numbers). + +2014-06-15 Michael Albinus <michael.albinus@gmx.de> + + Sync with Tramp 2.2.10. + + * net/tramp.el (tramp-methods): Tweak docstring. + (tramp-handle-file-accessible-directory-p): Check for + `file-readable-p' instead of `file-executable-p'. + (tramp-check-cached-permissions): + Use `tramp-compat-file-attributes'. + (tramp-call-process): Add new argument VEC. Adapt callees in all + tramp*.el files. + + * net/tramp-adb.el (tramp-adb-handle-write-region): Improve messages. + (tramp-adb-maybe-open-connection): Don't set + `tramp-current-*' variables. + + * net/tramp-cache.el (tramp-flush-file-function): Do not flush + file properties of temporary buffers. + + * net/tramp-ftp.el (top): Remove special handling for URL syntax. + + * net/tramp-gvfs.el (tramp-gvfs-methods) <sftp>: Add. + (tramp-gvfs-handle-delete-file): Flush file + properties, not directory properties. + (tramp-gvfs-handle-file-attributes): Use `string-to-number' when + reading "unix::mode". + (tramp-gvfs-handle-file-name-all-completions): + Use "-h" option for "gvfs-ls". + (tramp-gvfs-url-file-name): `user' and `localname' could be nil. + (tramp-gvfs-send-command): Simplify traces. + + * net/tramp-sh.el (vc-handled-backends, vc-bzr-program) + (vc-git-program, vc-hg-program): Declare. + (tramp-methods) <sftp>: Remove. It has never worked satisfactorily. + (tramp-methods) <nc>: Add new method. + (tramp-methods) <telnet>: Redirect stderr to "/dev/null". + (tramp-methods) <plink, plinkx, pscp, psftp>: Improve + `tramp-login-args'. + (tramp-default-user-alist): Add "nc". + (top): Remove completion function for "sftp". Add completion + functions for "nc" and "psftp". + (tramp-do-copy-or-rename-file-out-of-band): Tweak docstring. + Implement support for "nc" method. + (tramp-sh-handle-expand-file-name, tramp-local-coding-commands) + (tramp-remote-coding-commands, tramp-call-local-coding-command): + Tweak docstring. + (tramp-sh-handle-write-region): Tweak error message. + (tramp-sh-handle-vc-registered): Remove backends when the remote + binary does not exist. + (tramp-find-inline-encoding): Do not raise an error. + (tramp-make-copy-program-file-name): Tweak docstring. Handle also + the "nc" case. Quote result also locally. + + * net/tramp-smb.el (tramp-smb-handle-copy-directory) + (tramp-smb-handle-set-file-acl): Use `start-process'. + (tramp-smb-handle-insert-directory): Use progress reporter. + (tramp-smb-handle-rename-file): Flush also file properties of + FILENAME. + + * net/trampver.el: Update release number. + +2014-06-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * ses.el: Miscellaneous cleanups; use lexical-binding; avoid + add-to-list. + (ses-localvars): Remove ses--local-printer-list, unused. + (ses--metaprogramming): New macro. Use it to defvar variables. + (ses-set-localvars): Simplify. + (ses--locprn, ses-cell): Use defstruct. Change ses-cell's + property-list into an alist. + (ses-locprn-get-compiled, ses-locprn-compiled-aset) + (ses-locprn-get-def, ses-locprn-def-aset, ses-locprn-get-number): + Remove; use defstruct accessors/setters instead. + (ses-cell-formula-aset, ses-cell-printer-aset) + (ses-cell-references-aset): Remove, use setf instead. + (ses--alist-get): New function. + (ses-cell-property): Rename from ses-cell-property-get and rewrite. + Use an alist instead of a plist and don't do move-to-front since the + list is always short. + (ses-cell-property-get-fun, ses-cell-property-delq-fun) + (ses-cell-property-set-fun, ses-cell-property-set) + (ses-cell-property-pop-fun, ses-cell-property-get-handle) + (ses-cell-property-handle-car, ses-cell-property-handle-setcar): Remove. + (ses--letref): New macro. + (ses-cell-property-pop): Rewrite. + (ses--cell): Rename from ses-cell and make it into a function. + Make `formula' fallback on `value' if nil. + (ses--local-printer): Rename from ses-local-printer and make it into + a function. + (ses-set-cell): Turn it into a macro so finding the accessor from the + field name is done at compile time. + (ses-repair-cell-reference-all): Test presence of `sym' rather than + `ref' before adding `sym' to :ses-repair-reference. + (ses-calculate-cell): Use ses--letref rather than + ses-cell-property-get-handle. + (ses-write-cells): Use a single prin1-to-string. + (ses-setter-with-undo): New function. + (ses-aset-with-undo, ses-set-with-undo): Rewrite using it. + (ses-unset-with-undo): Remove. + (ses-load): Prefer apply' over `eval'. + (ses-read-printer, ses-set-column-width): Use standard "(default + foo)" format. + +2014-06-15 Glenn Morris <rgm@gnu.org> + + * Makefile.in (leim, semantic): Use `make -C' rather than `cd && make'. * progmodes/cc-langs.el: Require cl-lib. (Bug#17463) Replace delete-duplicates and mapcan by cl- versions throughout. And cl-macroexpand-all by macroexpand-all. (delete-duplicates, mapcan, cl-macroexpand-all): No need to declare. -2014-06-14 Eli Zaretskii <eliz@gnu.org> +2014-06-15 Eli Zaretskii <eliz@gnu.org> * subr.el (posn-col-row): Doc fix. (Bug#17768) -2014-06-14 Juri Linkov <juri@jurta.org> +2014-06-15 Juri Linkov <juri@jurta.org> * bindings.el: Put `ascii-character' property on keypad keys mapped to characters. (Bug#17759) -2014-06-13 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-15 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/smie.el (smie-next-sexp): Fix up "other-end" info when bumping forward into a closing paren (bug#17761). @@ -1603,6 +7457,130 @@ * term/xterm.el (xterm--version-handler): Work around for OSX Terminal.app (bug#17607). +2014-06-14 Ron Schnell <ronnie@driver-aces.com> + + * play/dunnet.el (dun-describe-room, dun-mode): + If a lamp is in the room, you won't be eaten by a grue. + +2014-06-13 Glenn Morris <rgm@gnu.org> + + * Makefile.in ($(lisp)/cus-load.el, $(lisp)/finder-inf.el) + (autoloads, $(lisp)/subdirs.el, compile-main, leim, semantic, compile) + (compile-always): GNU make automatically passes + command-line arguments to sub-makes. + + * calendar/calendar.el (calendar-generate-window): + Remove pointless call to font-lock-fontify-buffer. + +2014-06-13 Matthias Meulien <orontee@gmail.com> + + * simple.el (completion-list-mode-map): Navigate with tab and backtab + (bug#17767). + +2014-06-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * simple.el (set-mark-command): Simplify a bit. + +2014-06-12 Nicolas Richard <theonewiththeevillook@yahoo.fr> + + * help.el (help--key-binding-keymap): New function. + (help--binding-locus): New function. + (describe-key): Mention the keymap in which the binding was + found. (bug#13948) + +2014-06-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * hippie-exp.el (he--all-buffers): New function. + (try-expand-line-all-buffers, try-expand-list-all-buffers) + (try-expand-dabbrev-all-buffers): Use it. + +2014-06-12 Emilio C. Lopes <eclig@gmx.net> + + * hippie-exp.el (try-expand-line-all-buffers) + (try-expand-list-all-buffers, try-expand-dabbrev-all-buffers): + Read hippie-expand-only-buffers and hippie-expand-ignore-buffers in the + original buffer, in case they're buffer-local. + +2014-06-12 Vincent Belaïche <vincentb1@users.sourceforge.net> + + * ses.el (ses-initial-global-parameters-re): New defconst, a + specific regexp is needed now that ses.el can handle both + file-format 2 --- ie. no local printers --- and 3 --- i.e. may have + local printers. + (ses-localvars): Add local variables needed for local printer handling. + (ses-set-localvars): Handle hashmap initialisation. + (ses-paramlines-plist): Add param-line for number of local printers. + (ses-paramfmt-plist): New defconst, needed for code factorization + between functions `ses-set-parameter' and + `ses-file-format-extend-paramter-list' + (ses-make-local-printer-info): New defsubst. + (ses-locprn-get-compiled, ses-locprn-compiled-aset) + (ses-locprn-get-def, ses-locprn-def-aset, ses-locprn-get-number) + (ses-cell-printer-aset): New defmacro. + (ses-local-printer-compile): New defun. + (ses-local-printer): New defmacro. + (ses-printer-validate, ses-call-printer): Add support for local + printer functions. + (ses-file-format-extend-paramter-list): New defun. + (ses-set-parameter): Use const `ses-paramfmt-plist' for code + factorization. + (ses-load): Add support for local printer functions. + (ses-read-printer): Update docstring and add support for local printer + functions. + (ses-refresh-local-printer, ses-define-local-printer): New defun. + (ses-safe-printer): Add support for local printer functions. + +2014-06-12 Ivan Andrus <darthandrus@gmail.com> + + * ffap.el (ffap-lax-url): New var (bug#17723). + (ffap-url-at-point): Use it. + (ffap-file-at-point): Avoid returning just "/". + +2014-06-12 Matthias Meulien <orontee@gmail.com> + + * progmodes/python.el (import skeleton): New skeleton (bug#17672). + (python-mode-map): Bind it. + + * progmodes/python.el (class skeleton): Don't erase last char of class + name (bug#17683). + +2014-06-12 Cameron Desautels <camdez@gmail.com> (tiny change) + + * help.el (where-is): Use `default' arg of completing-read (bug#17705). + +2014-06-12 Kevin Ryde <user42_kevin@yahoo.com.au> + + * files.el (auto-mode-alist): Map .ad files to xdefaults-mode + (bug#17745). + +2014-06-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * international/mule-cmds.el: Use lexical-binding. + (ucs-names): Simplify. + +2014-05-18 Eric Hanchrow <eric.hanchrow@gmail.com> + + * progmodes/python.el (run-python): Use read-shell-command. + +2014-06-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * rect.el: Make it possible to move bounds past EOL or into TABs. + (operate-on-rectangle): Use apply-on-rectangle. + (rectangle--mark-crutches): New var. + (rectangle--pos-cols, rectangle--col-pos, rectangle--point-col) + (rectangle--crutches, rectangle--reset-crutches): New functions. + (apply-on-rectangle): Obey crutches. Avoid setq. + Fix missing final iteration if end is at EOB&BOL. + (rectangle-mark-mode-map): Add remap bindings for + exchange-point-and-mark and char/line movements. + (rectangle--*-char): New function. + (rectangle-exchange-point-and-mark, rectangle-right-char) + (rectangle-left-char, rectangle-forward-char) + (rectangle-backward-char, rectangle-next-line) + (rectangle-previous-line): New commands. + (rectangle--place-cursor): New function. + (rectangle--highlight-for-redisplay): Use it. Use apply-on-rectangle. + 2014-06-08 Glenn Morris <rgm@gnu.org> * startup.el (initial-buffer-choice): Doc fix. @@ -1611,63 +7589,231 @@ * bookmark.el (bookmark-load): * uniquify.el (uniquify-buffer-name-style): Doc fixes. -2014-06-06 Juri Linkov <juri@jurta.org> +2014-06-08 Juri Linkov <juri@jurta.org> * desktop.el: Activate auto-saving on window configuration changes. (desktop-save-mode, desktop-auto-save-timeout): Add/remove - `desktop-auto-save-set-timer' to/from `window-configuration-change-hook'. + `desktop-auto-save-set-timer' to/from + `window-configuration-change-hook'. (desktop-auto-save-set-timer): Change REPEAT arg of `run-with-idle-timer' from t to nil. http://lists.gnu.org/archive/html/emacs-devel/2014-06/msg00147.html -2014-06-06 Santiago Payà i Miralta <santiagopim@gmail.com> +2014-06-08 Santiago Payà i Miralta <santiagopim@gmail.com> * vc/vc-hg.el (vc-hg-working-revision): Use "hg parent" and vc-hg-command (bug#17570). -2014-06-06 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-08 Stefan Monnier <monnier@iro.umontreal.ca> * international/mule-cmds.el (ucs-names): Add special entry for BEL (bug#17702). -2014-06-06 Glenn Morris <rgm@gnu.org> +2014-06-08 Glenn Morris <rgm@gnu.org> * startup.el (window-setup-hook): Doc fix. -2014-06-05 Glenn Morris <rgm@gnu.org> - * emacs-lisp/package.el (package-check-signature) (package-unsigned-archives): Doc fixes. -2014-06-03 Martin Rudalics <rudalics@gmx.at> +2014-06-08 Martin Rudalics <rudalics@gmx.at> * window.el (display-buffer-use-some-window): Don't make window used smaller than it was before (Bug#17671). -2014-06-03 Eli Zaretskii <eliz@gnu.org> +2014-06-08 Eli Zaretskii <eliz@gnu.org> * menu-bar.el (menu-bar-open): Fix last change: use the PC 'redisplay' instead of '(sit-for 0)'. -2014-06-03 Michael Albinus <michael.albinus@gmx.de> +2014-06-08 Michael Albinus <michael.albinus@gmx.de> - * net/tramp.el (tramp-ssh-controlmaster-options): Improve search - regexp. (Bug#17653) + * net/tramp.el (tramp-ssh-controlmaster-options): + Improve search regexp. (Bug#17653) -2014-06-03 Glenn Morris <rgm@gnu.org> +2014-06-08 Glenn Morris <rgm@gnu.org> * emacs-lisp/package.el (package-pinned-packages): Doc fix. -2014-06-02 Eli Zaretskii <eliz@gnu.org> +2014-06-08 Eli Zaretskii <eliz@gnu.org> * menu-bar.el (menu-bar-open): Fix invocation via M-x. -2014-06-01 Eli Zaretskii <eliz@gnu.org> +2014-06-06 Santiago Payà i Miralta <santiagopim@gmail.com> + + * vc/vc-hg.el (vc-hg-create-tag, vc-hg-retrieve-tag): New functions + (bug#17586). + + * vc/vc-hg.el (vc-hg-log-graph): New var. + (vc-hg-print-log): Use it. + (vc-hg-root-log-format): Include branch name and bookmarks; ignore + graph output (bug#17515). + +2014-06-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * mouse.el (mouse-posn-property): Ignore buffer position info when the + even happened elsewhere. + +2014-06-06 Mario Lang <mlang@delysid.org> + + * emacs-lisp/tabulated-list.el (tabulated-list-print): Only call + `recenter' if `current-buffer' is equal to `window-buffer'. + +2014-06-05 Leo Liu <sdl.web@gmail.com> + + * emacs-lisp/cl-macs.el (cl-macrolet): Avoid excessive progn's. + +2014-06-05 Michal Nazarewicz <mina86@mina86.com> + + * textmodes/tildify.el (tildify-foreach-region-outside-env): + New function which calls a callback on portions of the buffer that are + outside of ignored environments. + (tildify-build-regexp): Remove function since it is now + incorporated in `tildify-foreach-region-outside-env' where it is + optimized and simplified by the use of `mapconcat'. + (tildify-tildify): Return number of substitutions made so that… + (tildify-count): …can be removed. + (tildify-find-env): Accept a new PAIRS argument which was + previously looked up in `tildify-ignored-environments-alist' each + time the function was called. With this change, the lookup is + performed only once in `tildify-foreach-region-outside-env'. + (tildify-region): Greatly simplify the function since now most of + the work is done by `tildify-foreach-region-outside-env'. + (tildify-mode-alist): Simplify slightly by avoiding if and setq + and instead using or. + + * textmodes/tildify.el (tildify-ignored-environments-alist): + Optimize environments regexes + + Each time beginning of an environment to ignore is found, + `tildify-find-env' needs to identify regexp for the ending + of the environment. This is done by trying all the opening + regexes on matched text in a loop, so to speed that up, this + loop should have fewer things to match, which can be done by + using alternatives in the opening regexes. + + Coincidentally, this should make matching of the opening + regexp faster as well thanks to the use of `regexp-opt' and + having common prefix pulled from many regexes. + + * textmodes/tildify.el (tildify-string-alist) + (tildify-ignored-environments-alist): Add `nxml-mode' to the list + of supported modes since `xml-mode' is no longer a thing but just + an alias to the former. Also include comments and insides of tags + in `tildify-ignored-environments-alist' for XML modes. Finally, + since XML does not define “ ”[1], use a numeric reference for + a no-break space (namely “ ”) + + [1] XML specification defines only a handful of predefined entities. + The list is at <http://www.w3.org/TR/REC-xml/#sec-predefined-ent> + and includes only <, >, &, ' and " (meaning <, + >, &, ' and " respectively). This is in contrast to HTML and even + XHTML which defined a whole bunch of entities including “ ”. + + * textmodes/tildify.el (tildify-pattern-alist) + (tildify-string-alist, tildify-ignored-environments-alist): + Improve defcustom's types by adding more tags explaining what each + value means and replace “sexp” used in + `tildify-ignored-environments-alist' with a full type declaration. + + * textmodes/tildify.el (tildify-find-env): Fix matched group + indexes in end-regex building + + When looking for a start of an ignore-environment, the regex is built + by concatenating regexes of all the environments configured in + `tildify-ignored-environments-alist'. So for example, the following + list could be used to match TeX's \verb and \verb* commands: + + (("\\\\verb\\(.\\)" . (1)) + ("\\\\verb\\*\\(.\\)" . (1))) + + This would result in the following regex being used to find the start + of any of the variants of the \verb command: + + \\\\verb\\(.\\)\\|\\\\verb\\*\\(.\\) + + But now, if “\\\\verb\\*\\(.\\)” matches, the first capture group + won't match anything, and thus (match-string 1) will be nil, which + will cause building of the end-matching regex to fail. + + Fix this by using capture groups from the time when the opening + regexes are matched individually. + + * textmodes/tildify.el (tildify-find-env): Fix end-regex building + in `tildify-find-env' + + The `tildify-ignored-environments-alist' allows the end-regex to + be provided not as a static string but mix of strings and indexes + of groups matched the begin-regex. For example, the “\verb!…!” + TeX-command (where “!” is an arbitrary character) is handled + using: + + ("\\\\verb\\*?\\(.\\)" . (1)) + + In the same way, the following should be supported as well: + + ("open-\\(.\\)" . ("end-" 1)) + + However the tildify-find-env function fails at + + (concat result + (if (stringp (setq aux (car expression))) + expression ; BUG: expression is a list + (regexp-quote (match-string aux)))) + + where the string part is handled incorrectly. + + The most trivial fix would be to replace `expression' in the + true-part of the if-statement with `aux', but instead, this commit + optimizes `tildify-find-env' by changing it to use `mapconcat' + rather than open-coded while-loop. + +2014-06-05 Mario Lang <mlang@delysid.org> + + * woman.el (woman-mapcan): Remove. + (woman-parse-colon-path): Use cl-mapcan instead. + +2014-06-03 Rüdiger Sonderfeld <ruediger@c-plusplus.de> + + * register.el: Add link to Emacs manual in Commentary. + +2014-06-02 Sam Steingold <sds@gnu.org> + + * menu-bar.el (lookup-key-ignore-too-long): Extract from... + (popup-menu): ...here. + (menu-bar-open): Use it to avoid an error when `lookup-key' + returns a number. + +2014-06-02 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-call-process): Add traces. + (tramp-handle-unhandled-file-name-directory): Return "/". + +2014-06-02 Wilson Snyder <wsnyder@wsnyder.org> + + Sync with upstream verilog-mode revision 3cd8144. + * progmodes/verilog-mode.el (verilog-mode-version): Bump. + (verilog-auto-arg-format): New option, to support newlines in AUTOARG. + (verilog-type-font-keywords): Add nor. + (verilog-batch-execute-func): Force reading of Local Variables. + Fix printing "no changes to be saved" with verilog-batch. + (verilog-auto-arg-ports): Doc fix. + Add verilog-auto-arg-format to support newlines in AUTOARG. + (verilog-auto-arg): Doc fix. + +2014-06-02 Glenn Morris <rgm@gnu.org> + + * emulation/crisp.el, emulation/tpu-edt.el, emulation/tpu-extras.el: + * emulation/tpu-mapper.el, emulation/vi.el, emulation/vip.el: + * emulation/ws-mode.el: Move to obsolete/. + * Makefile.in (AUTOGEN_VCS): Update for moved tpu-edu.el. + +2014-06-02 Eli Zaretskii <eliz@gnu.org> * simple.el (keyboard-quit): Force update of mode lines, to remove the "Def" indicator, if we were defining a macro. (Bug#17615) -2014-06-01 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-02 Stefan Monnier <monnier@iro.umontreal.ca> * minibuffer.el (minibuffer-force-complete-and-exit): Obey minibuffer-default (bug#17545). @@ -1675,19 +7821,17 @@ * progmodes/js.el (js-indent-line): Don't mix columns and chars (bug#17619). -2014-05-31 Stefan Monnier <monnier@iro.umontreal.ca> - * subr.el (set-transient-map): Don't wait for some "nested" transient-map to finish if we're only supposed to be active for the next command (bug#17642). -2014-05-31 Leo Liu <sdl.web@gmail.com> +2014-06-02 Leo Liu <sdl.web@gmail.com> * emacs-lisp/gv.el (window-buffer, window-display-table) (window-dedicated-p, window-hscroll, window-point, window-start): Fix gv-expander. (Bug#17630) -2014-05-31 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-02 Stefan Monnier <monnier@iro.umontreal.ca> * mouse.el (mouse-posn-property): Ignore posn-point for mode-line clicks (bug#17633). @@ -1696,20 +7840,20 @@ for the single comma, since ", " is *very* common in normal French text (bug#17643). -2014-05-30 Glenn Morris <rgm@gnu.org> +2014-06-02 Glenn Morris <rgm@gnu.org> * emacs-lisp/package.el (package-check-signature) (package-unsigned-archives): Fix :version. -2014-05-29 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-02 Stefan Monnier <monnier@iro.umontreal.ca> * subr.el (sit-for): Don't run input-methods (bug#15614). -2014-05-28 Glenn Morris <rgm@gnu.org> +2014-06-02 Glenn Morris <rgm@gnu.org> * cus-start.el: Fix some :version numbers. -2014-05-27 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-02 Stefan Monnier <monnier@iro.umontreal.ca> * simple.el (deactivate-mark): Set mark-active to nil even if deactivation is done via setting transient-mark-mode to nil, @@ -1718,7 +7862,7 @@ * emacs-lisp/byte-opt.el (byte-optimize-binary-predicate): Don't assume there can't be more than 2 arguments (bug#17584). -2014-05-27 Glenn Morris <rgm@gnu.org> +2014-06-02 Glenn Morris <rgm@gnu.org> * simple.el (filter-buffer-substring-functions) (filter-buffer-substring-function, buffer-substring-filters) @@ -1730,27 +7874,140 @@ * abbrev.el (abbrev-expand-functions, abbrev-expand-function) (expand-abbrev, abbrev--default-expand): Doc fixes. -2014-05-26 Paul Eggert <eggert@cs.ucla.edu> +2014-06-02 Paul Eggert <eggert@cs.ucla.edu> Include sources used to create macuvs.h. * international/README: Refer to the Unicode Terms of Use rather than copying it bodily here, as that simplifies maintenance. -2014-05-25 Andreas Schwab <schwab@linux-m68k.org> +2014-06-01 Glenn Morris <rgm@gnu.org> + + * loadup.el (load-prefer-newer): Set non-nil when dumping. (Bug#17629) + +2014-05-31 Glenn Morris <rgm@gnu.org> + + * files.el (locate-dominating-file): Expand file argument. (Bug#17641) + +2014-05-30 Glenn Morris <rgm@gnu.org> + + * loadup.el: Treat `command-line-args' more flexibly. + +2014-05-30 Alan Mackenzie <acm@muc.de> + + Guard (looking-at "\\s!") from XEmacs. + * progmodes/cc-engine.el (c-state-pp-to-literal): Add guard form. + +2014-05-30 Ken Olum <kdo@cosmos.phy.tufts.edu> + + * mail/rmail.el (rmail-delete-forward, rmail-delete-backward): + The argument COUNT is now optional, to be more backward-compatible. + Doc fix. (Bug#17560) + +2014-05-29 Reuben Thomas <rrt@sc3d.org> + + * whitespace.el (whitespace-report-region): + Simplify documentation. + (whitespace-report-region): Allow report-if-bogus to take the + value `never', for non-interactive use. + (whitespace-report): Refer to whitespace-report-region's + documentation. + +2014-05-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * whitespace.el: Use font-lock-flush. Minimize refontifications. + Side benefit: it works without jit-lock. + (whitespace-point--used): New buffer-local var. + (whitespace-color-on): Initialize it and flush it. Use font-lock-flush. + (whitespace-color-off): Use font-lock-flush. + (whitespace-point--used, whitespace-point--flush-used): New functions. + (whitespace-trailing-regexp, whitespace-empty-at-bob-regexp) + (whitespace-empty-at-eob-regexp): Use them. + (whitespace-post-command-hook): Rewrite. + + * font-lock.el (font-lock-flush, font-lock-ensure): New functions. + (font-lock-fontify-buffer): Mark interactive-only. + (font-lock-multiline, font-lock-fontified, font-lock-set-defaults): + Make buffer-local. + (font-lock-specified-p): Remove redundant boundp check. + (font-lock-flush-function, font-lock-ensure-function): New vars. + (font-lock-turn-on-thing-lock): Set them. + (font-lock-default-fontify-buffer): Obey font-lock-dont-widen. + (font-lock-after-change-function): Make `old-len' optional. + (font-lock-set-defaults): Remove redundant `set' of font-lock-defaults. + Call font-lock-flush, just in case. + * progmodes/verilog-mode.el (verilog-preprocess): Disable workaround in + recent Emacsen. + * progmodes/vera-mode.el (vera-fontify-buffer): Declare obsolete. + (vera-mode-map, vera-mode-menu): Remove bindings to it. + * progmodes/idlw-help.el (idlwave-help-fontify): Use font-lock-ensure + and with-syntax-table. + * textmodes/conf-mode.el (conf-quote-normal): + * progmodes/sh-script.el (sh-set-shell): + * progmodes/prog-mode.el (prettify-symbols-mode): + * progmodes/f90.el (f90-font-lock-n): + * progmodes/cwarn.el (cwarn-mode): + * nxml/nxml-mode.el (nxml-toggle-char-ref-extra-display): + * progmodes/compile.el (compilation-setup, compilation--unsetup): + * hi-lock.el (hi-lock-mode, hi-lock-unface-buffer) + (hi-lock-set-pattern, hi-lock-set-file-patterns): Use font-lock-flush. + * mail/rmail.el (rmail-variables): Set font-lock-dont-widen instead of + font-lock-fontify-buffer-function and + font-lock-unfontify-buffer-function. + (rmail-unfontify-buffer-function, rmail-fontify-message): + Use with-silent-modifications. + * htmlfontify.el (hfy-force-fontification): Use jit-lock-fontify-now + and font-lock-ensure. + * bs.el (bs-show-in-buffer): Use font-lock-ensure. + +2014-05-28 Thien-Thi Nguyen <ttn@gnu.org> + + * emacs-lisp/package.el (package-generate-autoloads): + Inhibit backup files. + +2014-05-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/hideshow.el (hs-hide-all): Call syntax-propertize + (bug#17608). + +2014-05-21 Michal Nazarewicz <mina86@mina86.com> + + * textmodes/tildify.el (tildify-buffer, tildify-region): + Add dont-ask option. + +2014-05-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (zerop): Move from C. Add compiler-macro (bug#17475). + * emacs-lisp/byte-opt.el (byte-optimize-zerop): Remove. + + * subr.el (internal--funcall-interactively): New. + (internal--call-interactively): Remove. + (called-interactively-p): Detect funcall-interactively instead of + call-interactively. + * simple.el (repeat-complex-command): Use funcall-interactively. + (repeat-complex-command--called-interactively-skip): Remove. + +2014-05-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * register.el (register-read-with-preview): Don't burp on + frame switches (e.g. due to the frame we just popped). + + * mouse.el (mouse-set-region): Handle spurious drag events (bug#17562). + (mouse-drag-track): Annotate `mouse-drag-start' so we know we moved. + +2014-05-26 Andreas Schwab <schwab@linux-m68k.org> * cus-face.el (custom-face-attributes): Add :distant-foreground. -2014-05-25 Martin Rudalics <rudalics@gmx.at> +2014-05-26 Martin Rudalics <rudalics@gmx.at> - * window.el (window--dump-frame): Remove interactive - specification. + * window.el (window--dump-frame): Remove interactive specification. -2014-05-23 Glenn Morris <rgm@gnu.org> +2014-05-26 Glenn Morris <rgm@gnu.org> * hippie-exp.el (he-line-search-regexp): Handle comint-prompt-regexp containing subgroups. (Bug#17529) -2014-05-23 Stephen Berman <stephen.berman@gmx.net> +2014-05-26 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el: Remove dependence on auto-mode-alist, to avoid errors when trying to create or visit a file foo.todo @@ -1772,14 +8029,14 @@ (auto-mode-alist): Remove add-to-list calls making Todo file extensions unrestrictedly tied to Todo modes. -2014-05-23 Stefan Monnier <monnier@iro.umontreal.ca> +2014-05-26 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/nadvice.el (advice--member-p): Change second arg. (advice-function-member-p): Tell it to check both names and functions (bug#17531). (advice--add-function): Adjust call accordingly. -2014-05-23 Stephen Berman <stephen.berman@gmx.net> +2014-05-26 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el: Miscellaneous bug fixes. (todo-delete-file): When deleting an archive but not its todo @@ -1811,21 +8068,21 @@ (todo-reset-highlight-item): Also reset in filtered items files. Fix incorrect variable reference in document string. -2014-05-22 Glenn Morris <rgm@gnu.org> +2014-05-26 Glenn Morris <rgm@gnu.org> * window.el (window--dump-frame): Avoid error in --without-x builds. -2014-05-21 Glenn Morris <rgm@gnu.org> +2014-05-26 Glenn Morris <rgm@gnu.org> * nxml/nxml-mode.el (xml-mode): Only define this alias once. -2014-05-21 Eli Zaretskii <eliz@gnu.org> +2014-05-26 Eli Zaretskii <eliz@gnu.org> * frame.el (set-frame-font): Doc fix. * menu-bar.el (menu-set-font): Doc fix. (Bug#17532) -2014-05-21 Dmitry Gutov <dgutov@yandex.ru> +2014-05-26 Dmitry Gutov <dgutov@yandex.ru> * emacs-lisp/package.el (package--download-one-archive): Use `write-region' instead of `save-buffer' to avoid running various @@ -1833,7 +8090,7 @@ (describe-package-1): Same. Insert newline at the end of the buffer if appropriate. -2014-05-20 Juri Linkov <juri@jurta.org> +2014-05-26 Juri Linkov <juri@jurta.org> * avoid.el (mouse-avoidance-set-mouse-position): Don't raise frame. (mouse-avoidance-ignore-p): Remove `switch-frame', add `focus-out'. @@ -1843,7 +8100,7 @@ * avoid.el (mouse-avoidance-banish-position): Fix defcustom :options to allow changing its value with `set-variable'. -2014-05-20 Stefan Monnier <monnier@iro.umontreal.ca> +2014-05-26 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/scheme.el (scheme-mode-syntax-table): Remove hack for #; comments. @@ -1855,32 +8112,136 @@ * emacs-lisp/lisp.el (end-of-defun): Ensure we move (bug#17274). -2014-05-18 Stefan Monnier <monnier@iro.umontreal.ca> - * emacs-lisp/timer.el (timer-event-handler): Don't run if canceled (bug#17392). -2014-05-17 Michael Albinus <michael.albinus@gmx.de> +2014-05-26 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-find-inline-encoding): Do not match "%%t" for a temporary file name. -2014-05-17 Eli Zaretskii <eliz@gnu.org> +2014-05-26 Eli Zaretskii <eliz@gnu.org> * simple.el (line-move-ignore-invisible): Doc fix. (Bug#17511) -2014-05-16 Michael Albinus <michael.albinus@gmx.de> +2014-05-26 Michael Albinus <michael.albinus@gmx.de> * net/dbus.el (dbus-init-bus, dbus-call-method) (dbus-call-method-asynchronously, dbus-send-signal) (dbus-method-return-internal, dbus-method-error-internal): Check, whether Emacs has been compiled with D-Bus support. (Bug#17508) -2014-05-14 Nicolas Richard <theonewiththeevillook@yahoo.fr> +2014-05-26 Nicolas Richard <theonewiththeevillook@yahoo.fr> * emacs-lisp/eieio-opt.el (eieio-help-class): Correctly deal with methods which do not have a doc string. (Bug#17490) +2014-05-25 Tassilo Horn <tsdh@gnu.org> + + * textmodes/reftex-ref.el (reftex-format-special): Make it work + also for AMS Math's \eqref macro. + +2014-05-25 Thien-Thi Nguyen <ttn@gnu.org> + + Arrange to never byte-compile the generated -pkg.el file. + + * emacs-lisp/package.el (package-generate-description-file): + Output first-line comment to set buffer-local var `no-byte-compile'. + Suggested by Dmitry Gutov: + <http://lists.gnu.org/archive/html/emacs-devel/2014-05/msg00401.html>. + +2014-05-25 Thien-Thi Nguyen <ttn@gnu.org> + + Fix bug: Properly quote args to generated -pkg.el `define-package'. + + * emacs-lisp/package.el (package-generate-description-file): + Inline `package--alist-to-plist'; rewrite to selectively + quote alist values that are not self-quoting. + (package--alist-to-plist): Delete func. + +2014-05-25 Andreas Schwab <schwab@linux-m68k.org> + + * term/xterm.el (xterm-function-map): Add mapping for shifted + keypad keys. + +2014-05-24 Daniel Colascione <dancol@dancol.org> + + * progmodes/subword.el (subword-find-word-boundary): Move point to + correct spot before search. (Bug#17580) + + * emacs-lisp/nadvice.el (defun): Write in eval-and-compile to avoid + breaking the build. + +2014-05-24 Leo Liu <sdl.web@gmail.com> + + * calc/calc.el (math-bignum): Handle most-negative-fixnum. (Bug#17556) + +2014-05-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * minibuffer.el (completion--sreverse): Remove. + (completion--common-suffix): Use `reverse' instead. + * emacs-lisp/regexp-opt.el (regexp-opt-group): Use `reverse' on strings. + +2014-05-22 Glenn Morris <rgm@gnu.org> + + * shell.el (shell-mode) <shell-dirstack-query>: Bypass bash aliases. + +2014-05-21 Daniel Colascione <dancol@dancol.org> + + * files.el (interpreter-mode-alist): Add mksh. + + * progmodes/sh-script.el (sh-ancestor-alist): Add mksh, a pdksh + derivative. + (sh-alias-alist): Alias /system/bin/sh (Android's system shell) to + mksh. Improve custom spec; allow regular expressions. + (sh-shell): Delegate name splitting to `sh-canonicalize-shell'. + (sh-after-hack-local-variables): New function. + (sh-mode): Use it; respect file-local `sh-shell' variable. (Bug#17333) + (sh-set-shell): Use `sh-canonicalize-shell' instead of open-coding + the normalization. + (sh-canonicalize-shell): Rewrite to support regexes. + +2014-05-21 Leo Liu <sdl.web@gmail.com> + + * emacs-lisp/cl-lib.el (cl-endp): Fix last change. + +2014-05-19 Leo Liu <sdl.web@gmail.com> + + * emacs-lisp/cl-lib.el (cl-endp): Conform to CL's semantics. + +2014-05-18 Glenn Morris <rgm@gnu.org> + + * loadup.el: + * play/gametree.el: `track-mouse' is always defined since 2012-11-24. + +2014-05-14 Sam Steingold <sds@gnu.org> + + * progmodes/python.el (python-shell-get-or-create-process): + Do not bind `current-prefix-arg' so that C-c C-z does not talk + back unless requested. + +2014-05-14 Glenn Morris <rgm@gnu.org> + + * subr.el (with-file-modes): New macro. + * printing.el (pr-save-file-modes): Make obsolete. + * eshell/esh-util.el (eshell-with-file-modes): Make obsolete. + * emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-2): + Add with-file-modes. + * doc-view.el (doc-view-make-safe-dir): + * epg.el (epg--start): + * files.el (locate-user-emacs-file, make-temp-file) + (backup-buffer-copy, move-file-to-trash): + * printing.el (pr-despool-print, pr-call-process, pr-text2ps): + * eshell/esh-util.el (eshell-with-private-file-modes) + (eshell-make-private-directory): + * net/browse-url.el (browse-url-mosaic): + * obsolete/mailpost.el (post-mail-send-it): + * obsolete/pgg-pgp.el (pgg-pgp-verify-region): + * obsolete/pgg-pgp5.el (pgg-pgp5-verify-region): + Use with-file-modes. + + * vc/emerge.el (emerge-make-temp-file): Simplify. + 2014-05-14 Stephen Berman <stephen.berman@gmx.net> Stefan Monnier <monnier@iro.umontreal.ca> @@ -1893,14 +8254,31 @@ Make pointless option obsolete. (emerge-temp-file-mode): Make non-functional option obsolete. -2014-05-13 Michael Albinus <michael.albinus@gmx.de> +2014-05-14 Michael Albinus <michael.albinus@gmx.de> * net/browse-url.el (browse-url): Use `unhandled-file-name-directory' when setting `default-directory', in order to circumvent stalled remote connections. (Bug#17425) +2014-05-14 Glenn Morris <rgm@gnu.org> + + * printing.el (subst-char-in-string, make-temp-file, pr-get-symbol): + Optimize on Emacs, which has the relevant functions for ages. + +2014-05-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * simple.el (undo-make-selective-list): Obey undo-no-redo. + +2014-05-12 Sam Steingold <sds@gnu.org> + + * calendar/time-date.el (seconds-to-string): New function to + pretty print time delay in seconds. + 2014-05-12 Stefan Monnier <monnier@iro.umontreal.ca> + * mpc.el (mpc-format): Trim Date to the year. + (mpc-songs-hashcons): Shorten the Date field. + * emacs-lisp/nadvice.el (advice--interactive-form): Don't get fooled into autoloading just because of a silly indirection. @@ -1908,19 +8286,17 @@ * vc/vc-hg.el (vc-hg-unregister): New function. (Bug#17454) -2014-05-11 Glenn Morris <rgm@gnu.org> +2014-05-12 Glenn Morris <rgm@gnu.org> * emacs-lisp/find-gc.el: Move to ../admin. -2014-05-10 Glenn Morris <rgm@gnu.org> - * printing.el (pr-version): * ps-print.el (ps-print-version): Also mention bug-gnu-emacs. * net/browse-url.el (browse-url-mosaic): Create /tmp/Mosaic.PID as a private file. -2014-05-10 Stefan Monnier <monnier@iro.umontreal.ca> +2014-05-12 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/nadvice.el: Support adding a given function multiple times. (advice--member-p): If name is given, only compare the name. @@ -1930,21 +8306,17 @@ (advice--add-function): Pass the name, if any, to advice--remove-function. -2014-05-09 Philipp Rumpf <prumpf@gmail.com> (tiny change) +2014-05-12 Philipp Rumpf <prumpf@gmail.com> (tiny change) * electric.el (electric-indent-post-self-insert-function): Don't use `pos' after modifying the buffer (bug#17449). -2014-05-09 Stefan Monnier <monnier@iro.umontreal.ca> - - * subr.el (function-put): Add function. - -2014-05-09 Stephen Berman <stephen.berman@gmx.net> +2014-05-12 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el (todo-insert-item-from-calendar): Correct argument list to conform to todo-insert-item--basic. -2014-05-09 Glenn Morris <rgm@gnu.org> +2014-05-12 Glenn Morris <rgm@gnu.org> * files.el (cd-absolute): Test if directory is accessible rather than executable. (Bug#17330) @@ -1952,21 +8324,60 @@ * progmodes/compile.el (recompile): Handle C-u M-x recompile from a non-compilation buffer. (Bug#17444) -2014-05-08 Juri Linkov <juri@jurta.org> - - * dired.el (dired-check-switches, dired-switches-recursive-p): - New functions. (Bug#17218) - (dired-switches-escape-p, dired-move-to-end-of-filename): - Use `dired-check-switches'. - (dired-insert-old-subdirs, dired-build-subdir-alist) - (dired-sort-R-check): Use `dired-switches-recursive-p'. - -2014-05-08 Glenn Morris <rgm@gnu.org> - * net/browse-url.el (browse-url-mosaic): Be careful when writing /tmp/Mosaic.PID. (Bug#17428) This is CVE-2014-3423. +2014-05-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * mouse.el: Use the normal toplevel loop while dragging. + (mouse-set-point): Handle multi-clicks. + (mouse-set-region): Handle multi-clicks for drags. + (mouse-drag-region): Update call accordingly. + (mouse-drag-track): Remove `do-mouse-drag-region-post-process' hack. + Use the normal event loop instead of a local while/read-event loop. + (global-map): Remove redundant bindings for double/triple-mouse-1. + * xt-mouse.el (xterm-mouse-translate-1): Only process one event at a time. + Generate synthetic down events when the protocol only sends up events. + (xterm-mouse-last): Remove. + (xterm-mouse--read-event-sequence-1000): Use xterm-mouse-last-down + terminal parameter instead. + (xterm-mouse--set-click-count): New function. + (xterm-mouse-event): Detect/generate double/triple clicks. + * reveal.el (reveal-close-old-overlays): Don't close while dragging. + + * info.el (Info-quoted): New face. + (Info-mode-font-lock-keywords): New var. + (Info-mode): Use it. + + * emacs-lisp/lisp-mode.el (preceding-sexp): Exclude leading "," which + are a hindrance for C-x C-e. + +2014-05-11 Leo Liu <sdl.web@gmail.com> + + * net/rcirc.el (rcirc-sentinel): Fix last change. + +2014-05-08 Sam Steingold <sds@gnu.org> + + * net/rcirc.el (rcirc-reconnect-delay): New user option. + (rcirc-sentinel): Auto-reconnect to the server if + `rcirc-reconnect-delay' is non-0 (but not more often than its + value in case the host is off-line). + +2014-05-09 Eli Zaretskii <eliz@gnu.org> + + * progmodes/grep.el (lgrep): Fix a typo in last commit. + +2014-05-09 Glenn Morris <rgm@gnu.org> + + * files.el (file-expand-wildcards): + * man.el (Man-support-local-filenames): + * printing.el (pr-i-directory, pr-interface-directory): + * progmodes/grep.el (lgrep, rgrep): + * textmodes/ispell.el (ispell-call-process) + (ispell-call-process-region, ispell-start-process) + (ispell-init-process): Use file-accessible-directory-p. + 2014-05-08 Stefan Monnier <monnier@iro.umontreal.ca> * xt-mouse.el: Drop spurious/oddly shaped events (bug#17378). @@ -1975,24 +8386,24 @@ (xterm-mouse-event): Propagate it. (xterm-mouse-translate-1): Handle it. -2014-05-07 Stephen Berman <stephen.berman@gmx.net> +2014-05-08 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el (todo-insert-item--apply-args): When all four slots of the parameter list are filled, make sure to pass it to the argument list of todo-insert-item--basic. -2014-05-06 Stefan Monnier <monnier@iro.umontreal.ca> +2014-05-08 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/package.el (package-compute-transaction): Topological sort. Add optional `seen' argument to detect and break infinite loops. -2014-05-06 Eli Zaretskii <eliz@gnu.org> +2014-05-08 Eli Zaretskii <eliz@gnu.org> * emacs-lisp/find-gc.el (find-gc-unsafe, find-unsafe-funcs) (trace-unsafe, trace-use-tree): Make parentheses style be according to Emacs style. -2014-05-06 Michael Albinus <michael.albinus@gmx.de> +2014-05-08 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-remote-process-environment): Remove HISTFILE and HISTSIZE; it's too late to set them here. @@ -2010,7 +8421,7 @@ name. (Bug#17415) This is CVE-2014-3424. -2014-05-06 Glenn Morris <rgm@gnu.org> +2014-05-08 Glenn Morris <rgm@gnu.org> * emacs-lisp/find-gc.el (find-gc-source-directory): Give it a value. (find-gc-source-files): Update some names. @@ -2018,7 +8429,7 @@ Avoid predictable temp-file names. (http://bugs.debian.org/747100) This is CVE-2014-3422. -2014-05-05 Stefan Monnier <monnier@iro.umontreal.ca> +2014-05-08 Stefan Monnier <monnier@iro.umontreal.ca> * minibuffer.el (completion--try-word-completion): Revert fix for Bug#15980 (bug#17375). @@ -2028,30 +8439,47 @@ Don't burp is xterm-mouse-last is not set as expected. Never return negative indices. -2014-05-05 Dmitry Gutov <dgutov@yandex.ru> +2014-05-08 Dmitry Gutov <dgutov@yandex.ru> * progmodes/ruby-mode.el (ruby-syntax-propertize-function): Backtrack one char if the global/char-literal var matcher hits inside a string. The next char could be the beginning of an expression expansion. -2014-05-05 Glenn Morris <rgm@gnu.org> +2014-05-08 Glenn Morris <rgm@gnu.org> * help-fns.el (describe-function-1): Test for an autoload before a macro, since `macrop' works on autoloads. (Bug#17410) -2014-05-05 Stefan Monnier <monnier@iro.umontreal.ca> +2014-05-08 Stefan Monnier <monnier@iro.umontreal.ca> * electric.el (electric-indent-functions-without-reindent): Add yaml. * minibuffer.el (completion-table-with-quoting) <completion--unquote>: Make sure the new point we return is within the new string (bug#17239). -2014-05-03 Eli Zaretskii <eliz@gnu.org> +2014-05-05 Daniel Colascione <dancol@dancol.org> + + * progmodes/compile.el (compilation-error-regexp-alist-alist): + Port `gnu' pattern to rx. + +2014-05-05 Jarek Czekalski <jarekczek@poczta.onet.pl> + + Remove unneeded prompt when closing a buffer with active + emacsclient ("Buffer ... still has clients"), #16548. + * server.el (server-start): Remove the only call to: + (server-kill-buffer-query-function): Remove. + +2014-05-04 Leo Liu <sdl.web@gmail.com> + + * calendar/diary-lib.el (calendar-chinese-month-name-array): + Defvar to pacify compiler. + +2014-05-04 Eli Zaretskii <eliz@gnu.org> * mail/rmailsum.el (rmail-new-summary-1): Fix a typo in a comment. -2014-05-03 Stefan Monnier <monnier@iro.umontreal.ca> +2014-05-04 Stefan Monnier <monnier@iro.umontreal.ca> * vc/ediff-diff.el (ediff-set-fine-diff-properties-in-one-buffer): Use nil rather than `default' for the "default" appearance (bug#17388). @@ -2061,12 +8489,12 @@ * vc/ediff-init.el (ediff-set-overlay-face): Don't set help-echo if the overlay is not visible. -2014-05-02 Stephen Berman <stephen.berman@gmx.net> +2014-05-04 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el (todo-edit-file): Use display-warning. (todo-menu): Uncomment and update. -2014-05-02 Stephen Berman <stephen.berman@gmx.net> +2014-05-04 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el: Reimplement item editing to have the same basic user interface as item insertion, and make small UI and @@ -2119,11 +8547,11 @@ (todo-key-bindings-t): Bind "e" to todo-edit-item. Remove bindings of deleted commands. -2014-05-02 Leo Liu <sdl.web@gmail.com> +2014-05-04 Leo Liu <sdl.web@gmail.com> * emacs-lisp/cl-macs.el (cl-deftype): Fix indentation. -2014-05-01 Glenn Morris <rgm@gnu.org> +2014-05-04 Glenn Morris <rgm@gnu.org> * allout-widgets.el (allout-widgets-tally) (allout-decorate-item-guides): @@ -2137,58 +8565,146 @@ * textmodes/reftex-parse.el (reftex-using-biblatex-p): Doc fixes (replace `iff'). -2014-05-01 Stefan Monnier <monnier@iro.umontreal.ca> +2014-05-04 Stefan Monnier <monnier@iro.umontreal.ca> * mpc.el (mpc-volume-mouse-set): Don't burp at the boundaries. +2014-05-04 Leo Liu <sdl.web@gmail.com> + + Support Chinese diary entries in calendar and diary. (Bug#17393) + * calendar/cal-china.el (calendar-chinese-month-name-array): New var. + (calendar-chinese-from-absolute-for-diary) + (calendar-chinese-to-absolute-for-diary) + (calendar-chinese-mark-date-pattern, diary-chinese-mark-entries) + (diary-chinese-list-entries): New functions to list and mark + Chinese diary entries in the calendar window. + (diary-chinese-anniversary) + (diary-chinese-insert-anniversary-entry) + (diary-chinese-insert-entry, diary-chinese-insert-monthly-entry) + (diary-chinese-insert-yearly-entry): New commands to insert + Chinese diary entries. + + * calendar/diary-lib.el (diary-font-lock-keywords): + Support font-locking Chinese dates. + + * calendar/cal-menu.el (cal-menu-diary-menu): Add entries for + inserting Chinese diary entries. + + * calendar/calendar.el (diary-chinese-entry-symbol): + New customizable variable. + (calendar-mode-map): Add bindings for inserting Chinese diary + entries. + +2014-05-03 Juri Linkov <juri@jurta.org> + + * dired.el (dired-check-switches, dired-switches-recursive-p): + New functions. (Bug#17218) + (dired-switches-escape-p, dired-move-to-end-of-filename): + Use `dired-check-switches'. + (dired-insert-old-subdirs, dired-build-subdir-alist) + (dired-sort-R-check): Use `dired-switches-recursive-p'. + +2014-05-01 Barry O'Reilly <gundaetiapo@gmail.com> + + * simple.el (undo-make-selective-list): New algorithm fixes + incorrectness of position adjustments when undoing in region. + (Bug#17235) + (undo-elt-crosses-region): Make obsolete. + (undo-adjust-elt, undo-adjust-beg-end, undo-adjust-pos): + New functions to adjust positions using undo-deltas. + +2014-05-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/lisp-mode.el (lisp--match-hidden-arg): Only highlight past + the last consecutive closing paren (bug#17345). + +2014-04-30 Reuben Thomas <rrt@sc3d.org> + + * dired.el (dired-mode): make terminology for eXpunge command + consistent. (Bug#17276) + 2014-04-30 Eli Zaretskii <eliz@gnu.org> * dired.el (dired-initial-position-hook, dired-initial-position): Doc string fixes. -2014-04-29 Glenn Morris <rgm@gnu.org> +2014-04-30 Glenn Morris <rgm@gnu.org> * mail/rmail.el (rmail-quit): Handle killed summaries. (Bug#17283) -2014-04-27 Matthias Dahl <matthias.dahl@binary-island.eu> +2014-04-30 Matthias Dahl <matthias.dahl@binary-island.eu> * faces.el (face-spec-recalc): Apply X resources only after the defface spec has been applied. Thus, X resources are no longer - overridden by the defface spec which also fixes issues on win32 where + overriden by the defface spec which also fixes issues on win32 where the toolbar coloring was wrong because it is set through X resources - and was (wrongfully) overridden. (Bug#16694) + and was (wrongfully) overriden. (Bug#16694) -2014-04-28 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-30 Stefan Monnier <monnier@iro.umontreal.ca> * textmodes/rst.el (electric-pair-pairs): Declare. (rst-mode): Set it (bug#17131). -2014-04-27 Juri Linkov <juri@jurta.org> +2014-04-30 Juri Linkov <juri@jurta.org> * desktop.el (desktop-value-to-string): Let-bind `print-length' and `print-level' to nil. (Bug#17351) -2014-04-25 Nicolas Richard <theonewiththeevillook@yahoo.fr> +2014-04-30 Nicolas Richard <theonewiththeevillook@yahoo.fr> * battery.el (battery-update): Handle the case where battery status is "N/A" (bug#17319). -2014-04-24 Eli Zaretskii <eliz@gnu.org> +2014-04-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/ps-mode.el: Use SMIE. Move string and comment recognition + to syntax-propertize. + (ps-mode-auto-indent): Mark as obsolete. + (ps-mode-font-lock-keywords-1): Remove string-or-comment handling. + (ps-mode-font-lock-keywords-3): Use symbol regexp operators instead of + word regexp operators. + (ps-mode-map): Move initialization into declaration. Remove binding + for TAB, RET, >, ], and }. + (ps-mode-syntax-table): Move initialization into declaration. + Don't give word syntax to non-word chars. + (ps-run-mode-map): Move initialization into declaration. + (ps-mode-menu-main): Remove auto-indent entry. + (ps-mode-smie-rules): New function. + (ps-mode): Setup smie, syntax-propertize, and electric-indent-mode. + (ps-mode-looking-at-nested, ps-mode-match-string-or-comment): Remove. + (ps-mode--string-syntax-table): New const. + (ps-mode--syntax-propertize-special, ps-mode-syntax-propertize): + New functions. + (ps-mode-newline, ps-mode-tabkey, ps-mode-r-brace, ps-mode-r-angle) + (ps-mode-r-gt, ps-mode-r-balance): Remove functions. + +2014-04-27 Daniel Colascione <dancol@dancol.org> + + * term/xterm.el (xterm-paste): Use large finite timeout when + reading event to avoid putting keys in this-command-keys. + +2014-04-25 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/perl-mode.el (perl--syntax-exp-intro-regexp): New var. + (perl-syntax-propertize-function): Use it. Extend handling of + here-docs to the unquoted case. + +2014-04-25 Eli Zaretskii <eliz@gnu.org> * tooltip.el (tooltip-show-help-non-mode, tooltip-show-help): Use equal-including-properties to compare help-echo strings (bug#17331). -2014-04-24 Leo Liu <sdl.web@gmail.com> +2014-04-25 Leo Liu <sdl.web@gmail.com> * emacs-lisp/lisp-mode.el (emacs-lisp-mode-syntax-table): Fix syntax for @. (Bug#17325) -2014-04-24 Daniel Colascione <dancol@dancol.org> +2014-04-25 Daniel Colascione <dancol@dancol.org> * emacs-lisp/cl.el (gv): Require gv early to break eager macro-expansion cycles. -2014-04-23 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-25 Stefan Monnier <monnier@iro.umontreal.ca> * simple.el (region-active-p): Check there's a mark (bug#17324). @@ -2204,11 +8720,42 @@ * progmodes/perl-mode.el (perl-syntax-propertize-function): Slash after &, |, +, - and * can't be a division (bug#17317). -2014-04-22 Stefan Monnier <monnier@iro.umontreal.ca> - * term/xterm.el (xterm--version-handler): Don't use modern xterm features on gnome-terminal (bug#16988). +2014-04-25 Thien-Thi Nguyen <ttn@gnu.org> + + Improve Scheme font-locking for (define ((foo ...) ...) ...). + + * progmodes/scheme.el (scheme-font-lock-keywords-1): To find + the declared object, ignore zero or more parens, not zero or one. + +2014-04-24 Leo Liu <sdl.web@gmail.com> + + * progmodes/xscheme.el (xscheme-expressions-ring) + (xscheme-expressions-ring-yank-pointer, xscheme-running-p) + (xscheme-control-g-disabled-p, xscheme-process-filter-state) + (xscheme-allow-output-p, xscheme-prompt) + (xscheme-string-accumulator, xscheme-mode-string): Use defvar-local. + + * progmodes/scheme.el (would-be-symbol, next-sexp-as-string): + Comment out unused functions. + +2014-04-24 Stefan Monnier <monnier@iro.umontreal.ca> + + * info.el: Use lexical-binding and cl-lib. + Use defvar-local and setq-local instead of make-local-variable. + (Info-apropos-matches): Avoid add-to-list. + (Info-edit-mode-map): Fix obsolescence call to Info-edit-map. + +2014-04-24 Daniel Colascione <dancol@dancol.org> + + * progmodes/sh-script.el (sh-builtins): Add coproc to list of bash builtins. + +2014-04-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/cl-macs.el (cl--loop-let): Fix last merge. + 2014-04-22 Michael Heerdegen <michael_heerdegen@web.de> * dired.el (dired-insert-set-properties): Do not consider @@ -2222,30 +8769,119 @@ (tramp-do-copy-or-rename-file-out-of-band): Do not quote `source' and `target' twice. -2014-04-21 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-22 Stefan Monnier <monnier@iro.umontreal.ca> * dframe.el (dframe-get-focus): Remove `hook' argument (bug#17311). * speedbar.el (speedbar-get-focus): Run the "hook" afterwards instead. * emacs-lisp/cl-macs.el (cl--loop-let): Avoid `nil' as var name. -2014-04-21 Michael Albinus <michael.albinus@gmx.de> +2014-04-22 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-sh-handle-file-name-all-completions): Set "IFS=" when using read builtin, in order to preserve spaces in the file name. Add test messages for hunting a bug on hydra. (tramp-get-ls-command): Undo using "-b" argument. It doesn't help. -2014-04-21 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-22 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/prog-mode.el (prettify-symbols--compose-symbol): Don't prettify a word within a symbol. -2014-04-20 Michael Albinus <michael.albinus@gmx.de> +2014-04-22 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-get-ls-command): Use "-b" argument if possible. +2014-04-22 Daniel Colascione <dancol@dancol.org> + + * emacs-lisp/byte-run.el (function-put): Unbreak build: don't + use defun to define `function-put'. + +2014-04-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/lisp-mode.el (lisp--match-hidden-arg): New function. + (lisp-el-font-lock-keywords-2, lisp-cl-font-lock-keywords-2): Use it. + (lisp-mode-variables): Set font-lock-extra-managed-props. + + * emacs-lisp/byte-run.el (function-put): New function. + (defun-declarations-alist): Use it. Add `pure' and `side-effect-free'. + * emacs-lisp/cl-macs.el (cl-defstruct, cl-struct-sequence-type) + (cl-struct-slot-info, cl-struct-slot-offset, cl-struct-slot-value): + Use them. + +2014-04-22 Daniel Colascione <dancol@dancol.org> + + * emacs-lisp/macroexp.el (internal-macroexpand-for-load): + Add `full-p' parameter; when nil, call `macroexpand' instead of + `macroexpand-all'. + + * emacs-lisp/byte-run.el (eval-when-compile, eval-and-compile): + Improve docstrings. + + * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): + Use lambda function values, not quoted lambdas. + (byte-compile-recurse-toplevel): Remove extraneous &optional. + + * emacs-lisp/cl-macs.el + (cl-struct-sequence-type, cl-struct-slot-info): Declare pure. + (cl-struct-slot-value): Conditionally use aref or nth so that the + compiler produces optimal code. + +2014-04-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/cl-macs.el (cl-struct-slot-offset): Mark as pure. + (inline): Don't inline cl--set-elt. + (cl-struct-slot-value): Remove explicit gv-setter and compiler-macro. + Define as inlinable instead. + (cl-struct-set-slot-value): Remove. + + * emacs-lisp/cl-lib.el (cl--set-elt): Remove. + * emacs-lisp/cl-seq.el (cl-replace, cl-substitute, cl-nsubstitute): + Use setf instead. + +2014-04-21 Daniel Colascione <dancol@dancol.org> + + * emacs-lisp/cl-macs.el (cl--const-expr-val): We didn't need the + last two parameters after all. + (cl--expr-contains,cl--compiler-macro-typep,cl--compiler-macro-member) + (cl--compiler-macro-assoc,cl-struct-slot-value) + (cl-struct-set-slot-value): Stop using them. + +(2014-04-21 Stefan Monnier <monnier@iro.umontreal.ca> + + * image-mode.el (image-mode-window-put): Don't assume there's a `t' + entry in image-mode-winprops-alist. + +2014-04-21 Daniel Colascione <dancol@dancol.org> + + * emacs-lisp/bytecomp.el (byte-compile-recurse-toplevel): New function. + (byte-compile-recurse-toplevel, byte-compile-initial-macro-environment) + (byte-compile-toplevel-file-form): Use it. + + * emacs-lisp/cl-macs.el: + (cl--loop-let): Properly destructure `while' clauses. + +2014-04-20 Daniel Colascione <dancol@dancol.org> + + * vc/vc.el (vc-root-dir): New public autoloaded function for + generically finding the current VC root. + * vc/vc-hooks.el (vc-not-supported): New error. + (vc-call-backend): Signal `vc-not-supported' instead of generic error. + +2014-04-20 Daniel Colascione <dancol@dancol.org> + + * emacs-lisp/cl-macs.el (cl-the): Make `cl-the' assert its type + argument. + (cl--const-expr-val): cl--const-expr-val should macroexpand its + argument in case we're inside a symbol-macrolet. + (cl--do-arglist, cl--compiler-macro-typep) + (cl--compiler-macro-member, cl--compiler-macro-assoc): Pass macro + environment to `cl--const-expr-val'. + (cl-struct-sequence-type,cl-struct-slot-info) + (cl-struct-slot-offset, cl-struct-slot-value) + (cl-struct-set-slot-value): New functions. + 2014-04-19 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/sh-script.el (sh-smie--sh-keyword-p): Handle variable @@ -2268,12 +8904,46 @@ * net/tramp-compat.el (tramp-unload-hook): Unload `tramp-loaddefs'. -2014-04-16 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-17 Daniel Colascione <dancol@dancol.org> + + Add support for bracketed paste mode; add infrastructure for + managing terminal mode enabling and disabling automatically. + + * xt-mouse.el: + (xterm-mouse-mode): Simplify. + (xterm-mouse-tracking-enable-sequence) + (xterm-mouse-tracking-disable-sequence): New constants. + (turn-on-xterm-mouse-tracking-on-terminal) + (turn-off-xterm-mouse-tracking-on-terminal): + Use tty-mode-set-strings and tty-mode-reset-strings terminal + parameters instead of random hooks. + (turn-on-xterm-mouse-tracking) + (turn-off-xterm-mouse-tracking): Delete. + + * term/xterm.el (xterm-extra-capabilities): Fix bitrotted comment. + (xterm-paste-ending-sequence): New constant. + (xterm-paste): New command used for bracketed paste support. + + (xterm-modify-other-keys-terminal-list): Delete obsolete variable. + (terminal-init-xterm-bracketed-paste-mode): New function. + (terminal-init-xterm): Call it. + (terminal-init-xterm-modify-other-keys): Use tty-mode-set-strings + and tty-mode-reset-strings instead of random hooks. + (xterm-turn-on-modify-other-keys) + (xterm-turn-off-modify-other-keys) + (xterm-remove-modify-other-keys): Delete obsolete functions. + + * term/screen.el: Rewrite to just use the xterm code. + Add copyright notice. Mention tmux. + +2014-04-17 Ian D <dunni@gnu.org> (tiny change) + + * image-mode.el (image-mode-window-put): Also update the property of + the "default window". + * doc-view.el (doc-view-new-window-function): If no window + exists, move to the last known page. - * nxml/nxml-mode.el (nxml-fontify-matcher): Make sure propertization - was done (bug#17264). - * nxml/xmltok.el (xmltok-scan-after-comment-open): Extend unclosed - comment to EOB. +2014-04-16 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/perl-mode.el (perl-calculate-indent): Don't auto-indent in here-documents (bug#17262). @@ -2283,7 +8953,7 @@ * term/pc-win.el (x-list-fonts, x-get-selection-value): Provide doc strings, as required by snarf-documentation. -2014-04-15 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-16 Stefan Monnier <monnier@iro.umontreal.ca> * ps-def.el (ps-generate-postscript-with-faces1): Use the new `sorted' arg of overlays-at. Use `invisible-p'. @@ -2293,46 +8963,69 @@ overlays-at. (hfy-fontify-buffer): Remove unused var `orig-ovls'. -2014-04-14 João Távora <joaotavora@gmail.com> +2014-04-16 João Távora <joaotavora@gmail.com> * net/shr.el (shr-expand-url): Use `expand-file-name' for relative links. (Bug#17217). -2014-04-14 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> +2014-04-16 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> * vc/ediff-diff.el (ediff-set-fine-diff-properties-in-one-buffer): Use mapc to loop over a vector. (Bug#17257). -2014-04-13 Michael Albinus <michael.albinus@gmx.de> +2014-04-16 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-sh-handle-file-truename): Revert previous patch, there are new problems with file names containing spaces. Get rid of backticks. (Bug#17238) -2014-04-13 João Távora <joaotavora@gmail.com> +2014-04-16 João Távora <joaotavora@gmail.com> * elec-pair.el (electric-pair--syntax-ppss): Simplify and fix possible bug. -2014-04-13 Eli Zaretskii <eliz@gnu.org> +2014-04-16 Eli Zaretskii <eliz@gnu.org> * frame.el (blink-cursor-blinks, blink-cursor-blinks-done): Doc fixes. (blink-cursor-mode): Mention customization variables and the effect of 'blink-cursor-blinks'. -2014-04-12 Barry O'Reilly <gundaetiapo@gmail.com> +2014-04-16 Barry O'Reilly <gundaetiapo@gmail.com> * simple.el (undo): Prevent insertion of identity mapping into undo-equiv-table so as undo-only does not inf loop in the presence of consecutive nils in undo list. -2014-04-12 Matthias Dahl <matthias.dahl@binary-island.eu> +2014-04-16 Matthias Dahl <matthias.dahl@binary-island.eu> * faces.el (make-face): Deprecate optional argument as it is no longer needed/used since the conditional X resources handling has been pushed down to make-face-x-resource-internal itself. (make-empty-face): Don't pass optional argument to make-face. +2014-04-16 Karl Fogel <kfogel@red-bean.com> + + * savehist.el (savehist-save): Remove workaround for a read-passwd + bug that was fixed before 24.3. Thanks to Juanma Barranquero for + noticing that the shim was still present. + +2014-04-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * doc-view.el (doc-view-set-doc-type): Ignore file name case; add .pps. + +2014-04-14 Juanma Barranquero <lekktu@gmail.com> + + * faces.el (face-set-after-frame-default): Remove unused local variable. + +2014-04-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/grep.el: Use lexical-binding. + (grep-expand-template): Pass explicit lexical env to `eval'. + (zrgrep): Let-bind grep-find-template explicitly. + + * emacs-lisp/cl-lib.el (current-case-table): Remove setter. + * leim/quail/sisheng.el (sisheng-list): Use with-case-table. + 2014-04-12 Eli Zaretskii <eliz@gnu.org> * international/characters.el <standard-case-table>: Add entries @@ -2341,24 +9034,34 @@ 2014-04-12 Leo Liu <sdl.web@gmail.com> - * progmodes/octave.el (completion-table-with-cache): Define if not - available. - (octave-goto-function-definition) - (octave-sync-function-file-names) - (octave-find-definition-default-filename): Backquote upattern for - compatibility. + * progmodes/octave.el (completion-table-with-cache): + Define if not available. + (octave-goto-function-definition, octave-sync-function-file-names) + (octave-find-definition-default-filename): + Backquote upattern for compatibility. -2014-04-11 Michael Albinus <michael.albinus@gmx.de> +2014-04-12 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-sh-handle-file-truename): Quote the file name twice due to backticks. (Bug#17238) -2014-04-11 Glenn Morris <rgm@gnu.org> +2014-04-12 Glenn Morris <rgm@gnu.org> * term/w32-win.el (x-win-suspend-error): * term/x-win.el (x-win-suspend-error): Sync docs. -2014-04-10 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-12 Matthias Dahl <matthias.dahl@binary-island.eu> + + * faces.el (make-face): Remove deprecated optional argument. + The conditional application of X resources is handled directly by + make-face-x-resource-internal since Emacs 24.4. + (make-empty-face): Don't pass optional argument to make-face. + +2014-04-11 Glenn Morris <rgm@gnu.org> + + * Makefile.in (EMACSDATA, EMACSDOC, EMACSPATH): Unexport. (Bug#16429) + +2014-04-11 Stefan Monnier <monnier@iro.umontreal.ca> Ediff's overlay priorities cause more trouble than they solve. * vc/ediff-init.el (ediff-shadow-overlay-priority): Remove variable. @@ -2368,12 +9071,12 @@ (ediff-set-fine-diff-properties-in-one-buffer): Don't mess with overlay priorities. -2014-04-10 Feng Li <fengli@gmail.com> (tiny change) +2014-04-11 Feng Li <fengli@gmail.com> (tiny change) * progmodes/pascal.el (pascal-font-lock-keywords): Fix incorrect format entry; use symbol boundaries to avoid mis-matches. -2014-04-10 Michael Albinus <michael.albinus@gmx.de> +2014-04-11 Michael Albinus <michael.albinus@gmx.de> * net/tramp.el (tramp-file-name-handler) (tramp-completion-file-name-handler): Avoid recursive loading. @@ -2381,21 +9084,86 @@ * net/tramp-sh.el (tramp-make-copy-program-file-name): Quote result also locally. +2014-04-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * emulation/cua-base.el (<toplevel>, cua--pre-command-handler-1): + Remove left-over code. + + * newcomment.el (comment-indent-new-line): Sink code where it's used. + Reuse the previous comment's indentation unconditionally if it's on its + own line. + +2014-04-09 Daniel Colascione <dancol@dancol.org> + + * emacs-lisp/lisp.el (backward-up-list): Add `escape-strings', + `no-syntax-crossing' arguments. Forward to `up-list'. + (up-list): Add `escape-strings', `no-syntax-crossing' arguments. + Implement logic for escaping from strings. Use narrowing to deal + with corner cases. + +2014-04-09 Leo Liu <sdl.web@gmail.com> + + * net/rcirc.el (rcirc-connection-info): New variable. + (rcirc-connect): Use it to store connection info. + (rcirc-buffer-process): Avoid get-buffer-process which returns nil + for killed process. + (rcirc-cmd-reconnect): New command. (Bug#17045) + (rcirc-mode, set-rcirc-encode-coding-system) + (set-rcirc-decode-coding-system, rcirc-connect): Use setq-local. + +2014-04-09 Daniel Colascione <dancol@dancol.org> + + * emacs-lisp/cl-indent.el: Add comment claiming + facility is also good for elisp. + (lisp-indent-find-method): New function. + (common-lisp-indent-function): Recognize cl-loop. + (common-lisp-indent-function-1): Recognize cl constructs; use + `lisp-indent-find-method' instead of `get' directly. + (if): Use else-body style for elisp. + 2014-04-09 Dmitry Gutov <dgutov@yandex.ru> * progmodes/ruby-mode.el (ruby-font-lock-keywords): Highlight more Module methods. (Bug#17216) -2014-04-08 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-09 Stefan Monnier <monnier@iro.umontreal.ca> * help.el (describe-bindings): Fix buffer handling (bug#17210). (describe-bindings-internal): Mark obsolete. +2014-04-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (with-silent-modifications): Don't bind deactivate-mark, + buffer-file-name, and buffer-file-truename any more. + +2014-04-08 Leo Liu <sdl.web@gmail.com> + + Use lexical-binding and require cl-lib. + * net/rcirc.el (rcirc, rcirc-handler-ctcp-KEEPALIVE) + (rcirc-handler-generic, rcirc-fill-paragraph) + (rcirc-format-response-string, rcirc-target-buffer) + (rcirc-last-line, rcirc-record-activity, rcirc-split-activity) + (rcirc-activity-string, rcirc-make-trees, rcirc-cmd-ctcp) + (rcirc-ctcp-sender-PING, rcirc-browse-url) + (rcirc-markup-timestamp, rcirc-markup-attributes) + (rcirc-markup-my-nick, rcirc-markup-urls) + (rcirc-markup-bright-nicks, rcirc-markup-fill) + (rcirc-check-auth-status, rcirc-handler-WALLOPS) + (rcirc-handler-JOIN, rcirc-handler-PART-or-KICK) + (rcirc-handler-PART, rcirc-handler-KICK, rcirc-handler-QUIT) + (rcirc-handler-NICK, rcirc-handler-PING, rcirc-handler-PONG) + (rcirc-handler-TOPIC, rcirc-handler-301, rcirc-handler-317) + (rcirc-handler-332, rcirc-handler-333, rcirc-handler-477) + (rcirc-handler-MODE, rcirc-handler-353, rcirc-handler-366) + (rcirc-authenticate, rcirc-handler-INVITE, rcirc-handler-ERROR) + (rcirc-handler-ctcp-VERSION, rcirc-handler-ctcp-TIME) + (rcirc-handler-CTCP-response): Fix unused arguments warnings and + use cl-lib. + 2014-04-07 João Távora <joaotavora@gmail.com> - * elec-pair.el: - (electric-pair--syntax-ppss): When inside comments parse from - comment beginning. + * elec-pair.el (electric-pair--syntax-ppss): + When inside comments parse from comment beginning. (electric-pair--balance-info): Fix typo in comment. (electric-pair--in-unterminated-string-p): Delete. (electric-pair--unbalanced-strings-p): New function. @@ -2403,8 +9171,6 @@ (electric-pair-inhibit-if-helps-balance): Decide quote pairing according to `electric-pair--in-unterminated-string-p' -2014-04-07 João Távora <joaotavora@gmail.com> - * elec-pair.el (electric-pair-inhibit-if-helps-balance): Inhibit quote pairing if point-max is inside an unterminated string. (electric-pair--looking-at-unterminated-string-p): Delete. @@ -2415,43 +9181,39 @@ * shell.el (shell-directory-tracker): Go back to just ignoring failures. (Bug#17159) -2014-04-06 João Távora <joaotavora@gmail.com> +2014-04-07 João Távora <joaotavora@gmail.com> Fix `electric-pair-delete-adjacent-pairs' in modes binding - backspace. (bug#16981) + backspace. (Bug#16981) * elec-pair.el (electric-pair-backward-delete-char): Delete. (electric-pair-backward-delete-char-untabify): Delete. (electric-pair-mode-map): Bind backspace to a menu item filtering a new `electric-pair-delete-pair' command. (electric-pair-delete-pair): New command. -2014-04-06 João Távora <joaotavora@gmail.com> - * progmodes/python.el (python-electric-pair-string-delimiter): Fix triple-quoting electricity. (Bug#17192) -2014-04-06 João Távora <joaotavora@gmail.com> - * elec-pair.el (electric-pair-post-self-insert-function): Don't skip whitespace when `electric-pair-text-pairs' and `electric-pair-pairs' were used. syntax to electric-pair--skip-whitespace. (Bug#17183) -2014-04-06 Eli Zaretskii <eliz@gnu.org> +2014-04-07 Eli Zaretskii <eliz@gnu.org> * leim/quail/ipa.el (ipa-x-sampa): Fix the character produced for "<F>". (Bug#17199) -2014-04-06 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-07 Stefan Monnier <monnier@iro.umontreal.ca> * mpc.el (mpc--status-timer-run): Disable timer if not displayed. (mpc--status-idle-timer-run): Use mpc--status-timer-run. -2014-04-05 Glenn Morris <rgm@gnu.org> +2014-04-07 Glenn Morris <rgm@gnu.org> * help.el (view-lossage): Doc tweak. -2014-04-05 Matthias Dahl <matthias.dahl@binary-island.eu> +2014-04-07 Matthias Dahl <ml_emacs-lists@binary-island.eu> * faces.el (face-spec-recalc): Call make-face-x-resource-internal only when inhibit-x-resources is nil, and do that earlier in the @@ -2466,30 +9228,30 @@ (face-set-after-frame-default): Don't call make-face-x-resource-internal here. (Bug#16434) -2014-04-04 Tassilo Horn <tsdh@gnu.org> +2014-04-07 Tassilo Horn <tsdh@gnu.org> * doc-view.el (doc-view-bookmark-jump): Use `bookmark-after-jump-hook' to jump to the right page after the buffer is shown in a window. (bug#16090) -2014-04-04 Eli Zaretskii <eliz@gnu.org> +2014-04-07 Eli Zaretskii <eliz@gnu.org> * international/characters.el (mirroring): Fix last change: instead of loading uni-mirrored.el explicitly, do that implicitly by creating the 'mirroring' uniprop table. This avoids announcing the loading of uni-mirrored.el. -2014-04-04 Glenn Morris <rgm@gnu.org> +2014-04-07 Glenn Morris <rgm@gnu.org> * files.el (buffer-stale--default-function) (buffer-stale-function, revert-buffer--default): * autorevert.el (auto-revert-buffers): Doc tweaks. -2014-04-03 Eli Zaretskii <eliz@gnu.org> +2014-04-07 Eli Zaretskii <eliz@gnu.org> * international/characters.el: Preload uni-mirrored.el. (Bug#17169) -2014-04-03 Glenn Morris <rgm@gnu.org> +2014-04-07 Glenn Morris <rgm@gnu.org> * files.el (make-backup-file-name-function) (make-backup-file-name, make-backup-file-name--default-function) @@ -2503,18 +9265,57 @@ (make-backup-file-name-function): Bump :version. Restore nil as a valid but deprecated custom type. -2014-04-03 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-07 Stefan Monnier <monnier@iro.umontreal.ca> - * progmodes/perl-mode.el (perl-syntax-propertize-function): Handle $' - used as a variable (bug#17174). - -2014-04-02 Stefan Monnier <monnier@iro.umontreal.ca> + * progmodes/perl-mode.el (perl-syntax-propertize-function): + Handle $' used as a variable (bug#17174). * progmodes/perl-mode.el (perl-indent-new-calculate): Handle forward-sexp failure (bug#16985). (perl-syntax-propertize-function): Add "foreach" and "for" statement modifiers introducing expressions (bug#17116). +2014-04-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * dired-aux.el (dired-file-set-difference): Use lexical-scoping. + +2014-04-05 Leo Liu <sdl.web@gmail.com> + + * emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression): + Add define-compilation-mode. + +2014-04-04 João Távora <joaotavora@gmail.com> + + * elec-pair.el (electric-pair--syntax-ppss): When inside comments + parse from comment beginning. + (electric-pair--balance-info): Fix typo in comment. + (electric-pair--in-unterminated-string-p): Delete. + (electric-pair--unbalanced-strings-p): New function. + (electric-pair-string-bound-function): New var. + (electric-pair-inhibit-if-helps-balance): Decide quote pairing + according to `electric-pair--in-unterminated-string-p'. + +2014-04-04 Stefan Monnier <monnier@iro.umontreal.ca> + + * textmodes/reftex-parse.el (reftex--index-tags): Rename `index-tags'. + Move declaration before first use. + (reftex-move-to-next-arg): Silence compiler warning. + +2014-04-04 Joost Kremers <joostkremers@fastmail.fm> (tiny change) + + * textmodes/reftex-toc.el (reftex-toc, reftex-re-enlarge): + Use `window-total-width' instead of `window-width'. + +2014-04-03 Daniel Colascione <dancol@dancol.org> + + * subr.el (set-transient-map): Remove rms's workaround entirely; + use new `suspicious-object' subr to mark our lambda for closer + scrutiny during gc. + +2014-04-02 Richard Stallman <rms@gnu.org> + + * subr.el (set-transient-map): Comment out previous change. + 2014-04-02 Glenn Morris <rgm@gnu.org> * menu-bar.el (menu-bar-file-menu): @@ -2523,21 +9324,132 @@ * simple.el (command-execute): Respect nil disabled-command-function. -2014-04-01 Nicolas Richard <theonewiththeevillook@yahoo.fr> +2014-04-02 Nicolas Richard <theonewiththeevillook@yahoo.fr> * simple.el (command-execute): Do not execute the command when it is disabled; fixes thinko in 2013-02-20 conversion from C. (Bug#17151) -2014-03-29 Juri Linkov <juri@jurta.org> +2014-04-02 Juri Linkov <juri@jurta.org> * dired-aux.el (dired-compress-file): Don't use string-match-p because its match data is used afterwards. -2014-03-28 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-02 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/package.el (package-built-in-p): Treat a min-version of 0 like nil. +2014-04-02 João Távora <joaotavora@gmail.com> + + * elec-pair.el (electric-pair-inhibit-if-helps-balance): + Inhibit quote pairing if point-max is inside an unterminated string. + (electric-pair--looking-at-unterminated-string-p): + Delete. + (electric-pair--in-unterminated-string-p): New function. + +2014-04-01 Daniel Colascione <dancol@dancol.org> + + * minibuffer.el (minibuffer-complete): Prevent assertion failure + when trying to complete the prompt. + +2014-03-31 Leo Liu <sdl.web@gmail.com> + + * emacs-lisp/eldoc.el (eldoc-print-current-symbol-info): + Refactor out eldoc-documentation-function-default. + (eldoc-documentation-function-default): New function. + (eldoc-documentation-function): Change value. + +2014-03-31 Glenn Morris <rgm@gnu.org> + + * simple.el (cycle-spacing--context, cycle-spacing): Doc tweaks. + + * progmodes/vhdl-mode.el (vhdl-speedbar-select-mra) + (vhdl-compose-components-package, vhdl-compose-configuration): + Abbreviate default-directory (missing from some previous upstream sync). + +2014-03-31 Reto Zimmermann <reto@gnu.org> + + Sync with upstream vhdl mode v3.35.2. + * progmodes/vhdl-mode.el (vhdl-version, vhdl-time-stamp): Update. + (top-level): No longer require assoc. + (vhdl-asort, vhdl-anot-head-p, vhdl-aput, vhdl-adelete, vhdl-aget): + New functions. Use throughout to replace aget etc. + (vhdl-aput-delete-if-nil): Rename from vhdl-aput. + (vhdl-update-file-contents): Update for vhdl-aput-delete-if-nil rename. + (vhdl-template-replace-header-keywords): Fix bug for "<title string>". + (vhdl-compile-init): Do not initialize regexps for Emacs 22+. + (vhdl-error-regexp-emacs-alist): Remove regexps from all compilers + except `vhdl-compiler'. + (vhdl-error-regexp-add-emacs): Remove all other compilers, + when appropriate. + +2014-03-31 Glenn Morris <rgm@gnu.org> + + * progmodes/vhdl-mode.el (vhdl-expand-abbrev, vhdl-expand-paren): + Revert 2014-03-26 merge goof; go back to using defalias. + +2014-03-30 Daniel Colascione <dancol@dancol.org> + + * comint.el (comint-send-input): + Deactivate completion-in-region-mode before we send comint input. + (Bug#17139). + + * simple.el (keyboard-quit): Deactivate completion-in-region-mode + on keyboard-quit. + +2014-03-29 Glenn Morris <rgm@gnu.org> + + * textmodes/reftex.el: Manage most autoloads automatically. + * textmodes/reftex-auc.el, textmodes/reftex-cite.el: + * textmodes/reftex-dcr.el, textmodes/reftex-global.el: + * textmodes/reftex-index.el, textmodes/reftex-parse.el: + * textmodes/reftex-ref.el, textmodes/reftex-sel.el: + * textmodes/reftex-toc.el: Set generated-autoload-file, + and add autoload cookies for reftex.el. + * Makefile.in (AUTOGEN_VCS): Add textmodes/reftex.el. + +2014-03-28 Glenn Morris <rgm@gnu.org> + + * cus-start.el (report-emacs-bug-address): Set custom properties. + * mail/emacsbug.el (report-emacs-bug-address): + Variable is now defined in emacs.c. + + * mail/emacsbug.el (report-emacs-bug): + Include system-configuration-features. + +2014-03-28 Michal Nazarewicz <mina86@mina86.com> + + * simple.el (cycle-spacing): Never delete spaces on first run by + default, but do so in a new 'fast mode and if there are already + N spaces (the previous behavior). + Compare N with its value in previous invocation so that changing + prefix argument restarts `cycle-spacing' sequence. + The idea is that with this change, binding M-SPC to + `cycle-spacing' should not introduce any changes in behavior of + the binding so long as users do not type M-SPC twice in a raw with + the same prefix argument or lack thereof. + +2014-03-28 Glenn Morris <rgm@gnu.org> + + * faces.el (term-file-aliases): New variable. + (tty-run-terminal-initialization): Respect term-file-aliases. + * term/apollo.el, term/vt102.el, term/vt125.el, term/vt201.el: + * term/vt220.el, term/vt240.el, term/vt300.el, term/vt320.el: + * term/vt400.el, term/vt420.el: Remove files, replaced by aliases. + +2014-03-27 Glenn Morris <rgm@gnu.org> + + * startup.el (inhibit-startup-hooks): Doc tweak. + (normal-top-level): Simplify running of hooks. + For window-setup-hook, respect inhibit-startup-hooks. + (command-line-1): Don't set window-setup-hook to nil. + + Allow selective autoloading from obsolete/ directory. + * Makefile.in (obsolete-autoloads): New rule. + (autoloads): Run obsolete-autoloads. + * obsolete/iswitchb.el (iswitchb-mode): Use obsolete-autoload. + * simple.el (iswitchb-mode): Remove hand-written autoloads. + 2014-03-27 Dmitry Gutov <dgutov@yandex.ru> * progmodes/ruby-mode.el (ruby-font-lock-keywords): @@ -2555,6 +9467,11 @@ * emacs-lisp/package-x.el (package--archive-contents-from-url): Use url-insert-file-contents; package-handle-response no longer exists. +2014-03-26 Daniel Colascione <dancol@dancol.org> + + * simple.el (process-menu-mode-map): New variable. + (process-menu-delete-process): New command. + 2014-03-26 Juanma Barranquero <lekktu@gmail.com> * emacs-lisp/package.el: Fix bug#16733 (again). @@ -2566,11 +9483,7 @@ dynamic binding of `buffer'. (describe-package-1): Do not decode readme-string. -2014-03-25 Barry O'Reilly <gundaetiapo@gmail.com> - - * simple.el (primitive-undo): Correction to 2014-03-24 change. - -2014-03-25 Michael Albinus <michael.albinus@gmx.de> +2014-03-26 Michael Albinus <michael.albinus@gmx.de> * net/tramp.el (tramp-methods, tramp-connection-timeout): Fix docstring. @@ -2582,7 +9495,7 @@ (tramp-do-copy-or-rename-file-directly): In the `rename' case, check whether source directory has set the sticky bit. -2014-03-24 Barry O'Reilly <gundaetiapo@gmail.com> +2014-03-26 Barry O'Reilly <gundaetiapo@gmail.com> * simple.el (primitive-undo): Only process marker adjustments validated against their corresponding (TEXT . POS). Issue warning @@ -2594,28 +9507,11 @@ (undo-elt-in-region): Return nil when passed a marker adjustment and explain in function doc. -2014-03-24 Dmitry Gutov <dgutov@yandex.ru> - - * emacs-lisp/package.el (package--add-to-archive-contents): - Include already installed and built-in packages in - `package-archive-contents'. - (package-install): Don't include already installed packages in the - options during interactive invocation. (Bug#16762) - -2014-03-24 Daniel Colascione <dancol@dancol.org> - - * emacs-lisp/cl-macs.el (cl--do-arglist): Use `plist-member' - instead of cl-loop search function. - -2014-03-24 Juanma Barranquero <lekktu@gmail.com> - - * frameset.el (frameset--initial-params): Fix typo in parameter name. - -2014-03-24 Nicolas Richard <theonewiththeevillook@yahoo.fr> +2014-03-26 Nicolas Richard <theonewiththeevillook@yahoo.fr> * align.el (align-region): Do not fail when end-mark is nil (bug#17088). -2014-03-24 Dmitry Gutov <dgutov@yandex.ru> +2014-03-26 Dmitry Gutov <dgutov@yandex.ru> * progmodes/ruby-mode.el (ruby-expression-expansion-re): Match special global variables without curlies, too. @@ -2623,32 +9519,118 @@ variables. Don't require a non-word character after the variable. (Bug#17057) -2014-03-23 Stefan Monnier <monnier@iro.umontreal.ca> +2014-03-26 Stefan Monnier <monnier@iro.umontreal.ca> * simple.el (redisplay-highlight-region-function): Increase priority of overlay to make sure boundaries are visible (bug#15899). -2014-03-23 Juanma Barranquero <lekktu@gmail.com> +2014-03-26 Juanma Barranquero <lekktu@gmail.com> - * frameset.el (frameset-restore): Compare display strings with equal. + * frameset.el (frameset--initial-params): Fix typo in parameter name. + (frameset-restore): Compare display strings with equal. * frame.el (make-frame): Don't quote display name in error message, it is already a string. -2014-03-23 Thierry Volpiatto <thierry.volpiatto@gmail.com> +2014-03-26 Thierry Volpiatto <thierry.volpiatto@gmail.com> * net/tramp.el (tramp-read-passwd): Suspend the timers while reading the password. -2014-03-23 Dmitry Gutov <dgutov@yandex.ru> +2014-03-26 Dmitry Gutov <dgutov@yandex.ru> - * emacs-lisp/package.el (package-show-package-list): If the buffer - is already displayed in another window, switch to that window. + * emacs-lisp/package.el (package--add-to-archive-contents): + Include already installed and built-in packages in + `package-archive-contents'. + (package-install): Don't include already installed packages in the + options during interactive invocation. (Bug#16762) + (package-show-package-list): If the buffer is already displayed in + another window, switch to that window. + +2014-03-26 Reto Zimmermann <reto@gnu.org> + + Sync with upstream vhdl mode v3.35.1. + * progmodes/vhdl-mode.el (vhdl-version, vhdl-time-stamp): Update. + (vhdl-compiler-alist): Doc fix. + (vhdl-goto-line): Remove. + (vhdl-mode-abbrev-table-init): Add XEmacs compat. + (vhdl-mode) <paragraph-start>: Fix value. + (vhdl-fix-statement-region): Not `for' in wait-statement. + (vhdl-beautify-region): Also (un)tabify. + (vhdl-get-visible-signals): + Scan declarative part of generate statements. + (vhdl-template-record): Fix indentation for record type declaration. + (vhdl-expand-abbrev, vhdl-expand-paren): + Revert to using fset again rather than defalias. + (vhdl-scan-directory-contents): Tweak. + (vhdl-speedbar-find-file, vhdl-speedbar-port-copy) + (vhdl-compose-components-package): + Replace vhdl-goto-line with forward-line. + (top-level): Tweak speedbar frame selection. + (vhdl-generate-makefile-1): Support for compilers with no + unit-to-file name mapping (create directory with dummy files). + +2014-03-26 Wilson Snyder <wsnyder@wsnyder.org> + + Sync with upstream verilog-mode revision 702457d. + * progmodes/verilog-mode.el (verilog-mode-version): Update. + (create-lockfiles): Declare. + (verilog-read-decls): Fix module header imports, bug709. + Reported by Victor Lau. + Fix parsing 'var' in AUTOs, msg1294. Reported by Dominique Chen. + (verilog-auto-inout-module): Fix AUTOINOUTMODULE not inserting + interface-only modules, bug721. Reported by Dean Hoyt. -2014-03-21 Daniel Colascione <dancol@dancol.org> +2014-03-26 Glenn Morris <rgm@gnu.org> - * mail/emacsbug.el (report-emacs-bug): Include memory usage - information in bug reports. + * obsolete/gulp.el: Move here from emacs-lisp/. + + * files.el (lock-buffer, unlock-buffer, file-locked-p): + Remove fallback aliases, since they are always defined now. + +2014-03-24 Daniel Colascione <dancol@dancol.org> + + * emacs-lisp/cl-macs.el (cl--do-arglist): Use `plist-member' + instead of cl-loop search function. + +2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> + + * calendar/parse-time.el (parse-time-iso8601-regexp) + (parse-iso8601-time-string): Copy from `url-dav' so that we can use + it more generally. + +2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> + + * net/dns.el (network-interface-list): Define for XEmacs. + +2014-03-23 Magnus Henoch <magnus.henoch@gmail.com> + + * net/dns.el (dns-servers-up-to-date-p): New function to see whether + the network interfaces changed. + (dns-query): Use it to flush the data. + +2014-03-23 Juanma Barranquero <lekktu@gmail.com> + + * vc/vc.el (vc-rollback): Use set-buffer-modified-p. + +2014-03-23 Daniel Colascione <dancol@dancol.org> + + Change subword-mode to use `find-word-boundary-function-table' and + replace `capitalized-words-mode'. Also, convert to lexical binding. + * progmodes/cap-words.el: Delete now-obsolete file. + * progmodes/subword.el: Reimplement using + `find-word-boundary-function-table'. + (subword-mode-map): Hollow out. + (capitalized-words-mode): Define as obsolete alias for + `subword-mode'. + (subword-mode, superword-mode): Tweak documentation to reflect new + implementation; call `subword-setup-buffer'. + (subword-forward, subword-capitalize): Add underscore to indicate + unused variable. + (subword-find-word-boundary-function-table): New constant. + (subword-empty-char-table): New constant. + (subword-setup-buffer): New function. + (subword-find-word-boundary): New function. 2014-03-23 Daniel Colascione <dancol@dancol.org> @@ -2657,10 +9639,41 @@ (Bug#3647) --- unfortunately, only for freshly-compiled code. Please make bootstrap. -2014-03-23 Richard Stallman <rms@gnu.org> +2014-03-22 Glenn Morris <rgm@gnu.org> - * battery.el (battery-linux-sysfs): Search for each field - from the beginning of the buffer. + * dired.el (dired-read-regexp): Make obsolete. + (dired-mark-files-regexp, dired-mark-files-containing-regexp) + (dired-flag-files-regexp): + * dired-aux.el (dired-mark-read-regexp): + * dired-x.el (dired-mark-unmarked-files): Use read-regexp directly. + + * startup.el (fancy-startup-text): + * help.el (describe-gnu-project): Visit online info about GNU project. + + * help-fns.el (help-fns--interactive-only): New function. + (help-fns-describe-function-functions): Add the above function. + * simple.el (beginning-of-buffer, end-of-buffer, insert-buffer) + (next-line, previous-line): Remove hand-written interactive-only + information from doc strings, it is auto-generated now. + * bookmark.el (bookmark-write): + * epa-mail.el (epa-mail-decrypt, epa-mail-verify, epa-mail-sign) + (epa-mail-import-keys): Mark interactive-only, + and remove hand-written interactive-only information from doc strings. + * epa.el (epa-decrypt-armor-in-region, epa-verify-region) + (epa-verify-cleartext-in-region, epa-sign-region, epa-encrypt-region): + * files.el (not-modified): + * simple.el (mark-whole-buffer): Mark interactive-only. + + * emacs-lisp/byte-run.el (defun-declarations-alist): + Add interactive-only. Doc tweak. + (macro-declarations-alist): Doc tweak. + * subr.el (declare): Doc tweak (add xref to manual). + * comint.el (comint-run): + * files.el (insert-file-literally, insert-file): + * replace.el (replace-string, replace-regexp): + * simple.el (beginning-of-buffer, end-of-buffer, delete-backward-char) + (delete-forward-char, goto-line, insert-buffer, next-line) + (previous-line): Set interactive-only via declare. 2014-03-22 Dmitry Gutov <dgutov@yandex.ru> @@ -2672,6 +9685,36 @@ * w32-common-fns.el (x-selection-owner-p): Add empty docstring for the benefit of doc.c; change parameter profile to match the X function. +2014-03-22 Leo Liu <sdl.web@gmail.com> + + * help.el (temp-buffer-setup-hook): Remove help-mode-setup. + (temp-buffer-show-hook): Remove help-mode-finish. (Bug#16038) + +2014-03-21 Richard Stallman <rms@gnu.org> + + * battery.el (battery-linux-sysfs): Search for each field + from the beginning of the buffer. + + * subr.el (set-transient-map): Clear out function and value + of the temporary symbol when we're done with it. + + * mail/rmailsum.el (rmail-summary-delete-forward): + Optimize case of reaching end and handling count. + (rmail-summary-mark-deleted): Optimize when N is current msg. + Don't create new summary line. + (rmail-summary-undelete): Pass arg to rmail-undelete-previous-message. + (rmail-summary-undelete-many): Rewrite for speed. + (rmail-summary-msg-number): New function. + + * mail/rmail.el (rmail-delete-message): Update summary. + (rmail-undelete-previous-message): Handle repeat count arg. + (rmail-delete-backward, rmail-delete-forward): Likewise. + +2014-03-21 Daniel Colascione <dancol@dancol.org> + + * mail/emacsbug.el (report-emacs-bug): Include memory usage + information in bug reports. + 2014-03-21 Michael Albinus <michael.albinus@gmx.de> * net/tramp.el (tramp-methods): Add docstring for `tramp-login-env' @@ -2720,6 +9763,34 @@ (tty-color-approximate, tty-color-by-index, tty-color-values) (tty-color-desc): Remove superfluous backslashes. +2014-03-21 Glenn Morris <rgm@gnu.org> + + * cus-start.el (history-length): Bump :version. + + * Makefile.in ($(MH_E_DIR)/mh-loaddefs.el) + ($(TRAMP_DIR)/tramp-loaddefs.el, $(CAL_DIR)/cal-loaddefs.el) + ($(CAL_DIR)/diary-loaddefs.el, $(CAL_DIR)/hol-loaddefs.el): + Don't set `make-backup-files'. + + * info.el (info--prettify-description): New function, + to give info-finder descriptions consistent case, punctuation. + (Info-finder-find-node): Use it. Sort packages. + Refer to "description" rather than "commentary". + +2014-03-21 Juanma Barranquero <lekktu@gmail.com> + + * frameset.el (frameset--print-register): New function. + (frameset-to-register): Use it. + +2014-03-20 Juanma Barranquero <lekktu@gmail.com> + + * progmodes/hideif.el (hif-string-to-number): New function. + (hif-tokenize): Use it to understand non-decimal floats. + + * emacs-lisp/cl-extra.el (cl--map-overlays): Remove obsolete code. + + * skeleton.el (skeleton-autowrap): Mark as obsolete. Doc fix. + 2014-03-20 Stefan Monnier <monnier@iro.umontreal.ca> * electric.el (electric-newline-and-maybe-indent): New command. @@ -3036,7 +10107,7 @@ 2014-03-10 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-open-connection-setup-interactive-shell): - Do not add `nil' to the environment, when there's no remote `locale'. + Do not add nil to the environment, when there's no remote `locale'. (tramp-find-inline-encoding): Check, that the remote host has installed perl, before sending scripts. @@ -4127,7 +11198,7 @@ * help-at-pt.el (help-at-pt-string, help-at-pt-maybe-display): Also try to display local help from just before point. -2014-02-02 Alan Mackenzie <bug-cc-mode@gnu.org> +2014-02-02 Alan Mackenzie <acm@muc.de> c-parse-state. Don't "append-lower-brace-pair" in certain circumstances. Also fix an obscure bug where "\\s!" shouldn't be @@ -4614,7 +11685,7 @@ COMMAND-alternatives variable, assign COMMAND as its definition name so that `describe-variable' can relocate it. -2014-01-14 Matthew Leach <matthew@mattleach.net> (tiny change) +2014-01-14 Matthew Leach <matthew@mattleach.net> * font-lock.el (font-lock-keywords): Fix typo in docstring (bug#16307). @@ -6887,7 +13958,7 @@ Add option to delete file when done. (Bug#15647) (python-shell-send-string, python-shell-send-region): Use it. -2013-11-23 Ivan Shmakov <ivan@siamics.net> (tiny change) +2013-11-23 Ivan Shmakov <ivan@siamics.net> * vc/diff-mode.el (diff-mode): Only allow diff-default-read-only to set buffer-read-only to t, never to nil. (Bug#15938) @@ -7503,7 +14574,7 @@ * rect.el (rectangle-mark-mode): Rename from rectangle-mark. Make it into a proper minor mode. - (rectangle--region): (implicitly) rename to rectangle-mark-mode. + (rectangle--region): (Implicitly) rename to rectangle-mark-mode. (rectangle-mark-mode-map): New keymap. (rectangle--highlight-for-redisplay): Fix some corner cases (bug#15796). @@ -7746,8 +14817,7 @@ 2013-10-28 Daiki Ueno <ueno@gnu.org> - * epa-file.el - (epa-file-cache-passphrase-for-symmetric-encryption): + * epa-file.el (epa-file-cache-passphrase-for-symmetric-encryption): Document that this option has no effect with GnuPG 2.0 (bug#15552). 2013-10-27 Xue Fuqiao <xfq.free@gmail.com> @@ -13917,7 +20987,7 @@ 2013-06-04 Alan Mackenzie <acm@muc.de> - Remove faulty optimisation from indentation calculation. + Remove faulty optimization from indentation calculation. * progmodes/cc-engine.el (c-guess-basic-syntax): Don't calculate search limit based on 2000 characters back from indent-point. @@ -14561,9 +21631,8 @@ * textmodes/reftex-vars.el (reftex-ref-style-alist): Add cleveref macros. - * textmodes/reftex-parse.el - (reftex-locate-bibliography-files): Accept options for - bibliography commands. + * textmodes/reftex-parse.el (reftex-locate-bibliography-files): + Accept options for bibliography commands. * textmodes/reftex-vars.el (reftex-bibliography-commands): Add addbibresource. Basic Biblatex support. @@ -16033,8 +23102,7 @@ 2013-04-19 Fabián Ezequiel Gallina <fgallina@gnu.org> New faster Imenu implementation (bug#14058). - * progmodes/python.el: - (python-imenu-prev-index-position): + * progmodes/python.el (python-imenu-prev-index-position) (python-imenu-format-item-label-function) (python-imenu-format-parent-item-label-function) (python-imenu-format-parent-item-jump-label-function): diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10 index f46e26d806a..82d9bf24012 100644 --- a/lisp/ChangeLog.10 +++ b/lisp/ChangeLog.10 @@ -1,4 +1,4 @@ -2003-07-03 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-07-03 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-menus.el (cc-imenu-init): Do not set `imenu-create-index-function' if the second argument is left @@ -9,7 +9,7 @@ (c-lineup-arglist-close-under-paren): Fixes to cope with special brace lists in Pike. -2003-07-03 Alan Mackenzie <bug-cc-mode@gnu.org> +2003-07-03 Alan Mackenzie <acm@muc.de> * progmodes/cc-mode.el (awk-mode): Call c-awk-after-change to ensure syntax-table props at loading. @@ -21,7 +21,7 @@ analyze AWK top-level forms properly (c-guess-basic-syntax CASE 5P), c-awk-backward-syntactic-ws. -2003-07-03 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-07-03 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-fix.el: cc-mode-19.el has been renamed to progmodes/cc-fix.el since it now contains compatibility stuff @@ -59,7 +59,7 @@ * progmodes/cc-langs.el (comment-end): Put a space in front of the comment ender in C, as it was before the move from cc-mode.el. -2003-07-03 Alan Mackenzie <bug-cc-mode@gnu.org> +2003-07-03 Alan Mackenzie <acm@muc.de> * progmodes/cc-fonts.el: Do not load progmodes/cc-awk.elc or awk-font-lock-keywords unless there is an AWK Mode buffer. @@ -72,7 +72,7 @@ * progmodes/cc-engine.el, progmodes/cc-fonts.el: Changes for the new AWK support. -2003-07-03 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-07-03 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el, progmodes/cc-langs.el (c-decl-block-key, c-search-uplist-for-classkey): Check that @@ -940,8 +940,8 @@ This change is slightly incompatible. Although the calling convention for line-up functions is strictly extended, the format - of the `c-syntactic-context' variable has changed slightly. It's - believed that this incompatibility is minor, though; not a single + of the `c-syntactic-context' variable has changed slightly. + It's believed that this incompatibility is minor, though; not a single line-up function distributed with CC Mode needed to be changed, for instance. @@ -1612,7 +1612,7 @@ * dabbrev.el (dabbrev--goto-start-of-abbrev): Use minibuffer-prompt-end. - * comint.el (comint-move-point-for-output): Renamed from + * comint.el (comint-move-point-for-output): Rename from comint-scroll-to-bottom-on-output. Old name is alias. All uses changed. Doc fix. (comint-scroll-show-maximum-output): Doc fix. @@ -2918,7 +2918,7 @@ 2003-05-09 Sam Steingold <sds@gnu.org> - * pcvs.el (cvs-mode-find-file): Fixed the last patch's logic. + * pcvs.el (cvs-mode-find-file): Fix the last patch's logic. 2003-05-09 Stefan Monnier <monnier@cs.yale.edu> @@ -3253,7 +3253,7 @@ 2003-05-03 Richard M. Stallman <rms@gnu.org> - * emacs-lisp/autoload.el (update-directory-autoloads): Renamed from + * emacs-lisp/autoload.el (update-directory-autoloads): Rename from update-autoloads-from-directories. * progmodes/cperl-mode.el (cperl-nonoverridable-face): Doc fix. @@ -3792,7 +3792,7 @@ for both the argument and the value. * desktop.el (desktop-base-file-name): - Renamed from desktop-basefilename. Add defvaralias. + Rename from desktop-basefilename. Add defvaralias. 2003-04-14 John Paul Wallington <jpw@gnu.org> @@ -3859,7 +3859,7 @@ (describe-minor-mode-completion-table-for-symbol): New functions. minor-mode-list is used here. (describe-minor-mode-from-symbol): - Renamed from (old) describe-minor-mode. + Rename from (old) describe-minor-mode. Use describe-minor-mode-completion-table-for-symbol. Don't use eval. Just use symbol-name. (describe-minor-mode-from-indicator): Document is updated. @@ -3929,7 +3929,7 @@ * international/mule.el: Don't set after-insert-file-adjust-coding-function. (after-insert-file-set-coding): - Renamed from after-insert-file-set-buffer-file-coding-system. + Rename from after-insert-file-set-buffer-file-coding-system. 2003-04-11 Kenichi Handa <handa@m17n.org> @@ -3952,13 +3952,13 @@ (quail-make-guidance-frame): Delete the arg BUF. Fix position calculation. Don't set the window buffer, just return the new frame. (quail-minibuffer-message): New function. - (quail-show-guidance): Renamed from quail-show-guidance-buf. + (quail-show-guidance): Rename from quail-show-guidance-buf. Use message and quail-minibuffer-message to display the guidance. - (quail-hide-guidance): Renamed from quail-hide-guidance-buf. + (quail-hide-guidance): Rename from quail-hide-guidance-buf. Only delete quail-guidance-frame. (quail-update-guidance): Just update quail-guidance-str, not display it. - (quail-get-translations): Renamed from quail-show-translations. + (quail-get-translations): Rename from quail-show-translations. Return a string instead of inserting it in quail-guidance-buf. 2003-04-11 Kenichi Handa <handa@m17n.org> @@ -3969,7 +3969,7 @@ 2003-04-10 Juanma Barranquero <lektu@terra.es> - * frame.el (modify-all-frames-parameters): Deleted. + * frame.el (modify-all-frames-parameters): Delete. 2003-04-10 Sebastian Tennant <seb@albert.vcisp.net> (tiny change) @@ -4071,7 +4071,7 @@ (utf-16-le-with-signature, utf-16-be-with-signature) (utf-16): Aliases of the above coding systems. -2003-04-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-04-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-langs.el (c-symbol-key): Use POSIX char classes to match symbols. This makes CC Mode cope with the full range @@ -4146,7 +4146,7 @@ 2003-04-06 Masatake YAMATO <jet@gyve.org> - * progmodes/etags.el (tag-find-file-of-tag): Renamed from + * progmodes/etags.el (tag-find-file-of-tag): Rename from find-file-of-tag to avoid name space pollution. (tag-find-file-of-tag-noselect): Likewise. (etags-list-tags, etags-tags-apropos): @@ -4270,10 +4270,10 @@ 2003-04-02 Masatake YAMATO <jet@gyve.org> - * woman.el (woman-xref): Removed. + * woman.el (woman-xref): Remove. (woman-mode): Use `Man-highlight-references' instead of `WoMan-highlight-references'. - (WoMan-highlight-references): Removed. + (WoMan-highlight-references): Remove. * man.el (toplevel): Require button. (Man-header-file-path): New option. @@ -4285,7 +4285,7 @@ `button-buffer-map'. (Man-xref-man-page, Man-xref-header-file, Man-xref-normal-file): New buttons. `Man-xref-man-page' comes from woman.el. - (man-follow-mouse): Removed. + (man-follow-mouse): Remove. (Man-fontify-manpage): Use `Man-highlight-references' instead of calling `add-text-properties' directly. (Man-highlight-references, Man-highlight-references0): New functions. @@ -4525,7 +4525,7 @@ * net/net-utils.el (dns-lookup-host): New function. -2003-03-23 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-03-23 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-mode.el (c-parse-state): Add kludge to avoid an infinite loop when Emacs' open-paren-in-column-zero rule @@ -5471,8 +5471,8 @@ * ffap.el: Many doc fixes. (ffap-replace-file-component): - Renamed from ffap-replace-path-component. Callers changed. - (ffap-host-to-filename): Renamed from ffap-host-to-path. Callers chgd. + Rename from ffap-replace-path-component. Callers changed. + (ffap-host-to-filename): Rename from ffap-host-to-path. Callers chgd. * international/iso-ascii.el (iso-ascii-display-table): New variable. (iso-ascii-standard-display-table): New variable. @@ -5801,13 +5801,13 @@ * language/ind-util.el (indian-itrans-v5-table): Add entries for "E" and "O". -2003-02-10 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-02-10 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-styles.el (c-set-offset): Don't find a default syntactic element through syntactic analysis if called outside a CC Mode buffer. -2003-02-09 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-02-09 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-mode.el (c-basic-common-init): Install `c-fill-paragraph' on `fill-paragraph-function'. @@ -5974,7 +5974,7 @@ * term.el (term-raw-map): Set it up at load time. (term-char-mode): Don't set up term-raw-map here. (term-set-escape-char): Don't set up C-x subcommand. - (term-ansi-face-already-done): Renamed from + (term-ansi-face-already-done): Rename from term-ansi-face-alredy-done. (term-command-hook): Avoid error if STRING is empty. (term, term-mode): Doc fixes. @@ -6134,7 +6134,7 @@ (antlr-slow-syntactic-context): Use cache. (antlr-slow-cache-enabling-symbol): New internal variable. (antlr-slow-cache-diff-threshold): New variable. - (antlr-fast-invalidate-context-cache): Renamed from + (antlr-fast-invalidate-context-cache): Rename from antlr-xemacs-bug-workaround. (antlr-imenu-create-index-function): Search from beginning. @@ -6152,13 +6152,13 @@ (antlr-simple-read-shell-command): Define. (antlr-simple-with-displaying-help-buffer): Define. (antlr-simple-scan-sexps, antlr-simple-scan-lists): - Renamed from antlr-scan-{sexps,lists}-internal. + Rename from antlr-scan-{sexps,lists}-internal. Changes from 2002-02-28: * progmodes/antlr-mode.el: Version 2.2 is released. - * progmodes/antlr-mode.el (antlr): Moved to SourceForge.net + * progmodes/antlr-mode.el (antlr): Move to SourceForge.net * progmodes/antlr-mode.el: Minor bug fixes: insert options and indentation. @@ -6284,7 +6284,7 @@ * ibuf-ext.el (ibuffer-yank-filter-group): Move check for empty `ibuffer-filter-group-kill-ring' out of `interactive' declaration. -2003-01-28 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-01-28 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-vars.el, progmodes/cc-mode.el (c-require-final-newline): Made this variable an alist to @@ -6325,7 +6325,7 @@ * progmodes/ebrowse.el (ebrowse-draw-tree-fn): Likewise. -2003-01-26 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-01-26 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-vars.el, progmodes/cc-mode.el (c-require-final-newline): Add a variable to make the @@ -6930,7 +6930,7 @@ 2003-01-08 Francesco Potortì <pot@gnu.org> - * mail/undigest.el (unforward-rmail-message): Simplified. + * mail/undigest.el (unforward-rmail-message): Simplify. No functional change. 2003-01-07 Markus Rost <rost@math.ohio-state.edu> @@ -7354,7 +7354,7 @@ (makeinfo-compilation-sentinel-buffer, makeinfo-current-node): New functions. (makeinfo-compile): Add a sentinel parameter. - (makeinfo-compilation-sentinel-region): Renamed from + (makeinfo-compilation-sentinel-region): Rename from makeinfo-compilation-sentinel, and makeinfo-temp-file now never nil. (makeinfo-region): Use this. * info.el (Info-revert-find-node): New function. @@ -7412,7 +7412,7 @@ 2002-12-20 Francesco Potortì <pot@gnu.org> - * mail/undigest.el (rmail-mail-separator): Renamed from + * mail/undigest.el (rmail-mail-separator): Rename from rmail-digest-mail-separator. All users changed. (unforward-rmail-message): Rewritten to be more robust and to additionally account for the common style of forwarding messages @@ -7618,7 +7618,7 @@ 2002-12-10 Steven Tamm <steventamm@mac.com> - * generic-x.el (javascript-generic-mode): Added C style block + * generic-x.el (javascript-generic-mode): Add C style block comments as used in ECMA-262 standard. 2002-12-10 Kenichi Handa <handa@m17n.org> @@ -8136,7 +8136,7 @@ * progmodes/sql.el: Added LINTER support. (sql-linter-program): New variable. (sql-linter-options): New variable. - (sql-mode-menu): Added Linter keywords. + (sql-mode-menu): Add Linter keywords. (sql-mode-linter-font-lock-keywords): New variable. (sql-highlight-linter-keywords): New function. (sql-linter): New function. @@ -8165,7 +8165,7 @@ 2002-11-20 Markus Rost <rost@math.ohio-state.edu> - * Makefile.in (setwins_almost): Renamed from finder_setwins. + * Makefile.in (setwins_almost): Rename from finder_setwins. (custom-deps): Use it. (finder-data): Adjust to that name change. @@ -8317,10 +8317,10 @@ diary-entries-list. (diary-mode, fancy-diary-display-mode): New derived modes, for diary file and fancy diary buffer respectively. - (fancy-diary-font-lock-keywords, diary-font-lock-keywords): New - variables. - (font-lock-diary-sexps, font-lock-diary-date-forms): New - functions, used in diary-font-lock-keywords. + (fancy-diary-font-lock-keywords, diary-font-lock-keywords): + New variables. + (font-lock-diary-sexps, font-lock-diary-date-forms): + New functions, used in diary-font-lock-keywords. * calendar/calendar.el (diary-face): New. (european-calendar-display-form, describe-calendar-mode) @@ -8335,9 +8335,9 @@ * international/codepage.el (cp866-decode-table): Fix the translation table. -2002-11-16 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-11-16 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-bytecomp.el (cc-bytecomp-defun): Fixed bug that + * progmodes/cc-bytecomp.el (cc-bytecomp-defun): Fix bug that caused existing function definitions to be overridden by phonies when the bytecomp environment is restored. @@ -8390,7 +8390,7 @@ * files.el (mode-name): Mark it as risky-local-variable like the other mode-line elements (moved from bindings.el). - * bindings.el (mode-name): Moved mark as risky-local-variable to + * bindings.el (mode-name): Move mark as risky-local-variable to files.el. 2002-11-14 Juanma Barranquero <lektu@terra.es> @@ -8452,7 +8452,7 @@ * vc-sccs.el (vc-sccs-registered): Improve comment. -2002-11-13 Tim Van Holder <tim.vanholder@anubex.com> (tiny change) +2002-11-13 Tim Van Holder <tim.vanholder@anubex.com> * progmodes/compile.el (compilation-error-regexp-alist): Don't include colon and space after a file name as part of the name. @@ -8655,13 +8655,13 @@ don't defvar, and make permanent-local. (ucs-unify-8859, ucs-unify-8859, ucs-fragment-8859): Add/remove set-buffer-major-mode-hook, not quail-activate-hook. - (ucs-set-table-for-input): Renamed from ucs-quail-activate. + (ucs-set-table-for-input): Rename from ucs-quail-activate. (ucs-unify-8859, ucs-unify-8859, ucs-fragment-8859): Setup keyboard-translate-table, not translation-table-for-input. Modify set-buffer-major-mode-hook, not quail-activate-hook. (ucs-fragment-8859): Don't use translation-table-for-input coding system property. - (ucs-quail-activate): Deleted. + (ucs-quail-activate): Delete. (ucs-set-table-for-input): New. (ucs-minibuffer-setup): Use it. @@ -8691,7 +8691,7 @@ 2002-11-06 Kim F. Storm <storm@cua.dk> - * info.el (Info-fontify-node): Fixed hiding of *note references + * info.el (Info-fontify-node): Fix hiding of *note references with embedded file names like (xxx.yyy). Avoid making any lines visibly longer if hiding newlines inside note references by wrapping line after references if it contained @@ -8852,7 +8852,7 @@ 2002-10-29 Kim F. Storm <storm@cua.dk> - * ido.el (ido-wide-find-dirs-or-files): Fixed problem that caused + * ido.el (ido-wide-find-dirs-or-files): Fix problem that caused incomplete list of matches to be returned. 2002-10-29 Masayuki Ataka <ataka@milk.freemail.ne.jp> (tiny change) @@ -9119,21 +9119,21 @@ * international/mule-diag.el (non-iso-charset-alist): Add koi8-u. - * international/code-pages.el (cp-make-translation-table): Use - ucs-mule-to-mule-unicode. + * international/code-pages.el (cp-make-translation-table): + Use ucs-mule-to-mule-unicode. (cp-fix-safe-chars): Fix typo. (non-iso-charset-alist): Don't define. (cp-make-coding-system): Use utf-8-translation-table-for-decode. Define translation-table-for-input. (cp866): Reinstate. (alternativnj): Don't define alias. - (koi8-u): Deleted. + (koi8-u): Delete. * language/european.el ("Slovenian"): Use slovenian input-method. (encode-mac-roman): Use ucs-mule-to-mule-unicode. - * language/cyrillic.el (cyrillic-alternativnyj-decode-table): Fix - the table. + * language/cyrillic.el (cyrillic-alternativnyj-decode-table): + Fix the table. (cyrillic-alternativnyj): Don't give it `mime-charset' property. (cp866): Delete this alias. ("Bulgarian"): Fix the value of `input-method'. @@ -9162,8 +9162,8 @@ 2002-10-15 Kenichi Handa <handa@m17n.org> - * mail/sendmail.el (sendmail-send-it): Call - select-message-coding-system before changing the current buffer to + * mail/sendmail.el (sendmail-send-it): + Call select-message-coding-system before changing the current buffer to " sendmail temp". 2002-10-14 Andre Spiegel <spiegel@gnu.org> @@ -9171,7 +9171,7 @@ * files.el (insert-directory): Handle //SUBDIRED// lines in recursive listings from ls --dired. - * vc.el (vc-dired-reformat-line): Simplified. Handles text + * vc.el (vc-dired-reformat-line): Simplify. Handles text properties correctly now. 2002-10-14 Juanma Barranquero <lektu@terra.es> @@ -9208,7 +9208,7 @@ * ediff-init.el (ediff-frame-char-height): Use frame-selected-window. - * ediff-util.el (ediff-file-checked-in-p): Changed progn with and. + * ediff-util.el (ediff-file-checked-in-p): Change progn with and. * ediff-wind.el (ediff-skip-unsuitable-frames): Distinguish selected frame from frame of selected window. @@ -9341,7 +9341,7 @@ 2002-10-07 Kim F. Storm <storm@cua.dk> * emulation/cua-base.el (cua-normal-cursor-color): - Fixed initialization to make "Erase Customization" work. + Fix initialization to make "Erase Customization" work. 2002-10-07 Stefan Monnier <monnier@cs.yale.edu> @@ -9469,7 +9469,7 @@ (widget-editable-list-entry-create): Update caller. * wid-edit.el (widget-types-copy): New function. - (default): Added :copy keyword. + (default): Add :copy keyword. (menu-choice): Ditto. (checklist): Ditto. (radio-button-choice): Ditto. @@ -9580,17 +9580,17 @@ * international/utf-8.el (ucs-mule-to-mule-unicode): Don't define this translation-table name here. (utf-translation-table-for-encode): New translation-table name. - (utf-fragmentation-table): Renamed from utf-8-fragmentation-table. + (utf-fragmentation-table): Rename from utf-8-fragmentation-table. (utf-defragmentation-table): New variable. - (ucs-mule-cjk-to-unicode): Renamed from utf-8-subst-rev-table. + (ucs-mule-cjk-to-unicode): Rename from utf-8-subst-rev-table. (utf-subst-table-for-encode): New translation-table name. - (ucs-unicode-to-mule-cjk): Renamed from utf-8-subst-table. + (ucs-unicode-to-mule-cjk): Rename from utf-8-subst-table. (utf-subst-table-for-decode): New translation-table name. - (utf-fragment-on-decoding): Renamed from + (utf-fragment-on-decoding): Rename from utf-8-fragment-on-decoding. Correctly handle the case that unify-8859-on-encoding-mode is off. Handle mule-utf-16-le and mule-utf-16-be too. - (utf-translate-cjk): Renamed from utf-8-translate-cjk. + (utf-translate-cjk): Rename from utf-8-translate-cjk. Handle mule-utf-16-le and mule-utf-16-be too. (ccl-decode-mule-utf-8): Refer to utf-translation-table-for-decode and utf-subst-table-for-decode. @@ -10044,7 +10044,7 @@ (gamegrid-display-type): Use Emacs' standard `display-.*-p' functions to check for display capabilities. Fix the recognition of image-support in Emacs 21 by this way. - (gamegrid-hide-cursor): Removed. + (gamegrid-hide-cursor): Remove. (gamegrid-setup-default-font): Ported the code from XEmacs to Emacs: create a new face and assign the variable `gamegrid-face' to it. Make sure that the face is not higher than the smallest @@ -10234,7 +10234,7 @@ 2002-09-10 Michael Albinus <Michael.Albinus@alcatel.de> - * net/tramp.el (tramp-handle-write-region): Added missing + * net/tramp.el (tramp-handle-write-region): Add missing `)'. Hope it's the right place. 2002-09-09 Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> @@ -10246,7 +10246,7 @@ something harmless, but the /bin/sh will display a dollar sign which confused the subsequent prompt recognition. (tramp-multi-action-password): More debugging output. - (tramp-encoding-shell): Renamed from tramp-sh-program. + (tramp-encoding-shell): Rename from tramp-sh-program. More documentation. Default to cmd.exe on Windows NT. (tramp-encoding-command-switch): New variable. Use instead of hard-wired "-c" which is only good for /bin/sh. @@ -10286,7 +10286,7 @@ (tramp-completion-handle-file-name-all-completions): Change function call for user/host completion according to definition in `tramp-completion-function-alist'. - (tramp-parse-passwd): Added exception handling for "root", because + (tramp-parse-passwd): Add exception handling for "root", because `tramp-get-completion-su' (the previous place for this stuff) doesn't exist any longer. @@ -10375,7 +10375,7 @@ (tramp-multi-file-name-hop-structure-unified) (tramp-multi-file-name-hop-structure-separate) (tramp-make-multi-tramp-file-format-unified) - (tramp-make-multi-tramp-file-format-separate): Removed. + (tramp-make-multi-tramp-file-format-separate): Remove. (tramp-make-tramp-file-name): Allow partial tramp file names. Generate tramp file format on-the-fly depending on parameters. Apply atomar format strings resp expressions. @@ -10402,7 +10402,7 @@ (tramp-completion-file-name-handler-alist): Add handler for `file-exists-p. (tramp-completion-handle-file-exists-p): New function. - (tramp-completion-handle-file-name-completion): Simplified. + (tramp-completion-handle-file-name-completion): Simplify. (tramp-completion-dissect-file-name): Regexp's reorganized. (tramp-completion-handle-file-name-all-completions): Call completion-function only if `user' or `host' is given. @@ -10683,7 +10683,7 @@ * viper-util.el (viper-chars-in-region): Simplification. - * viper.el (viper-emacs-state-mode-list): Added modes. + * viper.el (viper-emacs-state-mode-list): Add modes. 2002-09-18 Jonathan Yavner <jyavner@engineer.com> @@ -10766,13 +10766,13 @@ (nonincremental-search-forward, nonincremental-re-search-forward) (nonincremental-search-backward, nonincremental-re-search-backward): Set menu-bar-last-search-type to string or regexp. - (nonincremental-repeat-re-search-forward): Removed. - (nonincremental-repeat-re-search-backward): Removed. + (nonincremental-repeat-re-search-forward): Remove. + (nonincremental-repeat-re-search-backward): Remove. (menu-bar-replace-menu): New keymap for "Edit->Replace" submenu. (menu-bar-i-search-menu): New keymap for "Incremental Search" submenu. - (menu-bar-adv-search-menu): Removed. + (menu-bar-adv-search-menu): Remove. (menu-bar-search-menu): Reorganized. - (menu-bar-edit-menu): Added "Replace" submenu. + (menu-bar-edit-menu): Add "Replace" submenu. 2002-09-15 Richard M. Stallman <rms@gnu.org> @@ -10917,7 +10917,7 @@ 2002-09-13 Kim F. Storm <storm@cua.dk> - * kmacro.el (kmacro-keymap): Changed bindings: + * kmacro.el (kmacro-keymap): Change bindings: C-x C-k s to kmacro-start-macro, C-x C-k b to kmacro-bind-to-key. 2002-09-12 Richard M. Stallman <rms@gnu.org> @@ -11033,7 +11033,7 @@ * loadup.el ("simple.el"): Move to after loaddefs.el. - * subr.el (define-mail-user-agent): Moved from simple.el. + * subr.el (define-mail-user-agent): Move from simple.el. 2002-09-10 Richard M. Stallman <rms@gnu.org> @@ -11051,11 +11051,11 @@ * international/ucs-tables.el: Bind utf-8-translation-table-for-decode when setting up tables and remove useless optimize-char-table. - (ucs-mule-to-mule-unicode): Deleted. + (ucs-mule-to-mule-unicode): Delete. (ucs-unify-8859): Maybe optimize ucs-mule-to-mule-unicode. * international/utf-16.el (utf-16-le-pre-write-conversion) - (utf-16-be-pre-write-conversion): Deleted. + (utf-16-be-pre-write-conversion): Delete. (mule-utf-16-le, mule-utf-16-be): Register encoding translation table. 2002-09-10 Richard M. Stallman <rms@gnu.org> @@ -11384,10 +11384,10 @@ * vc-hooks.el: Require vc.el at compile-time. (vc-workfile-unchanged-p, vc-default-workfile-unchanged-p): - Moved here from vc.el. + Move here from vc.el. * vc.el (vc-workfile-unchanged-p, vc-default-workfile-unchanged-p): - Moved to vc-hooks.el. + Move to vc-hooks.el. * vc-rcs.el (vc-rcs-state): Don't require vc.el. @@ -11540,7 +11540,7 @@ 2002-08-30 ARISAWA Akihiro <ari@mbf.sphere.ne.jp> (tiny change) - * ps-print.el (ps-lp-system): Fixed typo in `usg-unix-v'. + * ps-print.el (ps-lp-system): Fix typo in `usg-unix-v'. 2002-08-30 Markus Rost <rost@math.ohio-state.edu> @@ -11660,7 +11660,7 @@ 2002-08-28 Juanma Barranquero <lektu@terra.es> - * replace.el (occur-hook): Renamed from `occur-mode-hook'. + * replace.el (occur-hook): Rename from `occur-mode-hook'. (occur-mode): Remove call to `occur-mode-hook'. (occur-rename-buffer): Fix reference to `occur-mode-hook' in docstring. (occur-1): Add call to `occur-hook'. @@ -11700,9 +11700,9 @@ (reftex-section-number): Better handling of parts: No chapter counter resets. - * textmodes/reftex.el (reftex-highlight-overlays): Added a third + * textmodes/reftex.el (reftex-highlight-overlays): Add a third overlay. - (reftex-mode-menu): Added entry for `reftex-toc-recenter. + (reftex-mode-menu): Add entry for `reftex-toc-recenter. Also moved `reftex-reset-mode' to top level. * textmodes/reftex-toc.el (reftex-toc-recenter): New command. @@ -11745,15 +11745,15 @@ 2002-08-25 Miles Bader <miles@gnu.org> * rfn-eshadow.el (file-name-shadow-properties-custom-type): - Renamed from `read-file-name-electric-shadow-properties-custom-type'. + Rename from `read-file-name-electric-shadow-properties-custom-type'. Change name of face. - (file-name-shadow-properties): Renamed from + (file-name-shadow-properties): Rename from `read-file-name-electric-shadow-properties'. - (file-name-shadow-tty-properties): Renamed from + (file-name-shadow-tty-properties): Rename from `read-file-name-electric-shadow-tty-properties'. - (file-name-shadow): Renamed from `read-file-name-electric-shadow'. + (file-name-shadow): Rename from `read-file-name-electric-shadow'. (rfn-eshadow-setup-minibuffer): Update references to renamed variables. - (file-name-shadow-mode): Renamed from + (file-name-shadow-mode): Rename from `read-file-name-electric-shadow-mode'. Update references to renamed variables. @@ -11797,7 +11797,7 @@ * files.el (ange-ftp-completion-hook-function): Add safe-magic prop. * subr.el (symbol-file-load-history-loaded) - (load-symbol-file-load-history): Deleted. + (load-symbol-file-load-history): Delete. (symbol-file): Don't call load-symbol-file-load-history. 2002-08-23 Andre Spiegel <spiegel@gnu.org> @@ -11859,18 +11859,18 @@ 2002-08-21 Kim F. Storm <storm@cua.dk> - * bindings.el (mode-line-format): Moved global-mode-string last. - (mode-line-position): Moved %p first. Added padding to %l/%c to + * bindings.el (mode-line-format): Move global-mode-string last. + (mode-line-position): Move %p first. Added padding to %l/%c to eliminate jumpiness in modeline. Use (%l,%c) format if both line-number-mode and column-number-mode are enabled. -2002-08-20 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-08-20 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-engine.el (c-forward-syntactic-ws): Fixed a bug + * progmodes/cc-engine.el (c-forward-syntactic-ws): Fix a bug that could cause an infinite loop if something that looks like a macro begins in the middle of a line. - * progmodes/cc-engine.el (c-parse-state): Fixed a bug that + * progmodes/cc-engine.el (c-parse-state): Fix a bug that could cause `c-state-cache' to contain two conses in sequence when there's an unbalanced open paren in a macro. @@ -11990,7 +11990,7 @@ 2002-08-15 Carsten Dominik <dominik@sand.science.uva.nl> - * textmodes/reftex.el (reftex-mode): Moved the creation of special + * textmodes/reftex.el (reftex-mode): Move the creation of special syntax tables to top-level. 2002-08-15 David Kastrup <David.Kastrup@t-online.de> @@ -12094,7 +12094,7 @@ * international/mule-cmds.el (search-unencodable-char): New function. (select-safe-coding-system): Show unencodable characters. - (unencodable-char-position): Deleted, and implemented in C in coding.c. + (unencodable-char-position): Delete, and implemented in C in coding.c. 2002-04-09 John Wiegley <johnw@gnu.org> @@ -12177,9 +12177,9 @@ 2002-08-05 Alan Shutko <ats@acm.org> - * ibuffer.el (ibuffer-mode-map): Added ibuffer-filter-by-used-mode. - (ibuffer-mode-map): Added ibuffer-filter-by-used-mode. - (ibuffer-mode): Added ibuffer-filter-by-used-mode to doc string. + * ibuffer.el (ibuffer-mode-map): Add ibuffer-filter-by-used-mode. + (ibuffer-mode-map): Add ibuffer-filter-by-used-mode. + (ibuffer-mode): Add ibuffer-filter-by-used-mode to doc string. * ibuf-ext.el (ibuffer-list-buffer-modes): New. (ibuffer-filter-by-used-mode): New. @@ -12359,11 +12359,11 @@ 2002-07-31 Richard M. Stallman <rms@gnu.org> - * makefile.w32-in (compile-after-backup): Renamed from `compile'. + * makefile.w32-in (compile-after-backup): Rename from `compile'. Use `compile-always'. (bootstrap): Use `compile', not `compile-files'. Use `update-subdirs'. - (compile): Renamed from `compile-files'. - (compile-CMD, compile-SH): Renamed from `compile-files-*'. + (compile): Rename from `compile-files'. + (compile-CMD, compile-SH): Rename from `compile-files-*'. * emacs-lisp/bytecomp.el (byte-compile-find-cl-functions): Check that (car elt) is a string. @@ -12574,10 +12574,10 @@ 2002-07-25 Carsten Dominik <dominik@astro.uva.nl> * textmodes/reftex.el (reftex-compile-variables): - Simplified regular expression. + Simplify regular expression. * textmodes/reftex-parse.el (reftex-locate-bibliography-files): - Simplified the regexp. + Simplify the regexp. * textmodes/reftex-cite.el (reftex-get-bibkey-default): New function. (reftex-extract-bib-entries-from-thebibliography): @@ -12639,8 +12639,8 @@ * warnings.el (warning-levels): Add %s to the strings. (warning-group-format): New variable. - (warning-suppress-log-types): Renamed from warning-suppress-log. - (warning-suppress-types): Renamed from warning-suppress. + (warning-suppress-log-types): Rename from warning-suppress-log. + (warning-suppress-types): Rename from warning-suppress. (display-warning): Implement those changes. 2002-07-23 Richard M. Stallman <rms@gnu.org> @@ -12677,7 +12677,7 @@ (finder-inf.el): Remove. (update-authors): New target. (TAGS-LISP): Remove $(lispsource). - (compile-always): Renamed from `compile-files'. + (compile-always): Rename from `compile-files'. (compile): New target, adapted from `compile-files'. (compile-calc): New target. (recompile): Change `.' to $(lisp). @@ -12698,7 +12698,7 @@ * net/browse-url.el (browse-url-lynx-input-attempts): Use defcustom. (browse-url-lynx-input-delay): Add custom type and group. - * cus-start.el (double-click-fuzz): Added. + * cus-start.el (double-click-fuzz): Add. 2002-07-22 Alan Shutko <ats@acm.org> @@ -12747,7 +12747,7 @@ (reftex-toc-split-windows-horizontally): New option. (reftex-toc-split-windows-horizontally-fraction): New option. (reftex-include-file-commands): New option. - (reftex-cite-format-builtin): Added ?n for nocite. + (reftex-cite-format-builtin): Add ?n for nocite. * textmodes/reftex-index.el (reftex-query-index-phrase): Use `reftex-index-verify-function'. @@ -12764,7 +12764,7 @@ * textmodes/reftex.el (reftex-compile-variables): Use `reftex-include-file-commands'. - (reftex-type-query-prompt): Changed defconst to defvar. + (reftex-type-query-prompt): Change defconst to defvar. (reftex-type-query-help, reftex-typekey-to-format-alist) (reftex-typekey-to-prefix-alist, reftex-env-or-mac-alist) (reftex-special-env-parsers, reftex-label-mac-list) @@ -12929,7 +12929,7 @@ (ucs-mule-to-mule-unicode): New. (ucs-unify-8859): Use utf-8-fragment-on-decoding, set up Quail translation. - (ucs-fragment-8859): Modified consistent with ucs-unify-8859. + (ucs-fragment-8859): Modify consistent with ucs-unify-8859. (unify-8859-on-encoding-mode): Doc mod. Fix custom version. (unify-8859-on-decoding-mode): Doc mod. Change code. Fix custom version. Add custom dependencies. @@ -13184,7 +13184,7 @@ 2002-07-13 Kim F. Storm <storm@cua.dk> - * progmodes/compile.el (grep-tree): Fixed autoload. + * progmodes/compile.el (grep-tree): Fix autoload. Corrected use of undefined variable `match-files-aliases'. 2002-07-12 Glenn Morris <gmorris@ast.cam.ac.uk> @@ -13263,7 +13263,7 @@ (tramp-handle-file-name-directory): Don't return "/" when completing a remote root directory (where the filename looks like "/method:user@host:/"). - (tramp-handle-ange-ftp): Deleted. + (tramp-handle-ange-ftp): Delete. (tramp-disable-ange-ftp): New function, called at toplevel, deletes Ange-FTP from file-name-handler-alist. (tramp-handle-make-symbolic-link): Implement. @@ -13357,7 +13357,7 @@ * files.el (after-find-file): Don't check for read-only status of files just created (and not yet saved on disk). - * ido.el (ido-completion-help): Changed XEmacs specific code to + * ido.el (ido-completion-help): Change XEmacs specific code to avoid byte compiler warning in GNU Emacs. (ido-set-matches1): Use regexp-quote instead of identity. (ido-complete-space): New function. @@ -13549,7 +13549,7 @@ (define-stroke, strokes-fix-button2-command, strokes-insinuated) (strokes-insinuate, global-set-stroke, describe-stroke) (load-user-strokes, save-strokes, strokes-bug-address) - (strokes-click-command): Deleted. + (strokes-click-command): Delete. (strokes-execute-stroke): Remove strokes-click-p case. (strokes-describe-stroke): Remove strokes-click-p stuff. (strokes-help): Fix. @@ -13868,7 +13868,7 @@ end-statement, specially with regards to nested subprograms. (comment-region advice): Initially disabled, for better compatibility with other modes. - (ada-fill-comment-paragraph): Fixed (no longer worked with Emacs 21). + (ada-fill-comment-paragraph): Fix (no longer worked with Emacs 21). * progmodes/ada-xref.el: Update copyright notice. (ada-xref-create-ali): The default is now not to create automatically @@ -13889,7 +13889,7 @@ (ada-find-references): New parameters arg and local-only. (ada-find-any-references): New parameters local-only and append. (ada-goto-declaration): Fix handling of predefined entities in xref. - (ada-get-all-references): Updated to the new xref format in GNAT 3.15, + (ada-get-all-references): Update to the new xref format in GNAT 3.15, still compatible with GNAT 3.14 of course. Fix various calls to count-lines, that didn't work correctly when the buffer was narrowed. @@ -13958,17 +13958,17 @@ * simple.el (what-cursor-position): Use describe-char. - * descr-text.el (describe-char): Moved from mule-diag.el, renamed + * descr-text.el (describe-char): Move from mule-diag.el, renamed from describe-char-after. Now calls describe-text-properties. - (describe-property-list): Renamed from describe-text-properties. - (describe-text-properties): Renamed from describe-text-at. + (describe-property-list): Rename from describe-text-properties. + (describe-text-properties): Rename from describe-text-at. New arg OUTPUT-BUFFER. (describe-text-properties-1): New subroutine, broken out from describe-text-properties. Output a newline before each section of the output. * international/mule-diag.el (describe-char-after): - Moved to descr-text.el. + Move to descr-text.el. 2002-06-17 Eli Zaretskii <eliz@is.elta.co.il> @@ -14143,9 +14143,9 @@ (eshell-sublist): Use copy-sequence. (eshell-copy-tree): Make it an alias for copy-tree. - * emacs-lisp/cl.el (copy-list): Moved back from subr.el. + * emacs-lisp/cl.el (copy-list): Move back from subr.el. - * subr.el (copy-list): Moved to cl.el. + * subr.el (copy-list): Move to cl.el. (copy-tree): Don't use copy-list or cl-pop. 2002-06-10 Miles Bader <miles@gnu.org> @@ -14189,7 +14189,7 @@ `tty-color-translate' and `tty-color-by-index'; this is now the main place to do it. -2002-06-09 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-06-09 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-styles.el (c-set-style, c-set-style-1): Add another state for the `dont-override' flag where it only keeps @@ -14218,13 +14218,13 @@ 2002-06-08 Colin Walters <walters@verbum.org> - * subr.el (copy-list): Moved here from cl.el. - (copy-tree): Renamed here from `cl-copy-tree' in cl-extra.el. + * subr.el (copy-list): Move here from cl.el. + (copy-tree): Rename here from `cl-copy-tree' in cl-extra.el. - * emacs-lisp/cl-extra.el (cl-copy-tree): Moved to `copy-tree' in + * emacs-lisp/cl-extra.el (cl-copy-tree): Move to `copy-tree' in subr.el. Add a defalias with the old name. - * emacs-lisp/cl.el (copy-list): Moved to subr.el. + * emacs-lisp/cl.el (copy-list): Move to subr.el. * replace.el (occur-mode): Don't set up categories. Do set `font-lock-defaults', and be sure to set `font-lock-core-only'. @@ -14245,7 +14245,7 @@ (ibuffer-compile-format): Don't treat `name' category specially. (ibuffer-column name): Use `font-lock-face'. (filename-and-process): Ditto. - (ibuffer-buffer-name-category): Renamed to + (ibuffer-buffer-name-category): Rename to `ibuffer-buffer-name-face'. Don't use categories. (ibuffer-update-title-and-summary): Use `font-lock-face'. (ibuffer-insert-filter-group): Ditto. @@ -14374,15 +14374,15 @@ * subr.el (open-network-stream, open-network-stream-nowait) (open-network-stream-server, process-kill-without-query): - Moved from simple.el. + Move from simple.el. * simple.el (open-network-stream, open-network-stream-nowait) (open-network-stream-server, process-kill-without-query): - Moved to subr.el. + Move to subr.el. * simple.el (byte-compiling-files-p): Function deleted. - * textmodes/ispell.el (ispell-library-directory): Renamed from + * textmodes/ispell.el (ispell-library-directory): Rename from ispell-library-path. If Ispell is not installed, init to nil. (check-ispell-version): Doc fix. (ispell-menu-map): Get rid of byte-compiling-files-p hackery; @@ -14432,7 +14432,7 @@ * textmodes/sgml-mode.el (xml-mode): New alias for `sgml-mode'. - * emacs-lisp/bytecomp.el (byte-compile-last-line): Deleted. + * emacs-lisp/bytecomp.el (byte-compile-last-line): Delete. (byte-compile-delete-first): New function. (byte-compile-read-position): New variable. (byte-compile-last-position): New variable. @@ -14460,7 +14460,7 @@ 2002-05-27 Kim F. Storm <storm@cua.dk> - * simple.el (push-mark-command): Added optional NOMSG arg. + * simple.el (push-mark-command): Add optional NOMSG arg. * emulation/cua-base.el (cua-set-mark): Align pop to mark behavior with standard set-mark-command. @@ -14506,7 +14506,7 @@ * rot13.el (rot13-translate-table): New variable. (rot13, rot13-string, rot13-region): New functions. -2002-05-25 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-05-25 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-add-stmt-syntax): Fix some cases of wrong anchoring, e.g. for else-if compounds. @@ -14575,7 +14575,7 @@ (apropos-command, apropos, apropos-value, apropos-documentation): Allow keywords in addition to regexp. Added scoring. (apropos-documentation-check-doc-file) - (apropos-documentation-check-elc-file): Added scoring. + (apropos-documentation-check-elc-file): Add scoring. (apropos-print): Sort according to score. 2002-05-22 Colin Walters <walters@cis.ohio-state.edu> @@ -14660,8 +14660,8 @@ (ibuffer-compile-format): If the current column is a `name' column, figure out the appropriate category to put on it. (filename-and-process): Use category property. - (ibuffer-fontify-region-function): Deleted. - (ibuffer-unfontify-region-function): Deleted. + (ibuffer-fontify-region-function): Delete. + (ibuffer-unfontify-region-function): Delete. (ibuffer-update-title-and-summary): Use category properties. (ibuffer-insert-filter-group): Ditto. (ibuffer-mode): Set up category properties. @@ -14677,7 +14677,7 @@ * ibuffer.el (toplevel): Require font-lock, to get the face definitions. - (ibuffer-use-fontification): Deleted. + (ibuffer-use-fontification): Delete. (column filename-and-process): New column. (ibuffer-formats): Use it by default. (ibuffer-name-map, ibuffer-mode-name-map) @@ -15096,8 +15096,8 @@ * emacs-lisp/find-func.el (find-function-search-for-symbol): Add autoload cookie. - (find-function-regexp): Include - "\(quote " to match the defaliases in loaddefs.el. + (find-function-regexp): + Include "\(quote " to match the defaliases in loaddefs.el. * filesets.el (filesets-conditional-sort): Use copy-sequence, not copy-list. @@ -15287,7 +15287,7 @@ 2002-05-03 John Wiegley <johnw@gnu.org> - * eshell/esh-var.el (eshell-modify-global-environment): Added this + * eshell/esh-var.el (eshell-modify-global-environment): Add this customization variable, which will cause any "export" commands within any eshell buffer to modify the global Emacs environment. It defaults to nil, which means that such commands will only @@ -15375,7 +15375,7 @@ * align.el (align-region): Fix the fix to align-region, because the "name" argument was appearing twice. -2002-05-01 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-05-01 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-beginning-of-decl-1): Better way to handle protection labels, one which doesn't get confused by @@ -15465,7 +15465,7 @@ * subr.el (remove-yank-excluded-properties): New helper function. (insert-for-yank, insert-buffer-substring-as-yank): Use it. - * simple.el (yank-excluded-properties): Added help-echo to list. + * simple.el (yank-excluded-properties): Add help-echo to list. 2002-04-29 Glenn Morris <gmorris@ast.cam.ac.uk> @@ -15556,7 +15556,7 @@ not a list. * replace.el (occur-revert-arguments): - Renamed from occur-revert-properties. All uses changed. + Rename from occur-revert-properties. All uses changed. 2002-04-28 Pavel Janík <Pavel@Janik.cz> @@ -15838,7 +15838,7 @@ (buffers-menu-show-status): New variables. (menu-bar-update-buffers-1): Use them. -2002-04-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-24 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-mask-comment): More fixes when used from `c-do-auto-fill' and point is at or near the limit of the @@ -15863,19 +15863,19 @@ (occur-mode-display-occurrence): Handle buffer property. (list-matching-lines-face): Use defcustom. (list-matching-lines-buffer-name-face): New variable. - (occur-accumulate-lines): Renamed from `ibuffer-accumulate-lines', + (occur-accumulate-lines): Rename from `ibuffer-accumulate-lines', in ibuffer.el. (occur-read-primary-args): Move out of `occur'. (occur): Delete. Now simply call `occur-1'. (multi-occur, multi-occur-by-filename-regexp): New functions. (occur-1): New function. - (occur-engine): Renamed from `ibuffer-occur-engine' to replace the + (occur-engine): Rename from `ibuffer-occur-engine' to replace the previous implementation of `occur'; taken from ibuf-ext.el. (occur-fontify-on-property): New function. (occur-fontify-region-function, occur-unfontify-region-function): New functions. - * ibuffer.el (ibuffer-accumulate-lines): Moved to replace.el. + * ibuffer.el (ibuffer-accumulate-lines): Move to replace.el. * ibuf-ext.el (ibuffer-depropertize-string): Delete. (ibuffer-occur-match-face): Delete. @@ -15883,7 +15883,7 @@ (ibuffer-occur-mouse-display-occurence): Delete. (ibuffer-occur-goto-occurence, ibuffer-occur-display-occurence) (ibuffer-do-occur-1, ibuffer-occur-revert-buffer-function): Delete. - (ibuffer-occur-engine): Moved to replace.el. + (ibuffer-occur-engine): Move to replace.el. (ibuffer-do-occur): Simply call `occur-1'. * play/gamegrid.el (gamegrid-add-score-with-update-game-score): @@ -15921,9 +15921,9 @@ * dired.el (dired-mouse-find-file-other-window): Handle events that move out of the window. -2002-04-23 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-23 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-cmds.el (c-mask-comment): Fixed bug where point + * progmodes/cc-cmds.el (c-mask-comment): Fix bug where point was moved to the following line when it was at the first line of a block comment where comment-start-skip matched to eol. @@ -15948,13 +15948,13 @@ * diary-lib.el (include-other-diary-files): Allow modifying included buffer, to turn off selective display. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-mode.el (c-define-abbrev-table): New function to pass the SYSTEM-FLAG to `define-abbrev' in a way that works in emacsen that doesn't support it. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-align.el, progmodes/cc-engine.el, * progmodes/cc-styles.el, progmodes/cc-vars.el @@ -15976,27 +15976,27 @@ (c-opt-asm-stmt-key): New language variable to recognize the beginning of asm statements. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-guess-basic-syntax): Detect variable declarations after class and struct declarations correctly. Fixed limit error when finding the anchor for template-args-cont and topmost-intro-cont. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-beginning-of-defun) (c-declaration-limits): Find the "line oriented" declaration start too, just like the "line oriented" end is found. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-vars.el (c-offsets-alist): A more sane default for `inexpr-statement'. This is not compatible, though. I think the benefit of a good default style outweights that in this case. Besides, `inexpr-statement' is not very common. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-electric-delete-forward): Fix silly bug that caused it to delete backwards in hungry delete @@ -16013,7 +16013,7 @@ list initializers correctly (but costly; it ought to be integrated into `c-beginning-of-statement-1'). -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el, progmodes/cc-engine.el (c-beginning-of-defun, c-end-of-defun, c-mark-function): @@ -16028,7 +16028,7 @@ handles declarations that continue after the block. * progmodes/cc-engine.el (c-syntactic-re-search-forward): - Added an option to restrict matching to the top level of the + Add an option to restrict matching to the top level of the current paren sexp. * progmodes/cc-langs.el (c-opt-block-decls-with-vars-key): @@ -16036,9 +16036,9 @@ (c-syntactic-eol): New regexp to match a "syntactic" eol. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-engine.el (c-guess-basic-syntax): Fixed a bug + * progmodes/cc-engine.el (c-guess-basic-syntax): Fix a bug that often caused the backward limit to be lost at the top level. This improves performance a bit. @@ -16052,12 +16052,12 @@ (c-beginning-of-decl-1): New function that put point at the beginning of the declaration. It handles K&R argdecl blocks. - (c-guess-basic-syntax): Replaced the `knr-argdecl' recognition + (c-guess-basic-syntax): Replace the `knr-argdecl' recognition code with one that doesn't depend on the current indentation. The anchor position for `knr-argdecl' has also changed, but in a way that is unlikely to cause compatibility problems. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-defs.el, progmodes/cc-engine.el (c-forward-comment): `forward-comment' in XEmacs skips over @@ -16069,19 +16069,19 @@ setup of the language specific variables. The regexp-opt mangling is also done at compile time now. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-indent-line-or-region): Call `c-indent-line' directly instead of through `indent-according-to-mode' so that this function always indents syntactically. - * progmodes/cc-engine.el (c-guess-basic-syntax): Fixed a bug + * progmodes/cc-engine.el (c-guess-basic-syntax): Fix a bug where a class beginning with a nested class could cause an infinite loop (the state outside the narrowed out class is never used now). -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-align.el, progmodes/cc-cmds.el, progmodes/cc-engine.el, progmodes/cc-vars.el: Fixes so that @@ -16102,7 +16102,7 @@ * progmodes/cc-align.el: Use the vector form in the return value in all cases where lineup functions return absolute columns. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-add-stmt-syntax) (c-guess-basic-syntax): Anchor `brace-list-intro' and @@ -16122,7 +16122,7 @@ (c-major-mode-is): Compare against the buffer local variable `c-buffer-is-cc-mode', which is faster than using `derived-mode-class'. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-forward-syntactic-ws) (c-backward-syntactic-ws, c-forward-token-1) @@ -16133,19 +16133,19 @@ That's signified by making their documentation into docstrings. (c-whack-state, c-hack-state, c-skip-case-statement-forward): - Removed these internal functions since they aren't used. + Remove these internal functions since they aren't used. (c-forward-to-cpp-expression): Classified this function as internal. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-langs.el (c-ObjC-class-key, c-Java-class-key): - Simplified these regexps; the class keywords they contain + Simplify these regexps; the class keywords they contain ought to be enough to avoid false matches, so checking for following identifiers etc is just unnecessary (and might also fail for oddly formatted code). -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el, progmodes/cc-cmds.el (c-forward-comment-lc): New function that behaves like @@ -16160,7 +16160,7 @@ normal label in a switch block as a case label, to get consistent lineup with the case labels. - * progmodes/cc-engine.el (c-backward-syntactic-ws): Fixed bug + * progmodes/cc-engine.el (c-backward-syntactic-ws): Fix bug in skipping over a macro that ends with an empty line. * progmodes/cc-styles.el: Require cc-align since styles added @@ -16168,7 +16168,7 @@ defined there, and so the `c-valid-offset' check might otherwise complain on them. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-align.el, progmodes/cc-mode.el: * progmodes/cc-vars.el: Added two new lineup functions: @@ -16195,7 +16195,7 @@ * progmodes/cc-langs.el (c-symbol-key): Made this variable mode specific, to handle Pike special symbols like `== better. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el, progmodes/cc-engine.el, progmodes/cc-vars.el (c-report-syntactic-errors): A new @@ -16203,13 +16203,13 @@ to off; since CC Mode ignores most syntactic errors it might as well ignore them all for the sake of consistency. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-looking-at-inexpr-block): Optimization. Can give a noticeable speedup if there's a large preceding function or class body. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-align.el, progmodes/cc-cmds.el: Use more efficient and correct insertion functions in many places. @@ -16221,21 +16221,21 @@ * progmodes/cc-styles.el (c-read-offset): Unbind SPC in the completion to make it easier to enter lists. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-cmds.el (c-beginning-of-defun): Fixed bug where + * progmodes/cc-cmds.el (c-beginning-of-defun): Fix bug where c-state-cache was clobbered. * progmodes/cc-cmds.el, progmodes/cc-engine.el - (c-calculate-state): Moved from cc-cmds.el to cc-engine.el due + (c-calculate-state): Move from cc-cmds.el to cc-engine.el due to dependency. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-parse-state): Ignore unbalanced open parens in macros (if point isn't in the same one). -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-context-open-line): New function that is the `open-line' equivalent to `c-context-line-break'. @@ -16244,7 +16244,7 @@ for Emacs 21 since `indent-new-comment-line' has been changed to `comment-indent-new-line' there. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el, progmodes/cc-langs.el (c-stmt-delim-chars, c-stmt-delim-chars-with-comma): @@ -16257,7 +16257,7 @@ the set of statement delimiting characters, to allow it to be changed dynamically and per-mode. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-looking-at-bos) (c-looking-at-inexpr-block, c-add-stmt-syntax) @@ -16270,21 +16270,21 @@ Made arglist-cont anchor correctly in arglists that contain statements. * progmodes/cc-engine.el (c-guess-basic-syntax): - Fixed consistent anchoring of defun-block-intro in defuns in code + Fix consistent anchoring of defun-block-intro in defuns in code blocks (can only occur in Pike). * progmodes/cc-engine.el (c-looking-at-inexpr-block) - (c-looking-at-inexpr-block-backward): Changed the arguments to + (c-looking-at-inexpr-block-backward): Change the arguments to require containing sexps and paren state, for better efficiency. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el, progmodes/cc-engine.el, progmodes/cc-vars.el: Improved anchoring of statement and handling of labels in front of substatements. (c-guess-continued-construct, c-guess-basic-syntax): - Improved and unified anchoring at statements. Statements beginning + Improve and unified anchoring at statements. Statements beginning with comments or labels are now avoided, by going out of blocks and containing statements if necessary. This nesting handling also fixes the case when there's a statement after a @@ -16293,7 +16293,7 @@ (c-electric-colon): Map the new `substatement-label' to `label' when consulting `c-hanging-colons-alist'. - (c-offsets-alist): Added substatement-label. Updated the + (c-offsets-alist): Add substatement-label. Updated the comments for the new anchoring positions at statements. * progmodes/cc-engine.el (c-guess-basic-syntax): Use more sane @@ -16302,7 +16302,7 @@ neutralized by a kludge in `c-get-syntactic-indentation' which ignored such anchor points. - (c-get-syntactic-indentation): Removed the kludge that was + (c-get-syntactic-indentation): Remove the kludge that was necessary due to buggy anchor points. * progmodes/cc-engine.el (c-guess-basic-syntax): Do not check @@ -16312,7 +16312,7 @@ recognized as normal arglist-cont if we're directly in a macro arglist, for consistency with other "bare" statements. - * progmodes/cc-engine.el (c-looking-at-bos): Added optional + * progmodes/cc-engine.el (c-looking-at-bos): Add optional limit arg for backward searches. * progmodes/cc-engine.el (c-looking-at-inexpr-block): @@ -16325,7 +16325,7 @@ in the list of syntactic symbols. Only the first is used as the base for the offset calculation. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-indent-defun): Indent the current macro if inside one at the top level. Do not throw an error @@ -16340,7 +16340,7 @@ * progmodes/cc-engine.el (c-least-enclosing-brace): Rewritten to not be destructive. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-context-line-break): Only do a macro line break when point is inside the content of it; if it's in @@ -16349,21 +16349,21 @@ * progmodes/cc-engine.el (c-guess-basic-syntax): Do not add cpp-macro-cont inside the argument list to a #define. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-defs.el (c-forward-comment): Implemented a kludge to avoid the problem most forward-comment incarnations have with `\' together with comment parsing. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-engine.el (c-check-state-cache): Fixed bug + * progmodes/cc-engine.el (c-check-state-cache): Fix bug which could cause the state returned by `c-parse-state' to lack a closed paren element. That in turn could result in very long searches, since it's common that they start from the last preceding close brace. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-beginning-of-statement-1): Do not treat else-if as a single continuation, since that'd make it @@ -16373,7 +16373,7 @@ the starting if, but that doesn't affect the indentation for any reasonably sane style. Also introduced a noerror flag. - (c-beginning-of-closest-statement): Removed; + (c-beginning-of-closest-statement): Remove; c-beginning-of-statement-1 now avoids the problem this one solved. * progmodes/cc-engine.el (c-guess-continued-construct) @@ -16384,7 +16384,7 @@ before the start of the statement. * progmodes/cc-engine.el (c-looking-at-inexpr-block): - Added flag to disable looking at the type of the surrounding paren + Add flag to disable looking at the type of the surrounding paren since that confuses c-beginning-of-statement-1 and a couple of other places. @@ -16392,7 +16392,7 @@ Avoid stepping to the previous statement in case 18. Improvements in recognition of statement blocks on the top level. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-beginning-of-statement-1) (c-crosses-statement-barrier-p): Rewritten to get a well @@ -16400,7 +16400,7 @@ in recognition of do-while constructs. (c-backward-to-start-of-do, c-backward-to-start-of-if): - Removed; use c-beginning-of-statement-1 instead. + Remove; use c-beginning-of-statement-1 instead. (c-guess-continued-construct, c-guess-basic-syntax): Various fixes to not depend on the bugs previously in @@ -16408,20 +16408,20 @@ use the new behavior of c-beginning-of-statement-1 better. Fixed recognition of catch blocks inside macros. - * progmodes/cc-engine.el (c-backward-syntactic-ws): Fixed bug + * progmodes/cc-engine.el (c-backward-syntactic-ws): Fix bug in skipping over a macro. * progmodes/cc-langs.el (c-label-kwds): New variable to contain the appropriate c-*-label-kwds value. - * progmodes/cc-vars.el (defcustom-c-stylevar): Fixed value + * progmodes/cc-vars.el (defcustom-c-stylevar): Fix value evaluation bug that caused the widget for c-block-comment-prefix to bug out. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-guess-basic-syntax): - Improved recognition of statements: They are now recognized in + Improve recognition of statements: They are now recognized in contexts where they normally can't occur, e.g. on the top level or in function call arguments. This is mainly useful to recognize statements in macros at the top level, and in arguments to @@ -16444,7 +16444,7 @@ analysis in ObjC mode. * progmodes/cc-engine.el (c-beginning-of-statement-1): - Fixed bug in do-while statements where the body is not a block. + Fix bug in do-while statements where the body is not a block. * progmodes/cc-styles.el (c-set-style): Reset c-special-indent-hook to its global value if in override mode. @@ -16454,7 +16454,7 @@ * progmodes/cc-engine.el (c-evaluate-offset, c-get-offset): Use c-benign-error to report the c-strict-syntax-p error. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-align.el, progmodes/cc-defs.el: * progmodes/cc-cmds.el, progmodes/cc-engine.el, progmodes/cc-vars.el: @@ -16469,7 +16469,7 @@ default. An extra flag argument is required to do that. (c-macro-start, c-query-macro-start) - (c-query-and-set-macro-start): Added a cache for the macro + (c-query-and-set-macro-start): Add a cache for the macro start position. (c-forward-syntactic-ws, c-backward-syntactic-ws): Fixes for @@ -16477,7 +16477,7 @@ in forward-comment in some emacsen when it hits a buffer limit with a large repeat count. - (c-lineup-macro-cont): Improved behavior when + (c-lineup-macro-cont): Improve behavior when c-syntactic-indentation-in-macros is nil. (c-syntactic-indentation-in-macros, c-backslash-max-column) @@ -16495,15 +16495,15 @@ (c-benign-error): New macro to report errors that doesn't need to interrupt the operation. - * progmodes/cc-defs.el (c-point): Added eonl and eopl positions. + * progmodes/cc-defs.el (c-point): Add eonl and eopl positions. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-electric-brace, c-indent-region): - Removed most of the c-state-cache fiddling, since the global + Remove most of the c-state-cache fiddling, since the global state cache now handles this. - * progmodes/cc-engine.el (c-guess-basic-syntax): Fixed bug + * progmodes/cc-engine.el (c-guess-basic-syntax): Fix bug when there's an open paren at the very first char of the visible buffer region. @@ -16515,7 +16515,7 @@ * progmodes/cc-engine.el (c-whack-state-after): Slight optimization. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el, progmodes/cc-langs.el, progmodes/cc-align.el: Improvements to syntactic analysis @@ -16524,7 +16524,7 @@ (c-block-stmt-1-kwds, c-block-stmt-2-kwds): New variables used by `c-guess-basic-syntax'. - (c-parse-state): Fixed bug with braces inside macros when + (c-parse-state): Fix bug with braces inside macros when using cached state info. (c-forward-to-cpp-expression): New function to aid in @@ -16542,7 +16542,7 @@ (c-offsets-alist): Made `c-lineup-macro-cont' the default for cpp-macro-cont. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-beginning-of-statement-1) (c-forward-syntactic-ws): Fixes to handle continued lines. @@ -16550,7 +16550,7 @@ (c-backward-to-start-of-if, c-guess-basic-syntax): Do syntactic analysis inside macros. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-indent-region): Did a speedup made possible by the more flexible state cache. @@ -16558,22 +16558,22 @@ * progmodes/cc-engine.el (c-parse-state, c-whack-state-before) (c-whack-state-after, c-hack-state) (c-narrow-out-enclosing-class, c-guess-basic-syntax): - Improved the state cache system. It now can use partial info from + Improve the state cache system. It now can use partial info from an old cached state to calculate a new one at a different position. Removed some kludges to avoid the state cache. The new functions `c-whack-state-before' and `c-whack-state-after' replace the now obsolete `c-whack-state'. * progmodes/cc-engine.el (c-beginning-of-statement-1): - Optimized backing through a macro. This can speed things up + Optimize backing through a macro. This can speed things up quite a bit when there are long macros before point. (c-beginning-of-macro): Do not ignore the limit. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-electric-continued-statement): - Fixed a bug where the keyword wasn't reindented correctly if + Fix a bug where the keyword wasn't reindented correctly if followed by another keyword or identifier. * progmodes/cc-engine.el (c-parse-state): Ignore closed brace @@ -16581,7 +16581,7 @@ second of two "do { } while (0)" macros after each other indented differently. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-beginning-of-macro) (c-forward-syntactic-ws): Recognize "#!" as a preprocessor @@ -16589,13 +16589,13 @@ interpreter lines like "#!/usr/bin/pike" at the beginning of the file. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-looking-at-inexpr-block): Recognize brace blocks inside a parenthesis expression as inexpr-statement. Useful when writing statements as macro arguments. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-fill-paragraph, c-do-auto-fill) (c-mask-comment): Broke out the comment masking code from @@ -16603,14 +16603,14 @@ able to do the same thing in `c-do-auto-fill'. This should make auto-fill-mode behave better. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-electric-brace, c-electric-paren): Check `executing-macro' to avoid blinking parens when macros are executed. * progmodes/cc-mode.el, progmodes/cc-styles.el - (c-setup-filladapt): Moved from cc-mode.el to cc-styles.el for + (c-setup-filladapt): Move from cc-mode.el to cc-styles.el for consistency with `c-setup-paragraph-variables' (which was placed there due to the dependency from `c-set-style'). @@ -16619,14 +16619,14 @@ there already is a style called "user" defined when CC Mode starts up for the first time. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el, progmodes/cc-vars.el - (c-comment-indent, c-indent-comment-alist): Added new variable + (c-comment-indent, c-indent-comment-alist): Add new variable `c-indent-comment-alist' to allow better control over `c-comment-indent'. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-align.el (c-lineup-C-comments): Try to match both `comment-start-skip' and the comment prefix on the @@ -16636,29 +16636,29 @@ `comment-start-skip' match whatever `c-comment-prefix-regexp' matches. * progmodes/cc-mode.el, progmodes/cc-styles.el (c-common-init) - (c-set-style-1, c-setup-paragraph-variables): Moved the + (c-set-style-1, c-setup-paragraph-variables): Move the variable initialization based on `c-comment-prefix-regexp' to a new function `c-setup-paragraph-variables', which is now used both at mode init and when a style that sets `c-comment-prefix-regexp' is activated. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-beginning-of-member-init-list): Better handling of C++ template args to avoid confusion with `<' and `>' used as operators in member init expressions. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-most-enclosing-brace) - (c-least-enclosing-brace): Added optional second arg to limit + (c-least-enclosing-brace): Add optional second arg to limit the search to before a certain point. - * progmodes/cc-engine.el (c-guess-basic-syntax): Fixed bug which + * progmodes/cc-engine.el (c-guess-basic-syntax): Fix bug which could cause incorrect analysis if a cached state is used (usually only happens when an electric key reindents a line). -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-defs.el (c-forward-comment): More idiosyncrasy insulation. This time for XEmacs 21. @@ -16676,25 +16676,25 @@ the indentation of the current line. Switched places on cases 5D.3 and 5D.4 and made them use more syntactically correct methods. - (c-inher-key): Removed since the code in + (c-inher-key): Remove since the code in `c-guess-basic-syntax' now uses token-based search. * progmodes/cc-cmds.el, progmodes/cc-mode.el (c-mode-menu): - Added a submenu to access some toggles. + Add a submenu to access some toggles. (c-toggle-syntactic-indentation): New function to toggle the variable `c-syntactic-indentation'. - * progmodes/cc-styles.el (c-set-style): Improved the error + * progmodes/cc-styles.el (c-set-style): Improve the error message for incorrect offsets a bit. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-indent-exp): Don't require that the sexp follows point immediately, instead find the closest following open paren that ends on another line. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-align.el (c-lineup-cascaded-calls): New indentation function. @@ -16702,26 +16702,26 @@ * progmodes/cc-engine.el (c-beginning-of-macro): Bugfix for directives with whitespace between the '#' and the name. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-forward-syntactic-ws) (c-backward-syntactic-ws): Handle line continuations as whitespace. Don't move past a macro if that'd take us past the limit. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-beginning-of-macro) (c-forward-syntactic-ws): Multiline strings begin with `#"' in Pike, and that shouldn't be confused with a preprocessor directive. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el: Extended the kludge to interoperate with the delsel and pending-del packages wrt to the new function `c-electric-delete-forward'. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-indent-exp): Keep the indentation of the block itself, i.e. only indent the contents in it. @@ -16730,38 +16730,38 @@ argument to completing-read instead of initial-contents, if the function is recent enough to support it. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-mode.el (c-mode-help-address): - Removed bug-gnu-emacs@gnu.org from the receiver list for bug reports. + Remove bug-gnu-emacs@gnu.org from the receiver list for bug reports. I've almost never seen a bug reported this way that should go to that list, but it's rather common that the reports concern the combination CC Mode and XEmacs instead. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-cmds.el (c-electric-paren): Fixed bug when both + * progmodes/cc-cmds.el (c-electric-paren): Fix bug when both brace-elseif-brace and brace-catch-brace are active and there's a "else if"-block before the catch block. * progmodes/cc-menus.el (cc-imenu-c++-generic-expression): Detect function headers that span lines. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-electric-brace) (c-electric-semi&comma, c-electric-colon, c-electric-paren): Check for last on line only for doing the auto-newline-mode stuff, not for the reindentation. - * progmodes/cc-cmds.el (c-electric-brace): Fixed bugs in the + * progmodes/cc-cmds.el (c-electric-brace): Fix bugs in the handling of c-syntactic-indentation: When it's nil, indent the new lines but don't reindent the current one. Reindent the line only when the inserted brace comes first on it, instead of last. * progmodes/cc-cmds.el (c-electric-brace) - (c-electric-semi&comma): Fixed two places where + (c-electric-semi&comma): Fix two places where c-syntactic-indentation wasn't heeded. * progmodes/cc-cmds.el (c-electric-pound): Don't be electric @@ -16772,7 +16772,7 @@ is found. Fixed case where an else following a do-while statement could be associated with an if inside the do-while. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-guess-fill-prefix): Tuned the dwim for the fallback to add a single space after the comment prefix. @@ -16781,15 +16781,15 @@ behavior in some special cases, especially for single-line comments. Avoid breaking up a comment starter or ender. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-outline-level): Applied patch from the Emacs sources to make this work in invisible text. - * progmodes/cc-langs.el (c-switch-label-key): Fixed regexp to + * progmodes/cc-langs.el (c-switch-label-key): Fix regexp to not be confused by a later ':' on the same line as the label. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el, progmodes/cc-mode.el (c-electric-delete, c-electric-delete-forward): @@ -16800,20 +16800,20 @@ `c-electric-delete-forward' is now bound to C-d to get the electric behavior on that key too. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-cmds.el (c-fill-paragraph): Fixed bogus direct + * progmodes/cc-cmds.el (c-fill-paragraph): Fix bogus direct use of c-comment-prefix-regexp, which caused an error when it's a list. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-mode.el, progmodes/cc-vars.el (c-common-init) - (c-default-style): Removed the hardcoded switch to "java" style + (c-default-style): Remove the hardcoded switch to "java" style in Java mode. It's instead taken care of by the default value for c-default-style. -2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org> +2002-04-22 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-align.el (c-lineup-math): Fix bug where lineup was triggered by equal signs in string literals. @@ -16864,9 +16864,9 @@ 2002-04-19 Miles Bader <miles@gnu.org> * custom.el (customize-mark-to-save, customize-mark-as-set) - (custom-quote): Moved here from `cus-edit.el'. + (custom-quote): Move here from `cus-edit.el'. * cus-edit.el (customize-mark-to-save, customize-mark-as-set) - (custom-quote): Moved to `custom.el'. + (custom-quote): Move to `custom.el'. 2002-04-18 Richard M. Stallman <rms@gnu.org> @@ -16958,7 +16958,7 @@ (ediff-clone-buffer-for-region-comparison): More robust window arrangement while prompting for regions to compare. (ediff-make-cloned-buffer): Use generate-new-buffer-name. - (ediff-inferior-compare-regions): Deleted unused vars + (ediff-inferior-compare-regions): Delete unused vars ctl-buf and quit-now. 2002-04-15 Richard M. Stallman <rms@gnu.org> @@ -17039,7 +17039,7 @@ call `math-group-float'. * play/gamegrid.el (gamegrid-add-score-with-update-game-score): - Renamed from `gamegrid-add-score'. + Rename from `gamegrid-add-score'. (gamegrid-add-score-insecure): Restored from the old `gamegrid-add-score'. (gamegrid-add-score): Just dispatch on `system-type' to one of the @@ -17453,7 +17453,7 @@ (sgml-insert-end-tag): New funs taken from xml-lite.el. (sgml-calculate-indent): Use them. (sgml-slash-matching): Rename from sgml-slash. - (sgml-slash): Copied from xml-lite and changed to use + (sgml-slash): Copy from xml-lite and changed to use sgml-slash-matching and sgml-quick-keys. * international/mule-cmds.el (standard-keyboard-coding-systems): @@ -17502,10 +17502,10 @@ * info.el (info-tool-bar-map): Use tool-bar-local-item-from-menu. - * toolbar/tool-bar.el (tool-bar-local-item): Renamed from + * toolbar/tool-bar.el (tool-bar-local-item): Rename from tool-bar-add-item, and new arg MAP. (tool-bar-add-item): Now calls tool-bar-local-item. - (tool-bar-local-item-from-menu): Renamed from + (tool-bar-local-item-from-menu): Rename from tool-bar-add-item-from-menu, and new arg IN-MAP. (tool-bar-add-item-from-menu): Now calls tool-bar-local-item-from-menu. @@ -17542,9 +17542,9 @@ 2002-03-29 Richard M. Stallman <rms@gnu.org> - * subr.el (play-sound-file): Moved to simple.el. + * subr.el (play-sound-file): Move to simple.el. - * simple.el (play-sound-file): Moved from subr.el, made unconditional. + * simple.el (play-sound-file): Move from subr.el, made unconditional. 2002-03-29 Colin Walters <walters@verbum.org> @@ -17626,7 +17626,7 @@ 2002-03-28 Richard M. Stallman <rms@gnu.org> - * dired.el (dired-toggle-marks): Renamed from dired-do-toggle. + * dired.el (dired-toggle-marks): Rename from dired-do-toggle. Bindings changed. * progmodes/compile.el (compilation-handle-exit): @@ -17714,7 +17714,7 @@ * gud.el (gud-jdb-sourcepath): New variable, saves jdb -sourcepath parameter value. (gud-jdb-build-source-files-list): Comment clarification. - (gud-jdb-massage-args): Reworked into loop-based argument list + (gud-jdb-massage-args): Rework into loop-based argument list processing in order to support -classpath and -sourcepath argument processing. (gud-jdb-find-source-using-classpath): Prepend gud-jdb-sourcepath @@ -17894,11 +17894,11 @@ * ediff-util.el (ediff-toggle-hilit): Fix toggling of highlighting. (ediff-select-difference): Take highlighting style into account. (ediff-clone-buffer-for-region-comparison): New function. - (ediff-inferior-compare-regions): Added comparison of current diff + (ediff-inferior-compare-regions): Add comparison of current diff regions. * ediff.el (ediff-clone-buffer-for-region-comparison) - (ediff-clone-buffer-for-window-comparison): Moved to ediff-util.el. + (ediff-clone-buffer-for-window-comparison): Move to ediff-util.el. 2002-03-19 Paul Reilly <pmr-sav@hamm.pajato.com> @@ -17977,7 +17977,7 @@ 2002-03-17 Stefan Monnier <monnier@cs.yale.edu> - * textmodes/sgml-mode.el (sgml-xml-mode): Renamed from sgml-xml. + * textmodes/sgml-mode.el (sgml-xml-mode): Rename from sgml-xml. (sgml-xml-guess): Simplify. (sgml-mode-common): Remove (move into sgml-mode). (sgml-mode): Add code from sgml-mode-common. @@ -18020,7 +18020,7 @@ 2002-03-16 Simon Marshall <simon.marshall@misys.com> - * imenu.el (imenu-menubar-modified-tick): Renamed from + * imenu.el (imenu-menubar-modified-tick): Rename from imenu-update-menubar-modified-tick. (imenu-update-menubar): Update imenu-menubar-modified-tick whenever outer condition succeeds. @@ -18098,7 +18098,7 @@ (dired-internal-do-deletions): Use dired-fun-in-all-buffers and dired-delete-entry, to update this buffer (and others). - * dired-aux.el (dired-fun-in-all-buffers): Moved to dired.el. + * dired-aux.el (dired-fun-in-all-buffers): Move to dired.el. * facemenu.el (facemenu-add-new-face): Pass region args to facemenu-set-face, when there is a region. @@ -18167,7 +18167,7 @@ (lisp-loop-forms-indentation, lisp-simple-loop-indentation): New user options. (extended-loop-p, common-lisp-loop-part-indentation): New functions. - (common-lisp-indent-function-1): Renamed from + (common-lisp-indent-function-1): Rename from common-lisp-indent-function. (common-lisp-indent-function): Handle loop forms specially. (lisp-indent-defmethod): Use car/cdr instead of first/rest. @@ -18278,7 +18278,7 @@ (ibuffer-insert-buffer-line): Ditto. (ibuffer-map-lines): Ditto. (ibuffer-insert-buffers-and-marks): Ditto. - (ibuffer-update-title-and-summary): Renamed from + (ibuffer-update-title-and-summary): Rename from `ibuffer-update-title'. Handle "summarizer" columns. (ibuffer-clear-summary-columns): New function. @@ -18321,7 +18321,7 @@ (hif-tokenize): Handle `?' and ':' as tokens. (hif-expr): Parse conditional expressions. (hif-or-expr): Parse `||' expressions. - (hif-and-expr): Renamed from hif-term. + (hif-and-expr): Rename from hif-term. (hif-conditional): New function to evaluate a conditional expression. @@ -18441,14 +18441,14 @@ * cus-start.el: Rename automatic-hscroll-step and automatic-hscroll-margin into hscroll-step and hscroll-margin. - * frame.el (auto-hscroll-mode): Renamed from automatic-hscrolling. + * frame.el (auto-hscroll-mode): Rename from automatic-hscrolling. (automatic-hscrolling): Now a defvaralias for auto-hscroll-mode. * mouse.el (mouse-region-delete-keys): Add deletechar. 2002-03-03 Sam Steingold <sds@gnu.org> - * play/snake.el (snake-score-file): Fixed parens (broken by the + * play/snake.el (snake-score-file): Fix parens (broken by the last patch). * play/tetris.el (tetris-score-file): Ditto. @@ -18574,14 +18574,14 @@ `winner-boring-buffers', will no longer be restored by `winner-undo'. (winner-sorted-window-list): Used to improve comparison between window configurations. - (winner-win-data): Simplified and moved. - (winner-conf): Simplified (now uses `winner-win-data'). + (winner-win-data): Simplify and moved. + (winner-conf): Simplify (now uses `winner-win-data'). (winner-change-fun, winner-save-old-configurations) (winner-save-(un)conditionally, winner-redo): Changes made while in the minibuffer will be ignored. (Such changes are undone upon exit for the minibuffer, anyway.) (winner-set-conf): Preserve selected window whenever possible. - (winner-make-point-alist): Simplified. + (winner-make-point-alist): Simplify. (winner-mode, winner-save-unconditionally): Save current window configuration on entering minibuffer. (minor-mode-alist): Don't add winner-mode to `minor-mode-alist', @@ -18589,11 +18589,11 @@ 2002-02-26 Eli Zaretskii <eliz@is.elta.co.il> - * international/mule-conf.el (compound-text): Renamed back from + * international/mule-conf.el (compound-text): Rename back from compound-text-no-extensions. (ctext-no-compositions): Remove the mime-charset property. - (compound-text-with-extensions): Renamed from compound-text. - (x-ctext-with-extensions, ctext-with-extensions): Renamed aliases. + (compound-text-with-extensions): Rename from compound-text. + (x-ctext-with-extensions, ctext-with-extensions): Rename aliases. 2002-02-26 Juanma Barranquero <lektu@terra.es> @@ -18636,7 +18636,7 @@ 2002-02-25 Per Abrahamsen <abraham@dina.kvl.dk> - * ps-print.el (ps-print-printer): Added `lpr' customize group member. + * ps-print.el (ps-print-printer): Add `lpr' customize group member. 2002-02-25 Juanma Barranquero <lektu@terra.es> @@ -18715,7 +18715,7 @@ (snake-update-game, snake-move-left) (snake-move-right, snake-move-up, snake-move-down, snake-active-p) (snake-start-game): Use that queue. - (snake-use-glyphs-flag): Renamed from snake-use-glyphs. + (snake-use-glyphs-flag): Rename from snake-use-glyphs. (snake-use-color-flag): Likewise. (snake-mode): Rename uses of those variables. @@ -18725,7 +18725,7 @@ * international/mule-conf.el (ctext-no-compositions): New coding system. - (compound-text-no-extensions): Renamed from compound-text. + (compound-text-no-extensions): Rename from compound-text. (x-ctext-no-extensions, ctext-no-extensions): Aliases for compound-text-no-extensions. (compound-text): Redefined using post-read and pre-write conversions. @@ -18813,7 +18813,7 @@ 2002-02-19 Per Abrahamsen <abraham@dina.kvl.dk> - * facemenu.el (describe-text-mode-map): Removed bootstrap kludge. + * facemenu.el (describe-text-mode-map): Remove bootstrap kludge. * toolbar/tool-bar.el (tool-bar-mode): Made the standard value t. * menu-bar.el (menu-bar-mode): Ditto. @@ -18860,10 +18860,10 @@ 2002-02-17 Per Abrahamsen <abraham@dina.kvl.dk> - * menu-bar.el (menu-bar-showhide-menu): Added speedbar. - (menu-bar-tools-menu): Removed speedbar. + * menu-bar.el (menu-bar-showhide-menu): Add speedbar. + (menu-bar-tools-menu): Remove speedbar. - * textmodes/ispell.el (ispell-menu-map): Added `customize-ispell' + * textmodes/ispell.el (ispell-menu-map): Add `customize-ispell' and `flyspell-mode' entries. * textmodes/flyspell.el (flyspell): Add to ispell group. @@ -18962,13 +18962,13 @@ 2002-02-16 John Wiegley <johnw@gnu.org> - * eshell/esh-ext.el (eshell-external-command): Added a fix for + * eshell/esh-ext.el (eshell-external-command): Add a fix for XEmacs' new dired.el, which adds a global entry in the `file-name-handler-alist'. 2002-02-16 John Wiegley <johnw@gnu.org> - * align.el (align-region): Added a missing name argument. + * align.el (align-region): Add a missing name argument. 2002-02-16 John Wiegley <johnw@gnu.org> @@ -19037,7 +19037,7 @@ 2002-02-12 Per Abrahamsen <abraham@dina.kvl.dk> - * menu-bar.el (menu-bar-options-save): Removed `truncate-lines'. + * menu-bar.el (menu-bar-options-save): Remove `truncate-lines'. (menu-bar-options-menu): Don't set default value for `truncate-lines'. 2002-02-12 Per Abrahamsen <abraham@dina.kvl.dk> @@ -19063,7 +19063,7 @@ 2002-02-11 Per Abrahamsen <abraham@dina.kvl.dk> - * toolbar/tool-bar.el (tool-bar-mode): Removed standard value. + * toolbar/tool-bar.el (tool-bar-mode): Remove standard value. * menu-bar.el (menu-bar-mode): Ditto. * cus-edit.el (customize-mark-to-save): Always save variables without a standard value. @@ -19111,7 +19111,7 @@ table information. Maybe report char-code-property-table info. Maybe report character's unicode. Tweak printing of list info. (list-input-methods): Add xref buttons. - (dump-charsets, dump-codings): Deleted (obsolete). + (dump-charsets, dump-codings): Delete (obsolete). From Dave Love <fx@gnu.org>. 2002-02-10 Pavel Janík <Pavel@Janik.cz> @@ -19455,8 +19455,8 @@ (batch-byte-compile-if-not-done): New function. * Makefile.in (compile): New target. - (compile-always): Renamed from compile-files. - (compile-after-backup): Renamed from compile. + (compile-always): Rename from compile-files. + (compile-after-backup): Rename from compile. (bootstrap): Depend on compile-always, not compile-files. * emulation/pc-select.el (pc-select-save-and-set-mode): @@ -19769,7 +19769,7 @@ 2002-01-16 Richard M. Stallman <rms@gnu.org> - * mouse.el (mouse-drag-region-1): Renamed from mouse-drag-region, + * mouse.el (mouse-drag-region-1): Rename from mouse-drag-region, more or less. (mouse-drag-region): New function. For a click in the echo area, show *Messages*. @@ -19812,7 +19812,7 @@ (eudc-pre-select-window-configuration, eudc-insertion-marker): Variables removed. (eudc-insert-selected): Function removed. - (eudc-select): Reimplemented. + (eudc-select): Reimplement. (eudc-expand-inline): Delete the strings only after its expansion is chosen not before. @@ -20045,7 +20045,7 @@ * viper-util.el: Use viper-cond-compile-for-xemacs-or-emacs. (viper-read-key-sequence, viper-set-unread-command-events) - (viper-char-symbol-sequence-p, viper-char-array-p): Moved here. + (viper-char-symbol-sequence-p, viper-char-array-p): Move here. * viper-ex.el: Use viper-cond-compile-for-xemacs-or-emacs. @@ -20072,7 +20072,7 @@ (ediff-convert-fine-diffs-to-overlays, ediff-empty-diff-region-p) (ediff-whitespace-diff-region-p, ediff-get-region-contents): Move to ediff-util.el. - (ediff-event-key): Moved here. + (ediff-event-key): Move here. * ediff-merge.el: Got rid of unreferenced variables. @@ -20091,7 +20091,7 @@ (ediff-unhighlight-diff, ediff-unhighlight-diffs-totally) (ediff-empty-diff-region-p, ediff-whitespace-diff-region-p) (ediff-get-region-contents, ediff-make-current-diff-overlay): - Moved here. + Move here. (ediff-format-bindings-of): New function by Hannu Koivisto <azure@iki.fi>. (ediff-setup): Make sure the merge buffer is always widened and @@ -20116,7 +20116,7 @@ (ediff-regions-internal): Get rid of the warning about comparing regions of the same buffer. - * ediff-diff.el (ediff-convert-fine-diffs-to-overlays): Moved here. + * ediff-diff.el (ediff-convert-fine-diffs-to-overlays): Move here. Plus the following fixes courtesy of Dave Love: Doc fixes. (ediff-word-1): Use word class and move - to the front per regexp documentation. @@ -20177,19 +20177,19 @@ 2002-01-05 Andre Spiegel <spiegel@gnu.org> * vc.el (vc-branch-part): Return nil if there's no `.'. - (vc-default-previous-version): Renamed from vc-previous-version. + (vc-default-previous-version): Rename from vc-previous-version. New args BACKEND and FILE. Return nil for revision numbers without a `.'. (vc-version-diff): Call vc-BACKEND-previous-version. (vc-steal-lock): Steal lock before composing mail, so that no mail is sent when the stealing goes wrong. And we'll actually see the error in that case now. - (vc-finish-steal): Removed. + (vc-finish-steal): Remove. * vc-rcs.el (vc-rcs-steal-lock): Do a real checkout after stealing the lock, so that we see expanded headers. (vc-rcs-trunk-p, vc-rcs-branch-part, vc-rcs-branch-p) - (vc-rcs-minor-part, vc-rcs-previous-version): Removed. These are + (vc-rcs-minor-part, vc-rcs-previous-version): Remove. These are available from vc.el. Updated all callers. 2002-01-05 Richard M. Stallman <rms@gnu.org> @@ -20235,7 +20235,7 @@ 2002-01-03 Per Abrahamsen <abraham@dina.kvl.dk> - * custom.el (defcustom): Documented :tag, :link and :load. + * custom.el (defcustom): Document :tag, :link and :load. 2002-01-03 Eli Zaretskii <eliz@is.elta.co.il> @@ -20321,7 +20321,7 @@ (xscheme-send-string-1): Call xscheme-insert-expression to save expression in ring. (xscheme-yank-previous-send): Now an alias for xscheme-yank. - (xscheme-previous-send): Deleted variable. + (xscheme-previous-send): Delete variable. (xscheme-send-string-2, xscheme-send-char, xscheme-send-proceed) (xscheme-send-control-g-interrupt): Use process-send-string rather @@ -20591,15 +20591,15 @@ * viper-cmd.el (viper-change-state): Got rid of make-local-hook. (viper-special-read-and-insert-char): Make C-m work right in the r command. - (viper-buffer-search-enable): Fixed format string. + (viper-buffer-search-enable): Fix format string. * viper-ex.el (ex-token-alist): Use ex-set-visited-file-name instead of viper-info-on-file. (ex-set-visited-file-name): New function. - * viper.el (viper-emacs-state-mode-list): Added mail-mode. + * viper.el (viper-emacs-state-mode-list): Add mail-mode. - * ediff-mult.el (ediff-meta-mark-equal-files): Added optional + * ediff-mult.el (ediff-meta-mark-equal-files): Add optional action argument. * ediff-init.el: Fixed some doc strings. @@ -20626,7 +20626,7 @@ * emacs-lisp/elint.el (elint-unknown-builtin-args): Remove mocklisp entries. - * subr.el (insert-string): Moved from mocklisp.c, reimplemented in + * subr.el (insert-string): Move from mocklisp.c, reimplemented in Lisp. Obsoleted. * emulation/mlconvert.el: File removed. @@ -20887,8 +20887,8 @@ (lm-crack-copyright): Cope with multi-line copyright `lines'. * simple.el (newline): Doc fix. - (eval-expression-print-level, eval-expression-print-length): Doc - fix. Amend :type. + (eval-expression-print-level, eval-expression-print-length): + Doc fix. Amend :type. (next-line, previous-line): Make arg optional. (newline): Doc fix. @@ -20914,10 +20914,10 @@ 2001-12-16 Richard M. Stallman <rms@gnu.org> - * dired.el (dired-copy-filename-as-kill): Moved from dired-x.el. + * dired.el (dired-copy-filename-as-kill): Move from dired-x.el. (dired-mode-map): Bind w to dired-copy-filename-as-kill. - * dired-x.el (dired-copy-filename-as-kill): Moved to dired.el. + * dired-x.el (dired-copy-filename-as-kill): Move to dired.el. * autoinsert.el (auto-insert-alist): Redo finding C and C++ headers. Add a DESCRIPTION for the makefile item. @@ -20977,26 +20977,26 @@ 2001-12-15 Richard M. Stallman <rms@gnu.org> * language/ind-util.el (range): Function deleted. - (indian-regexp-of-hashtbl-keys): Renamed from `regexp-of-hashtbl-keys'. + (indian-regexp-of-hashtbl-keys): Rename from `regexp-of-hashtbl-keys'. All calls changed. - * language/devan-util.el (devanagari-range): Renamed from `range'. + * language/devan-util.el (devanagari-range): Rename from `range'. All calls changed. (devanagari-regexp-of-hashtbl-keys): - Renamed from `regexp-of-hashtbl-keys'. All calls changed. + Rename from `regexp-of-hashtbl-keys'. All calls changed. 2001-12-15 Dave Love <fx@gnu.org> * language/ind-util.el: Don't require cl. (indian-glyph-char, indian-glyph-max-char) - (indian-char-glyph): Moved from indian.el. + (indian-char-glyph): Move from indian.el. (indian--puthash-char, mapthread): Don't quote lambda. (indian--map): New function. (indian--puthash-v, indian--puthash-c, indian--puthash-m) (indian--puthash-cv): Use it. * language/indian.el (indian-glyph-char, indian-glyph-max-char) - (indian-char-glyph): Moved to ind-util.el + (indian-char-glyph): Move to ind-util.el * language/devan-util.el (devanagari-post-read-conversion): New function. @@ -21132,7 +21132,7 @@ * derived.el (derived-mode-p): Function moved to subr.el. - * subr.el (derived-mode-p): Moved here from derived.el. + * subr.el (derived-mode-p): Move here from derived.el. * international/mule.el (set-auto-coding): Use set-auto-mode-1. @@ -21282,7 +21282,7 @@ 2001-12-07 Miles Bader <miles@gnu.org> * progmodes/compile.el (compilation-error-regexp-alist): - Added regexps for RXP. + Add regexps for RXP. 2001-12-05 Eli Zaretskii <eliz@is.elta.co.il> @@ -21792,7 +21792,7 @@ * menu-bar.el (menu-bar-apropos-menu): New variable. Moved all `apropos' bindings to this menu. - (menu-bar-help-menu): Added `menu-bar-apropos-menu'. + (menu-bar-help-menu): Add `menu-bar-apropos-menu'. 2001-11-24 KAWABATA, Taichi <batta@beige.ocn.ne.jp> @@ -22048,7 +22048,7 @@ (browse-url-galeon, browse-url-galeon-sentinel): New functions. (browse-url-default-browser): New function. (browse-url-process-environment): Use browse-url-browser-display. - (browse-url-browser-display): Renamed from browse-url-netscape-display. + (browse-url-browser-display): Rename from browse-url-netscape-display. (browse-url-mozilla-startup-arguments, browse-url-galeon-program) (browse-url-galeon-arguments, browse-url-galeon-startup-arguments) (browse-url-mozilla-program, browse-url-mozilla-arguments): New vars. @@ -22077,7 +22077,7 @@ (Math-integer-neg, Math-equal, Math-lessp, Math-primp) (Math-num-integerp, Math-bignum-test, Math-equal-int) (Math-natnum-lessp, math-format-radix-digit): Change to `defsubst'. - (calc-record-compilation-date-macro): Deleted. Callers updated. + (calc-record-compilation-date-macro): Delete. Callers updated. (math-format-radix-digit): Move to calc-bin.el. * calc/calc.el (calc-record-compilation-date): Remove. @@ -22523,7 +22523,7 @@ * calc/calc-keypd.el (toplevel): Bind mouse buttons. (calc-do-keypad): Don't attempt to use nonexistent global mouse-map, use calc-keypad-map. - (calc-keypad-x-left-click): Renamed to calc-keypad-left-click. + (calc-keypad-x-left-click): Rename to calc-keypad-left-click. (calc-keypad-left-click): Don't use mouse-map; update to new event interface. (calc-keypad-x-middle-click, calc-keypad-x-right-click): Ditto. @@ -22632,7 +22632,7 @@ * textmodes/flyspell.el (flyspell-correct-word/local-keymap): Function deleted. (flyspell-correct-word): Old definition deleted. - (flyspell-correct-word/mouse-keymap): Renamed to flyspell-correct-word. + (flyspell-correct-word/mouse-keymap): Rename to flyspell-correct-word. All references renamed too. 2001-11-10 Gerd Moellmann <gerd@gnu.org> @@ -22641,7 +22641,7 @@ 2001-11-09 Per Abrahamsen <abraham@dina.kvl.dk> - * wid-edit.el (checklist): Removed `:menu-tag'. + * wid-edit.el (checklist): Remove `:menu-tag'. (radio-button-choice): Ditto. (editable-list): Ditto. @@ -23102,7 +23102,7 @@ 2001-10-28 Per Abrahamsen <abraham@dina.kvl.dk> - * cus-start.el (recursive-load-depth-limit): Added. + * cus-start.el (recursive-load-depth-limit): Add. 2001-10-28 Richard M. Stallman <rms@gnu.org> @@ -23176,7 +23176,7 @@ 2001-10-27 Sam Steingold <sds@gnu.org> - * textmodes/sgml-mode.el (sgml-xml): Renamed from `html-xhtml'. + * textmodes/sgml-mode.el (sgml-xml): Rename from `html-xhtml'. (sgml-xml-guess): Extracted from `html-mode' and generalized. (sgml-mode-common): Call it. (sgml-mode, html-mode): Set `mode-name' based on `sgml-xml'. @@ -23369,10 +23369,10 @@ 2001-10-24 Sam Steingold <sds@gnu.org> - * mouse.el (mouse-buffer-menu-mode-groups): Added "Version + * mouse.el (mouse-buffer-menu-mode-groups): Add "Version Control" and "SGML" groups. -2001-10-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2001-10-24 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-beginning-of-member-init-list): Better handling of C++ template args to avoid confusion with `<' @@ -23455,25 +23455,25 @@ * vc.el (vc-annotate-display-default): Accept colormap scaling ratio (now deprecated). - (vc-annotate-display-autoscale): Added. + (vc-annotate-display-autoscale): Add. (vc-annotate-add-menu): New autoscaling menu options "Span to Oldest" and "Span Oldest->Newest". Easymenu support added for toggle menus driven by customize variable `vc-annotate-display-mode'. - (vc-annotate-display-select): Added. - (vc-annotate): Changed temp-buffer-show-function to + (vc-annotate-display-select): Add. + (vc-annotate): Change temp-buffer-show-function to `vc-annotate-display-select'. - (vc-annotate-display): Removed arguments BUFFER and BACKEND. + (vc-annotate-display): Remove arguments BUFFER and BACKEND. Added argument OFFSET. Instead of backend function, calls now generic `vc-annotate-difference'. - (vc-annotate-difference): Added as generic function instead of + (vc-annotate-difference): Add as generic function instead of backend-specific function. No longer takes argument POINT, but instead accepts a time OFFSET. - (vc-default-annotate-current-time): Added. + (vc-default-annotate-current-time): Add. - * vc-cvs.el (vc-cvs-annotate-difference): Removed to generic + * vc-cvs.el (vc-cvs-annotate-difference): Remove to generic version in vc.el. - (vc-cvs-annotate-current-time): Added, as override of default. - (vc-cvs-annotate-time): Added. Taken mostly from the (now removed) + (vc-cvs-annotate-current-time): Add, as override of default. + (vc-cvs-annotate-time): Add. Taken mostly from the (now removed) `vc-cvs-annotate-difference'. 2001-10-22 Gerd Moellmann <gerd@gnu.org> diff --git a/lisp/ChangeLog.11 b/lisp/ChangeLog.11 index 8fe31a52ddc..b3cdfa034e2 100644 --- a/lisp/ChangeLog.11 +++ b/lisp/ChangeLog.11 @@ -40,8 +40,8 @@ * progmodes/fortran.el (fortran-mode): Use mode-require-final-newline. * progmodes/f90.el (f90-mode): Use mode-require-final-newline. * progmodes/cperl-mode.el (cperl-mode): Use mode-require-final-newline. - * progmodes/cfengine.el (cfengine-mode): Use - mode-require-final-newline. + * progmodes/cfengine.el (cfengine-mode): + Use mode-require-final-newline. * progmodes/ada-mode.el (ada-mode): Use mode-require-final-newline. * textmodes/text-mode.el (text-mode): Use mode-require-final-newline. * textmodes/texinfo.el (texinfo-mode): Use mode-require-final-newline. @@ -438,8 +438,8 @@ * net/tramp-smb.el (tramp-smb-advice-PC-do-completion): Make the advice less fragile. Surround temporary redefinition of - `substitute-in-file-name' with `unwind-protect'. Suggested by - Matt Hodges <MPHodges@member.fsf.org>. + `substitute-in-file-name' with `unwind-protect'. + Suggested by Matt Hodges <MPHodges@member.fsf.org>. 2004-12-17 Juri Linkov <juri@jurta.org> @@ -1608,9 +1608,9 @@ 2004-11-24 Jay Belanger <belanger@truman.edu> - * calc/calc.el (calc-embedded-active): Removed unnecessary + * calc/calc.el (calc-embedded-active): Remove unnecessary declaration. - (calc-show-banner): Removed redundant declaration. + (calc-show-banner): Remove redundant declaration. * calc/calc-graph.el (calc-gnuplot-default-device) (calc-gnuplot-default-output, calc-gnuplot-print-device) @@ -1662,7 +1662,7 @@ (math-nri-n): New variable. (math-nth-root-integer, math-nth-root-int-iter): Replace variable n by declared variable. - (calcFunc-log): Removed misplaced condition. + (calcFunc-log): Remove misplaced condition. 2004-11-24 Stefan Monnier <monnier@iro.umontreal.ca> @@ -3366,8 +3366,8 @@ 2004-10-24 Kai Grossjohann <kai.grossjohann@gmx.net> - * simple.el (process-file): Accept nil for INFILE. Reported by - Luc Teirlinck. + * simple.el (process-file): Accept nil for INFILE. + Reported by Luc Teirlinck. 2004-10-24 Masatake YAMATO <jet@gyve.org> @@ -3969,7 +3969,7 @@ * indent.el (set-left-margin, set-right-margin): Rename `lm' arg to `width' for consistency with docstring. Doc fix. -2004-10-01 Martin Stjernholm <bug-cc-mode@gnu.org> +2004-10-01 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-langs.el: Load cl here since cc-defs doesn't do it. This is necessary for derived modes. @@ -4330,8 +4330,8 @@ (calc-mode): Compare `calc-settings-file' to `user-init-file' rather than "\\.emacs" to determine if it is the user-init-file. - * calc/calc-embed.el (calc-embedded-set-modes): Use - `calc-mode-var-list' correctly. + * calc/calc-embed.el (calc-embedded-set-modes): + Use `calc-mode-var-list' correctly. 2004-09-15 Thien-Thi Nguyen <ttn@gnu.org> @@ -5129,7 +5129,7 @@ (speedbar-directory): New image (unused pixmap already existed). (speedbar-expand-image-button-alist): Use it. -2004-08-11 Martin Stjernholm <bug-cc-mode@gnu.org> +2004-08-11 Martin Stjernholm <mast@lysator.liu.se> CC Mode update to 5.30.9: @@ -5212,7 +5212,7 @@ Fix bug that could cause an error from `after-change-functions' when the changed region is at bob. -2004-08-11 Alan Mackenzie <bug-cc-mode@gnu.org> +2004-08-11 Alan Mackenzie <acm@muc.de> CC Mode update to 5.30.9: @@ -5503,8 +5503,8 @@ since Emacs 22.1 only (XEmacs has it). Implementation rewritten in order to avoid this function. (tramp-handle-write-region): Set current buffer. If connection - wasn't open, `file-modes' has changed it accidentally. Reported by - David Kastrup <dak@gnu.org>. + wasn't open, `file-modes' has changed it accidentally. + Reported by David Kastrup <dak@gnu.org>. (tramp-enter-password, tramp-read-passwd): New arguments USER and HOST. (tramp-action-password, tramp-multi-action-password): Apply it. @@ -8532,8 +8532,8 @@ 2004-04-16 Dave Love <fx@gnu.org> - * progmodes/python.el (python-compilation-line-number): Fix - braindamage. + * progmodes/python.el (python-compilation-line-number): + Fix braindamage. (python-load-file): Fix python-orig-start setting. * progmodes/compile.el: Doc fixes. @@ -9482,8 +9482,8 @@ 2004-03-22 Luc Teirlinck <teirllm@auburn.edu> - * autorevert.el (global-auto-revert-non-file-buffers): Expand - docstring. + * autorevert.el (global-auto-revert-non-file-buffers): + Expand docstring. (buffer-stale-function): New variable. (auto-revert-list-diff, auto-revert-dired-file-list) (auto-revert-dired-changed-p, auto-revert-buffer-p): Delete. @@ -10230,8 +10230,8 @@ * progmodes/ebnf-abn.el: New file, implements an ABNF parser. - * progmodes/ebnf2ps.el: Doc fix. Accept ABNF (Augmented BNF). New - arrow shapes: semi-up-hollow, semi-up-full, semi-down-hollow and + * progmodes/ebnf2ps.el: Doc fix. Accept ABNF (Augmented BNF). + New arrow shapes: semi-up-hollow, semi-up-full, semi-down-hollow and semi-down-full. Fix a bug on productions like test = {"test"}* | ( "tt" ["test"] ). Reported by Markus Dreyer <mdreyer@ix.urz.uni-heidelberg.de>. @@ -10568,7 +10568,7 @@ (ses-mode-map): Use them. (ses-read-number) New fun. Duplicates code from interactive "N" spec. -2004-02-14 Martin Stjernholm <bug-cc-mode@gnu.org> +2004-02-14 Martin Stjernholm <mast@lysator.liu.se> * Makefile.in: Fix the CC Mode recompile kludge so it works when building in a different directory. @@ -10642,7 +10642,7 @@ * tar-mode.el (tar-extract): Fix for the case that a file doesn't have end-of-line. -2004-02-09 Martin Stjernholm <bug-cc-mode@gnu.org> +2004-02-09 Martin Stjernholm <mast@lysator.liu.se> * Makefile.in: Added extra dependencies in the recompile target needed to cope with the compile time macro expansions in CC Mode. @@ -11034,8 +11034,8 @@ 2004-01-21 Jan Djärv <jan.h.d@swipnet.se> - * term/x-win.el (x-clipboard-yank, menu-bar-edit-menu): Call - menu-bar-enable-clipboard and make Paste use clipboard first. + * term/x-win.el (x-clipboard-yank, menu-bar-edit-menu): + Call menu-bar-enable-clipboard and make Paste use clipboard first. 2004-01-20 Stefan Monnier <monnier@iro.umontreal.ca> @@ -11714,8 +11714,8 @@ 2003-11-30 Kai Grossjohann <kai.grossjohann@gmx.net> Version 2.0.38 of Tramp released. - * net/tramp.el (tramp-chunksize): Extend docstring. Suggested by - Charles Curley <charlescurley@charlescurley.com>. + * net/tramp.el (tramp-chunksize): Extend docstring. + Suggested by Charles Curley <charlescurley@charlescurley.com>. (tramp-multi-connection-function-alist): Add ssht entry which adds "-e none -t -t" to the list of ssh args. Suggested by Adrian Aichner. @@ -11932,7 +11932,7 @@ by returning the original value of 8 in all cases, but 99% of the time this is a waste of whitespace). -2003-11-16 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-11-16 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-guess-continued-construct) (c-guess-basic-syntax): Check a little more carefully if it's a @@ -12696,13 +12696,13 @@ * window.el (window-current-scroll-bars): New defun. -2003-09-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-09-24 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-parse-state): Fix bug that could cause errors when the state cache contains info on parts that have been narrowed out. -2003-09-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-09-24 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-vars.el (c-comment-prefix-regexp): Document that `c-setup-paragraph-variables' has to be used when this variable is @@ -12712,7 +12712,7 @@ * progmodes/cc-styles.el (c-setup-paragraph-variables): Make it interactive. -2003-09-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-09-24 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-fonts.el (c-font-lock-declarations): Fix recognition of constructors and destructors for classes whose @@ -12721,14 +12721,14 @@ * progmodes/cc-langs.el (c-type-list-kwds): If "operator" is followed by an identifier in C++ then it's a type. -2003-09-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-09-24 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-fonts.el (c-font-lock-invalid-string): Fix eob problem that primarily affected XEmacs. Don't use faces to find unterminated strings since Emacs and XEmacs fontify strings differently - this function should now work better in XEmacs. -2003-09-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-09-24 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-electric-brace): Fix a bug in the `expand-abbrev' workaround which caused braces to misbehave inside @@ -12737,7 +12737,7 @@ * progmodes/cc-engine.el (c-forward-keyword-clause): Fix error handling. This bug could cause interactive font locking to bail out. -2003-09-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-09-24 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-just-after-func-arglist-p): Handle paren-style types in Pike. Also fixed some cases of @@ -13113,13 +13113,13 @@ * image.el (image-jpeg-p): Don't search beyond length of data. -2003-08-26 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-08-26 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-electric-brace): Work around for a misfeature in `expand-abbrev' which caused electric keywords like "else" to disappear if an open brace was typed directly afterwards. -2003-08-26 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-08-26 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-vars.el (c-extra-types-widget): The doc string is mandatory in `define-widget'. @@ -13132,7 +13132,7 @@ (c-assignment-op-regexp): New language var used by `c-lineup-math'. -2003-08-26 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-08-26 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-just-after-func-arglist-p): Safeguard against unbalanced sexps. @@ -13467,12 +13467,12 @@ * textmodes/reftex.el (reftex-region-active-p): New function. - * textmodes/reftex-parse.el (reftex-locate-bibliography-files): Improved the + * textmodes/reftex-parse.el (reftex-locate-bibliography-files): Improve the regexp to find the \bibliography macro. - * textmodes/reftex-vars.el (reftex-section-levels): Removed subsubparagraph, + * textmodes/reftex-vars.el (reftex-section-levels): Remove subsubparagraph, which does not exist in LaTeX. - (reftex-cite-format-builtin): Added amsrefs support. + (reftex-cite-format-builtin): Add amsrefs support. (reftex-toc-confirm-promotion): New option * textmodes/reftex-toc.el @@ -13482,7 +13482,7 @@ (reftex-toc-promote-action, reftex-toc-extract-section-number) (reftex-toc-newhead-from-alist) (reftex-toc-load-all-files-for-promotion): New functions. - (reftex-toc-help): Added description of new keys. + (reftex-toc-help): Add description of new keys. (reftex-toc-split-windows-fraction): New option. (reftex-recenter-toc-when-idle): Search *toc* window on all visible frames. @@ -13498,8 +13498,8 @@ (reftex-toc-quit): Adapted to delete frame when called in dedicated frame. - * textmodes/reftex-index.el (reftex-index-phrase-match-is-indexed): Check - all enclosing macros. + * textmodes/reftex-index.el (reftex-index-phrase-match-is-indexed): + Check all enclosing macros. 2003-08-08 Vinicius Jose Latorre <viniciusjl@ig.com.br> @@ -13618,7 +13618,7 @@ * calendar/holidays.el, calendar/lunar.el, calendar/solar.el: (displayed-month, displayed-year): Define for compiler. -2003-08-03 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-08-03 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-mode.el (c-init-language-vars-for): Add argument MODE. Renamed from c-init-c-language-vars'. @@ -13632,7 +13632,7 @@ (pike-mode): Ditto. (awk-mode): Ditto. -2003-08-03 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-08-03 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-end-of-current-token): Return whether or not the point moved. @@ -13850,7 +13850,7 @@ * simple.el (current-word): Don't include punctuation char when `really-word' arg is non-nil. -2003-07-17 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-07-17 Martin Stjernholm <mast@lysator.liu.se> * progmodes/awk-mode.el: Obsoleted by the AWK support in CC Mode - moved to the directory obsolete. @@ -13865,12 +13865,12 @@ (syntax-ppss-after-change-function): New alias. Update uses. (syntax-ppss): Catch the case where the buffer is narrowed. -2003-07-16 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-07-16 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-defs.el (c-langelem-sym, c-langelem-pos) (c-langelem-2nd-pos): Add accessor functions for syntactic elements. -2003-07-16 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-07-16 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-literal-faces): Declare as a variable since it might be modified. @@ -13964,8 +13964,8 @@ 2003-07-10 Vinicius Jose Latorre <viniciusjl@ig.com.br> - * ps-print.el: Print line number correctly in a region. Reported by - Tim Allen <timallen@ls83.fsnet.co.uk>. + * ps-print.el: Print line number correctly in a region. + Reported by Tim Allen <timallen@ls83.fsnet.co.uk>. (ps-print-version): New version number (6.6.2). (ps-printing-region): Code fix. @@ -14004,24 +14004,24 @@ * dired.el (dired-move-to-filename-regexp): Allow quote in months. -2003-07-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-07-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-guess-basic-syntax): Do not do hidden buffer changes; there's third party code that calls this function directly. -2003-07-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-07-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-fonts.el (javadoc-font-lock-keywords) (autodoc-font-lock-keywords): Don't byte compile on font lock initialization when running from byte compiled files. -2003-07-08 Alan Mackenzie <bug-cc-mode@gnu.org> +2003-07-08 Alan Mackenzie <acm@muc.de> * progmodes/cc-engine.el: Fix AWK mode indentation when previous statement ends with auto-increment "++". -2003-07-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-07-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-langs.el, progmodes/cc-styles.el (c-style-alist) (c-lang-variable-inits, c-lang-variable-inits-tail): The values of @@ -14110,13 +14110,13 @@ * info.el (Info-menu-entry-name-re): Add `:' to second [] part. This should fix the infinite loop when extracting menu names. -2003-07-05 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-07-05 Martin Stjernholm <mast@lysator.liu.se> * files.el (auto-mode-alist, interpreter-mode-alist): Remove entries to CC Mode modes to avoid duplicates; they are now added with autoload directives in cc-mode.el. -2003-07-05 Martin Stjernholm <bug-cc-mode@gnu.org> +2003-07-05 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-langs.el, progmodes/cc-styles.el (c-style-alist) (c-lang-variable-inits, c-lang-variable-inits-tail): The values of diff --git a/lisp/ChangeLog.12 b/lisp/ChangeLog.12 index 4b28e0f6d2e..968658cb69c 100644 --- a/lisp/ChangeLog.12 +++ b/lisp/ChangeLog.12 @@ -932,7 +932,7 @@ * international/quail.el (quail-setup-completion-buf): Make the completion buffer read-only. - (quail-completion): Adjusted for the above change. Leave the + (quail-completion): Adjust for the above change. Leave the modified flag nil. 2007-03-20 David Kastrup <dak@gnu.org> @@ -2371,8 +2371,8 @@ 2007-01-27 Eli Zaretskii <eliz@gnu.org> * ls-lisp.el (ls-lisp-use-localized-time-format): New defcustom. - (ls-lisp-format-time-list): Doc fix. Mention - ls-lisp-use-localized-time-format. + (ls-lisp-format-time-list): Doc fix. + Mention ls-lisp-use-localized-time-format. (ls-lisp-format-time): Use ls-lisp-format-time-list if ls-lisp-use-localized-time-format is non-nil, even if a valid locale is defined. @@ -3410,8 +3410,8 @@ * wdired.el (wdired-change-to-wdired-mode, wdired-finish-edit) (wdired-search-and-rename): Simplify code. - (wdired-preprocess-files, wdired-preprocess-perms): Make - read-only property of preceding character rear-nonsticky to + (wdired-preprocess-files, wdired-preprocess-perms): + Make read-only property of preceding character rear-nonsticky to avoid that it can be modified. Put old-name and old-link properties on character preceding name and replace put-text-property by add-text-properties. @@ -3560,8 +3560,8 @@ 2006-12-04 Michael Albinus <michael.albinus@gmx.de> * net/tramp.el (tramp-methods): Add "ControlPath" and - "ControlMaster" to scp, scp1 and scp2 methods. Suggested by - Andreas Schwab <schwab@suse.de>. + "ControlMaster" to scp, scp1 and scp2 methods. + Suggested by Andreas Schwab <schwab@suse.de>. (tramp-do-copy-or-rename-file-out-of-band) (tramp-open-connection-rsh): Compute format spec for ?t. (tramp-process-actions): Trace command parameters. @@ -6782,9 +6782,9 @@ * mail/feedmail.el (feedmail-buffer-to-sendmail): Look for sendmail in several common directories. - * mail/sendmail.el (sendmail-program): Moved here from paths.el. + * mail/sendmail.el (sendmail-program): Move here from paths.el. - * paths.el (sendmail-program): Removed. + * paths.el (sendmail-program): Remove. 2006-09-04 Daiki Ueno <ueno@unixuser.org> @@ -6822,8 +6822,8 @@ * net/rcirc.el (rcirc-keywords): New variable. (rcirc-bright-nicks, rcirc-dim-nicks): New variables. - (rcirc-bright-nick-regexp, rcirc-dim-nick-regexp): Remove - variables. + (rcirc-bright-nick-regexp, rcirc-dim-nick-regexp): + Remove variables. (rcirc-responses-no-activity): New function. (rcirc-handler-generic): Check for responses in above. (rcirc-process-command): Add ?: character to arguments of raw @@ -6870,8 +6870,8 @@ 2006-08-31 Richard Stallman <rms@gnu.org> * cus-edit.el (custom-save-variables): Slight cleanup. - (Custom-no-edit): Renamed from custom-no-edit. - (Custom-newline): Renamed from custom-newline. + (Custom-no-edit): Rename from custom-no-edit. + (Custom-newline): Rename from custom-newline. (custom-mode-map): Use new names. * emacs-lisp/easy-mmode.el (define-minor-mode): Reference manual @@ -7465,7 +7465,7 @@ 2006-08-09 John Wiegley <johnw@newartisans.com> - * calendar/timeclock.el (timeclock-use-elapsed): Added a new + * calendar/timeclock.el (timeclock-use-elapsed): Add a new variable, which causes timeclock to report elapsed time worked, instead of just work remaining. @@ -8041,8 +8041,8 @@ instead of retired `allout-resumptions'. For hook functions, use `local' parameter so hook settings are created and removed as buffer-local settings. Revise (resumptions) setting - auto-fill-function so it is set only if already active. The - related fill-function settings are all made in either case, so + auto-fill-function so it is set only if already active. + The related fill-function settings are all made in either case, so that activating auto-fill-mode activity will have the custom allout-mode behaviors (hanging indent on topics, if configured for it). Remove all allout-exposure-category overlays on mode deactivation. @@ -9914,7 +9914,7 @@ * progmodes/idlw-shell.el (idlwave-shell-move-or-history): Remove spurious move to point-max (new comint behavior fixes). - * progmodes/idlwave.el (idlwave-push-mark): Removed obsolete + * progmodes/idlwave.el (idlwave-push-mark): Remove obsolete compatibility function (Emacs 18/19). (idlwave-is-continuation-line): Always return point at start of previous non-blank continuation line. @@ -9978,12 +9978,12 @@ `point'. (diff-hunk-text, diff-goto-source): Doc fix. - * startup.el (fancy-splash-screens, normal-splash-screen): Use - face `mode-line-buffer-id' for mode-line buffer face instead of + * startup.el (fancy-splash-screens, normal-splash-screen): + Use face `mode-line-buffer-id' for mode-line buffer face instead of hard-coded `(:weight bold)'. - * arc-mode.el (archive-set-buffer-as-visiting-file): Bind - buffer-undo-list to t (undo-ask is reproducible by visiting + * arc-mode.el (archive-set-buffer-as-visiting-file): + Bind buffer-undo-list to t (undo-ask is reproducible by visiting nested archives). 2006-05-09 Kim F. Storm <storm@cua.dk> @@ -9999,9 +9999,9 @@ 2006-05-09 Masatake YAMATO <jet@gyve.org> - * font-lock.el (cpp-font-lock-keywords-source-directives): Added - "warning" and "import". - (cpp-font-lock-keywords): Added "warning". + * font-lock.el (cpp-font-lock-keywords-source-directives): + Add "warning" and "import". + (cpp-font-lock-keywords): Add "warning". 2006-05-08 Dan Nicolaescu <dann@ics.uci.edu> @@ -12213,41 +12213,41 @@ * progmodes/etags.el (tags-completion-table): Do completion from all the tables in the current list, as documented in the manual. -2006-02-24 Alan Mackenzie <bug-cc-mode@gnu.org> +2006-02-24 Alan Mackenzie <acm@muc.de> * CC Mode Update to 5.31.3. -2006-02-24 Alan Mackenzie <bug-cc-mode@gnu.org> +2006-02-24 Alan Mackenzie <acm@muc.de> * progmodes/cc-mode.el (c-postprocess-file-styles): Bind inhibit-read-only to t, around the call to c-remove-any-local-eval-or-mode-variables, so that it works on a RO file. -2006-02-24 Alan Mackenzie <bug-cc-mode@gnu.org> +2006-02-24 Alan Mackenzie <acm@muc.de> * progmodes/cc-awk.el: Correct a typo. -2006-02-24 Alan Mackenzie <bug-cc-mode@gnu.org> +2006-02-24 Alan Mackenzie <acm@muc.de> * progmodes/cc-cmds.el, progmodes/cc-mode.el: Rename c-hungry-backspace to c-hungry-delete-backwards, at the request of RMS. Leave the old name as an alias. -2006-02-24 Alan Mackenzie <bug-cc-mode@gnu.org> +2006-02-24 Alan Mackenzie <acm@muc.de> * progmodes/cc-mode.el: Correct a typo. -2006-02-24 Alan Mackenzie <bug-cc-mode@gnu.org> +2006-02-24 Alan Mackenzie <acm@muc.de> * progmodes/cc-defs.el: Update the version number to 5.31.3. -2006-02-24 Alan Mackenzie <bug-cc-mode@gnu.org> +2006-02-24 Alan Mackenzie <acm@muc.de> * progmodes/cc-cmds.el (c-electric-brace): Fix clean-up brace-else-brace (error due to mbeg, mend being undefined). -2006-02-24 Alan Mackenzie <bug-cc-mode@gnu.org> +2006-02-24 Alan Mackenzie <acm@muc.de> * progmodes/cc-mode.el: File Local variables: Solve the problem where both `mode' and c-file-offsets are specified: `mode' will @@ -12257,7 +12257,7 @@ c-tentative-buffer-change, to splat `mode' and `eval' before the second hack-local-variables. -2006-02-24 Alan Mackenzie <bug-cc-mode@gnu.org> +2006-02-24 Alan Mackenzie <acm@muc.de> * progmodes/cc-mode.el: [Supersedes patch to cc-engine.el 2005-12-16T20:07:49Z!monnier@iro.umontreal.ca] @@ -12272,7 +12272,7 @@ with save-match-data. It was being corrupted when Font Lock was not enabled. -2006-02-24 Alan Mackenzie <bug-cc-mode@gnu.org> +2006-02-24 Alan Mackenzie <acm@muc.de> * progmodes/cc-langs.el (c-mode-menu): Add menu items for Electric Mode and Subword Mode. @@ -12292,7 +12292,7 @@ * progmodes/cc-cmds.el (c-electric-brace, c-electric-semi&comma) (c-electric-colon): Correct doc-strings: "/ln" -> "/la". -2006-02-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2006-02-24 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-langs.el (c-make-init-lang-vars-fun): Improve the error message when there's an evaluation error to show whether @@ -12630,8 +12630,8 @@ (Info-isearch-push-state): Add quote before Info-current-file and Info-current-node. (Info-isearch-pop-state): Use `equal' instead of `string='. - (Info-extract-pointer, Info-following-node-name): Use - `match-string-no-properties' instead of `match-string'. + (Info-extract-pointer, Info-following-node-name): + Use `match-string-no-properties' instead of `match-string'. (Info-up): Check `old-file' for `stringp'. (Info-history): Use `equal' instead of `string-equal'. Check `file' for `stringp'. @@ -12681,8 +12681,8 @@ (rcirc-get-buffer-create): Fix bug with setting the target. (rcirc-any-buffer): Rename from rcirc-get-any-buffer, and include test for rcirc-always-use-server-buffer-flag here. - (rcirc-response-formats): Add %N, which is a facified nick. %n - uses the default face. Change the ACTION format string. If the + (rcirc-response-formats): Add %N, which is a facified nick. + %n uses the default face. Change the ACTION format string. If the "nick" is the server, don't print anything for that field. Comment fixes. (rcirc-target-buffer): Don't test @@ -12707,7 +12707,7 @@ (allout-version): Incremented, corrected, revised, and refined module commentary. - (provide 'allout): Moved to the bottom, added a require of overlay. + (provide 'allout): Move to the bottom, added a require of overlay. (allout-encrypt-unencrypted-on-saves): Defaults to t instead of `except-current'. @@ -12730,19 +12730,19 @@ Clarify provision for various write-file hook var names. Adjusted for invisible-text overlays instead of selective-display. - (allout-depth): Really return 0 if not within any topic. This - rectifies `allout-beginning-of-level' and sequence numbering + (allout-depth): Really return 0 if not within any topic. + This rectifies `allout-beginning-of-level' and sequence numbering errors that occur when cutting and pasting numbered topics. Changed from a in-line subst to a regular function, as well. - (allout-pre-next-prefix): Renamed from allout-pre-next-preface. + (allout-pre-next-prefix): Rename from allout-pre-next-preface. (allout-end-of-subtree, allout-end-of-subtree) (allout-end-of-entry, allout-end-of-current-heading) (allout-next-visible-heading, allout-open-topic, allout-show-entry) (allout-show-children, allout-show-to-offshoot) - (allout-hide-current-entry, allout-show-current-entry): Rectified - handling of trailing blank lines between items. + (allout-hide-current-entry, allout-show-current-entry): + Rectified handling of trailing blank lines between items. (allout-line-boundary-regexp, set-allout-regexp, allout-depth) (allout-current-depth, allout-unprotected, allout-hidden-p) @@ -12753,11 +12753,11 @@ (allout-hide-region-body, allout-toggle-subtree-encryption) (allout-encrypt-string, allout-encrypted-key-info) (allout-next-topic-pending-encryption, allout-encrypt-decrypted) - (allout-file-vars-section-data): Adjusted for use with + (allout-file-vars-section-data): Adjust for use with invisible-text overlays instead of selective-display. (allout-kill-line, allout-kill-topic, allout-yank-processing): - Reworked for use with invisible text overlays. + Rework for use with invisible text overlays. (allout-current-topic-collapsed-p): New function. @@ -12777,8 +12777,8 @@ (allout-overlay-insert-in-front-handler) (allout-overlay-interior-modification-handler) - (allout-before-change-handler, allout-isearch-end-handler): New - functions to handle extraordinary actions affecting concealed + (allout-before-change-handler, allout-isearch-end-handler): + New functions to handle extraordinary actions affecting concealed text. (allout-flag-region): Use overlays instead of selective-display @@ -12810,8 +12810,8 @@ 2006-02-17 Agustín Martín <agustin.martin@hispalinux.es> - * textmodes/ispell.el (ispell-change-dictionary): Call - ispell-buffer-local-dict instead of + * textmodes/ispell.el (ispell-change-dictionary): + Call ispell-buffer-local-dict instead of ispell-accept-buffer-local-defs. (ispell-local-dictionary-alist): Accept as valid any coding-system supported by Emacs. @@ -12918,8 +12918,8 @@ (hack-local-variables): Construct list of variable-value pairs, and apply or reject them in one go. Ask for confirmation if variables are not known safe. - (hack-local-variables-confirm): Complete rewrite. Support - `safe-local-variable-values'. + (hack-local-variables-confirm): Complete rewrite. + Support `safe-local-variable-values'. (enable-local-variables): Update docstring to reflect new behavior. (ignored-local-variables): Ignore ignored-local-variables and @@ -13018,8 +13018,8 @@ 2006-02-12 Michael Albinus <michael.albinus@gmx.de> * net/tramp.el (tramp-remote-path): Add "/usr/xpg4/bin" on top, - because on Solaris a POSIX compatible "id" is needed. Reported by - Magnus Henoch <mange@freemail.hu>. + because on Solaris a POSIX compatible "id" is needed. + Reported by Magnus Henoch <mange@freemail.hu>. 2006-02-12 Juri Linkov <juri@jurta.org> @@ -13103,10 +13103,10 @@ * help.el (describe-key-briefly): Now a wrapper for describe-key-briefly-internal. Bind enable-disabled-menus-and-buttons to t. Populate yank-menu if empty. - (describe-key-briefly-internal): Renamed from describe-key-briefly. + (describe-key-briefly-internal): Rename from describe-key-briefly. (describe-key): Now a wrapper for describe-key-internal. Bind enable-disabled-menus-and-buttons to t. Populate yank-menu if empty. - (describe-key-internal): Renamed from describe-key. + (describe-key-internal): Rename from describe-key. 2006-02-11 Milan Zamazal <pdm@zamazal.org> @@ -13641,8 +13641,8 @@ 2006-01-22 Kenichi Handa <handa@m17n.org> - * international/mule.el (make-subsidiary-coding-system): Reset - `coding-system-define-form' property of subsidiaries to nil. + * international/mule.el (make-subsidiary-coding-system): + Reset `coding-system-define-form' property of subsidiaries to nil. Avoid duplicated entry in coding-system-alist. (make-coding-system): Avoid duplicated entry in coding-system-alist. @@ -13790,8 +13790,8 @@ (tramp-unload-file-name-handler-alist) (tramp-unload-tramp): New defuns. (tramp-advice-PC-expand-many-files): New defadvice. - (tramp-save-PC-expand-many-files, tramp-setup-complete): Defuns - removed. + (tramp-save-PC-expand-many-files, tramp-setup-complete): + Defuns removed. (tramp-handle-expand-file-name): Remove double slash. (tramp-handle-file-attributes-with-ls): Return t as 9th attribute. It doesn't matter, because it will be converted later on. @@ -13869,7 +13869,7 @@ 2006-01-20 Carsten Dominik <dominik@science.uva.nl> - * textmodes/org.el (org-open-at-point): Fixed bug with matching a + * textmodes/org.el (org-open-at-point): Fix bug with matching a link. Fixed buggy argument sequence in call to `org-view-tags'. (org-compile-prefix-format): Set `org-prefix-has-tag'. (org-prefix-has-tag): New variable. @@ -13886,8 +13886,8 @@ images remain visible. (thumbs-file-alist): Construct list in thumbs-buffer and reverse order. - (thumbs-show-image-num): Get image from thumbs-file-alist. Set - mode name. + (thumbs-show-image-num): Get image from thumbs-file-alist. + Set mode name. (thumbs-next-image, thumbs-previous-image): Make them work. 2006-01-19 Luc Teirlinck <teirllm@auburn.edu> @@ -14197,8 +14197,8 @@ 2006-01-12 Masatake YAMATO <jet@gyve.org> - * progmodes/ld-script.el (auto-mode-alist): Support - suffix conventions used in netbsd and eCos. + * progmodes/ld-script.el (auto-mode-alist): + Support suffix conventions used in netbsd and eCos. 2006-01-11 Luc Teirlinck <teirllm@auburn.edu> @@ -15573,7 +15573,7 @@ * hi-lock.el (hi-lock-mode): Rename from hi-lock-buffer-mode; react if global-hi-lock-mode seems intended. - (global-hi-lock-mode): Renamed from hi-lock-mode. + (global-hi-lock-mode): Rename from hi-lock-mode. (hi-lock-archaic-interface-message-used) (hi-lock-archaic-interface-deduce): New variables. (turn-on-hi-lock-if-enabled, hi-lock-line-face-buffer) @@ -15723,7 +15723,7 @@ No need to check gud-comint-buffer is bound. (gdb): Prevent multiple debugging when first session uses gdba. -2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org> +2005-12-08 Alan Mackenzie <acm@muc.de> CC Mode update to 5.31. @@ -15736,7 +15736,7 @@ New macros c-sentence-end and c-default-value-sentence end, to cope with Emacs 22's new function `sentence-end'. -2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2005-12-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-show-syntactic-information): Solve the compat issue using `c-put-overlay' and `c-delete-overlay'. @@ -15744,7 +15744,7 @@ * progmodes/cc-defs.el (c-put-overlay, c-delete-overlay): New compat macros to handle overlays/extents. -2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org> +2005-12-08 Alan Mackenzie <acm@muc.de> * progmodes/cc-fix.el: Add definitions of the macros push and pop (for GNU Emacs 20.4). @@ -15761,7 +15761,7 @@ call to the new macro c-int-to-char. This solves XEmacs's regarding characters as different from integers. -2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2005-12-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-fonts.el (c-make-syntactic-matcher): New internal helper. @@ -15777,7 +15777,7 @@ * progmodes/cc-fonts.el (c-negation-char-face-name): New variable to map to `font-lock-negation-char-face' in emacsen where it exists. -2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org> +2005-12-08 Alan Mackenzie <acm@muc.de> * progmodes/cc-mode.el: Bind c-subword-mode to C-c C-w. @@ -15787,12 +15787,12 @@ * progmodes/cc-mode.el: Added tty suitable bindings for C-c <delete> and C-c C-<delete>. (To the c-hungry- delete functions). -2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2005-12-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-mode.el: Added autoload directive for `c-subword-move-mode' for use in older emacsen. -2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org> +2005-12-08 Alan Mackenzie <acm@muc.de> * progmodes/cc-mode.el: (i): Insert a binding for C-c C-backspace into @@ -15810,7 +15810,7 @@ * progmodes/cc-awk.el: Apply a tidy-up patch (from Stefan Monnier). -2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2005-12-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-fonts.el, progmodes/cc-vars.el (gtkdoc-font-lock-doc-comments, gtkdoc-font-lock-doc-protection) @@ -15829,7 +15829,7 @@ <delete> key behavior in XEmacs according to `delete-forward-p'. C.f. `c-electric-delete'. -2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org> +2005-12-08 Alan Mackenzie <acm@muc.de> * progmodes/cc-mode.el: Give c-hungry-backspace and c-hungry-delete-forward permanent key bindings. @@ -15847,7 +15847,7 @@ response to a report from Joseph Kiniry <kiniry@acm.org> that it was difficult to understand. -2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2005-12-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-on-identifier): Fix bug when at the first char of an identifier. @@ -15855,7 +15855,7 @@ * progmodes/cc-engine.el (c-on-identifier): Handle the "operator +" syntax in C++. -2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org> +2005-12-08 Alan Mackenzie <acm@muc.de> * progmodes/cc-cmds.el (c-mask-paragraph): Correct, so that auto-fill doesn't split a c-comment's last word from a hanging @@ -15871,7 +15871,7 @@ with blank comment-prefix, and a blank line as the comment's second line. -2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2005-12-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-fonts.el (c-cpp-matchers, c-basic-matchers-before): Incorporate the patterns added in the Emacs development branch @@ -15883,7 +15883,7 @@ * progmodes/cc-engine.el (c-literal-faces): Add `font-lock-comment-delimiter-face' which is new in Emacs 22. -2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org> +2005-12-08 Alan Mackenzie <acm@muc.de> * progmodes/cc-cmds.el: Make C-c C-a (`c-toggle-auto-newline') forcibly enable c-electric-flag. @@ -15892,7 +15892,7 @@ `comment-close-slash' on c-electric-slash: if enabled, typing `/' just after the comment-prefix of a C-style comment will close that comment. -2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2005-12-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-fonts.el (c-basic-matchers-before) (c-complex-decl-matchers): Fix the "not-arrow-prefix" regexp used @@ -15956,11 +15956,11 @@ Enable heuristics below the point to cope with classes inside special brace lists in Pike. -2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org> +2005-12-08 Alan Mackenzie <acm@muc.de> * progmodes/cc-cmds.el: Amend c-point-syntax to handle macros. -2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2005-12-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-guess.el (cc-guess-install): New function to install an already guessed style in another buffer. @@ -15969,7 +15969,7 @@ sets `inhibit-read-only' - `c-save-buffer-state' should be used anyway if the change always is undone. -2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org> +2005-12-08 Alan Mackenzie <acm@muc.de> Implement togglable electricity: @@ -16009,7 +16009,7 @@ (c-electric-semi&comma, c-electric-colon, c-electric-paren): restructure a bit. -2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2005-12-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-show-syntactic-information): Show the anchor position(s) using faces. Thanks to Masatake YAMATO for the idea. @@ -16037,7 +16037,7 @@ (c-subword-move-mode): Minor mode that replaces all the standard word handling functions with their subword equivalences. -2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org> +2005-12-08 Alan Mackenzie <acm@muc.de> * progmodes/cc-vars.el (c-cleanup-list): Insert a customization entry for one-liner-defun. @@ -16064,7 +16064,7 @@ c-max-one-liner-length. In c-default-style, set the default style for AWK to "awk". -2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2005-12-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-forward-label): Fix fontification of macros inside labels. @@ -16139,7 +16139,7 @@ * progmodes/cc-engine.el (c-beginning-of-statement-1): Fix a macro related issue. -2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org> +2005-12-08 Alan Mackenzie <acm@muc.de> * progmodes/cc-awk.el: Change the terminology of regexps: A char list is now [asdf], a char class [:alpha:]. @@ -16175,14 +16175,14 @@ c-string-par-start, c-string-par-separate to be more like Text Mode than Fundamental Mode. -2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2005-12-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-fonts.el (c-font-lock-declarations): Always narrow to the fontified region so that fontification doesn't occur outside it (could happen e.g. when fontifying a line with an unfinished declaration). -2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org> +2005-12-08 Alan Mackenzie <acm@muc.de> * progmodes/cc-awk.el: Move regexps for analyzing AWK code to near the start of the file. ^L now separate sections of the file. @@ -16220,7 +16220,7 @@ * progmodes/cc-mode.el: Fix what's almost a semantic ambiguity in a comment. -2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2005-12-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-electric-brace): Clean up using `c-tentative-buffer-changes'. @@ -16241,7 +16241,7 @@ avoid some false alarms. * progmodes/cc-engine.el, progmodes/cc-langs.el (c-looking-at-inexpr-block): - Fixed a situation where an error could be thrown for unbalanced + Fix a situation where an error could be thrown for unbalanced parens. Changed to make use of c-keyword-member' to avoid some repeated regexp matches. @@ -16279,7 +16279,7 @@ * progmodes/cc-defs.el (c-point): Add `bosws' and `eosws'. -2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org> +2005-12-08 Alan Mackenzie <acm@muc.de> * progmodes/cc-cmds.el, progmodes/cc-styles.el: * progmodes/cc-vars.el: New variables @@ -16290,7 +16290,7 @@ * progmodes/cc-cmds.el (c-electric-brace): Don't delete a comment which precedes the newly inserted `{'. -2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2005-12-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el, progmodes/cc-langs.el: Rewrote the recognition function for declaration level blocks. It should now cope with @@ -16475,7 +16475,7 @@ when macros occur in obscure places. Optimized the sexp movement a bit. -2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org> +2005-12-08 Alan Mackenzie <acm@muc.de> Enhancements for c-beginning-of-statement to work in AWK Mode: @@ -16498,7 +16498,7 @@ * progmodes/cc-mode.el: Put M-a and M-e into awk-mode-map. -2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2005-12-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el, progmodes/cc-fonts.el: * progmodes/cc-langs.el: Cleaned up the @@ -16650,13 +16650,13 @@ (c-lineup-math): Change to use `c-lineup-assignments'. -2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org> +2005-12-08 Alan Mackenzie <acm@muc.de> * progmodes/cc-cmds.el: Fix some bugs in subfunctions of c-beginning-of-statement. New subfunctions c-in-comment-line-prefix-p, c-narrow-to-comment-innards. -2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2005-12-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-fonts.el, progmodes/cc-langs.el: Use `c-simple-ws' instead of hardcoded char classes wherever possible. Changed a couple of @@ -16688,7 +16688,7 @@ in `regexp-opt' in Emacs 20 and XEmacs when strings contain newlines. Allow and ignore nil elements in the list. -2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org> +2005-12-08 Alan Mackenzie <acm@muc.de> * progmodes/cc-cmds.el: Comment out a (n almost certainly superfluous) check, (eq here (point-max)) in c-beginning-of-statement. @@ -16712,7 +16712,7 @@ c-beginning-of-statement, including new variable c-block-comment-start-regexp. -2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2005-12-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-langs.el (c-known-type-key): Optimize simple symbols from `*-font-lock-extra-types' so that there's no need to @@ -16731,7 +16731,7 @@ * progmodes/cc-vars.el (c-emacs-features): Remove compatibility with older emacsen: We now require `pps-extended-state'. -2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org> +2005-12-08 Alan Mackenzie <acm@muc.de> * progmodes/cc-cmds.el: New function c-beginning-of-sentence, which obviates the need to hack sentence-end. This now handles @@ -16746,7 +16746,7 @@ * progmodes/cc-cmds.el: Restructure c-beginning-of-statement: Improve its doc-string. Improve the handling of certain specific cases. -2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2005-12-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el, progmodes/cc-fonts.el, progmodes/cc-langs.el (c-guess-basic-syntax): Change the way class-level labels are @@ -16857,16 +16857,16 @@ `template-args-cont' in nested template arglists. There's still much to be desired in this area, though. -2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org> +2005-12-08 Alan Mackenzie <acm@muc.de> * progmodes/cc-cmds.el, progmodes/cc-engine.el: * progmodes/cc-langs.el, progmodes/cc-vars.el: Make the "Text Filling and Line Breaking" commands work for AWK buffers. -2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org> +2005-12-08 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-defs.el, progmodes/cc-engine.el (c-mode-is-new-awk-p): - Removed; (c-major-mode-is 'awk-mode) can be used instead now. + Remove; (c-major-mode-is 'awk-mode) can be used instead now. * progmodes/cc-mode.el: Always set up AWK mode since emacsen where it doesn't work no longer are supported. @@ -17613,7 +17613,7 @@ 2005-11-24 Chong Yidong <cyd@stupidchicken.com> - * hi-lock.el (hi-lock-buffer-mode): Renamed from `hi-lock-mode'. + * hi-lock.el (hi-lock-buffer-mode): Rename from `hi-lock-mode'. Use define-minor-mode, and make it a local mode. Turn on font-lock. (hi-lock-mode): New global minor mode. (turn-on-hi-lock-if-enabled): New function. @@ -17659,8 +17659,8 @@ New functions. (org-move-item-down, org-move-item-up): New commands. (org-export-as-html): New classes for CSS support. Bug fix in - regular expression detecting fixed-width regions. Respect - `org-local-list-ordered-item-terminator'. + regular expression detecting fixed-width regions. + Respect `org-local-list-ordered-item-terminator'. (org-set-autofill-regexps, org-adaptive-fill-function): "1)" is also a list item. (org-metaup, org-metadown, org-shiftmetaup, org-shiftmetadown): @@ -17685,8 +17685,8 @@ (gdb-var-update-handler): Find values for all variable objects. (gdb-info-frames-custom): Identify frames by leading "#". - * progmodes/gud.el (gud-speedbar-menu-items): Add - gdb-speedbar-auto-raise as radio button. + * progmodes/gud.el (gud-speedbar-menu-items): + Add gdb-speedbar-auto-raise as radio button. (gud-speedbar-buttons): Raise speedbar if requested. Don't match on "char **...". (gud-speedbar-buttons): Add (pointer) value for non-leaves. @@ -20089,8 +20089,8 @@ 2005-10-17 Bill Wohler <wohler@newt.com> Move all remaining images from lisp/toolbar to etc/images, move - lisp/toolbar/tool-bar to lisp and "delete" lisp/toolbar. Place - the low resolution images in their own directory (low-color). + lisp/toolbar/tool-bar to lisp and "delete" lisp/toolbar. + Place the low resolution images in their own directory (low-color). * toolbar/attach.*, toolbar/cancel.*, toolbar/close.* * toolbar/copy.*, toolbar/cut.*, toolbar/diropen.*, toolbar/exit.* @@ -20357,8 +20357,8 @@ 2005-10-13 Jan Djärv <jan.h.d@swipnet.se> * toolbar/diropen.xpm, toolbar/diropen.pbm: New versions made from - Gnome file-manager.png. Suggested by - Joachim Nilsson <joachim.nilsson@vmlinux.org>. + Gnome file-manager.png. + Suggested by Joachim Nilsson <joachim.nilsson@vmlinux.org>. * toolbar/README: Add diropen.xpm. @@ -20636,8 +20636,8 @@ trailing ":". Reported by Kurt Steinkraus <kurt@steinkraus.us>. (tramp-chunksize): Improve docstring. (tramp-set-auto-save-file-modes): Octal integer code #o600 breaks - Emacs 20. Use `tramp-octal-to-decimal' therefore. Reported by - Christian Joergensen <bugs@razor.dk>. + Emacs 20. Use `tramp-octal-to-decimal' therefore. + Reported by Christian Joergensen <bugs@razor.dk>. 2005-10-07 Glenn Morris <rgm@gnu.org> @@ -20792,8 +20792,8 @@ * emulation/viper-cmd.el (viper-normalize-minor-mode-map-alist) (viper-refresh-mode-line): Use make-local-variable to localize - some vars instead of make-variable-buffer-local. Suggested by - Stefan Monnier. + some vars instead of make-variable-buffer-local. + Suggested by Stefan Monnier. * emulation/viper-init.el (viper-make-variable-buffer-local): Delete alias. @@ -21035,23 +21035,23 @@ Frame management code (including timer, and mouse click specifics) moved to dframe.el: - (speedbar-attached-frame): Removed. Use dframe-attached-frame. - (speedbar-timer): Removed. Use dframe-timer. - (speedbar-close-frame): Removed. Use dframe-close-frame. - (speedbar-activity-change-focus-flag): Removed. Use - dframe-activity-change-focus-flag. - (speedbar-update-speed, speedbar-navigating-speed): Obsolete. Use - dframe-update-speed. + (speedbar-attached-frame): Remove. Use dframe-attached-frame. + (speedbar-timer): Remove. Use dframe-timer. + (speedbar-close-frame): Remove. Use dframe-close-frame. + (speedbar-activity-change-focus-flag): Remove. + Use dframe-activity-change-focus-flag. + (speedbar-update-speed, speedbar-navigating-speed): Obsolete. + Use dframe-update-speed. (speedbar-current-frame): New macro. Use this instead of the variable speedbar-frame. (speedbar-use-images, speedbar-expand-image-button-alist) - (speedbar-insert-image-button-maybe): Moved to sb-image.el. + (speedbar-insert-image-button-maybe): Move to sb-image.el. - (speedbar-find-image-on-load-path): Removed. Replaced by + (speedbar-find-image-on-load-path): Remove. Replaced by defezimage in ezimage.el. - (speedbar-expand-image-button-alist): Removed. Replaced by + (speedbar-expand-image-button-alist): Remove. Replaced by ezimage-expand-image-button-alist in ezimage.el. (speedbar-ignored-directory-regexp) @@ -21059,7 +21059,7 @@ (speedbar-ignored-directory-expressions) (speedbar-line-directory, speedbar-buffers-line-directory) (speedbar-directory-line, speedbar-buffers-line-directory): - Renamed, replacing `path' with `directory'. + Rename, replacing `path' with `directory'. (speedbar-create-directory, speedbar-expand-line-descendants) (speedbar-toggle-line-expansion) @@ -21617,8 +21617,8 @@ 2005-09-17 Milan Zamazal <pdm@zamazal.org> - * progmodes/glasses.el (glasses-make-readable): If - glasses-separator differs from underscore, put appropriate + * progmodes/glasses.el (glasses-make-readable): + If glasses-separator differs from underscore, put appropriate overlays over underscore characters. (glasses-convert-to-unreadable): If glasses-separator differs from underscore, try to convert glasses-separator characters to @@ -21975,7 +21975,7 @@ * custom.el (custom-known-themes): Clarify meaning of "standard". (custom-push-theme): Save old values in the standard theme. (disable-theme): Correct typo. - (custom-face-theme-value): Deleted unused function. + (custom-face-theme-value): Delete unused function. (custom-theme-recalc-face): Rewritten to treat enable/disable properly. 2005-09-05 Stefan Monnier <monnier@iro.umontreal.ca> @@ -25828,14 +25828,14 @@ (antlr-font-lock-default-face, antlr-font-lock-keyword-face) (antlr-font-lock-syntax-face, antlr-font-lock-ruledef-face) (antlr-font-lock-tokendef-face, antlr-font-lock-ruleref-face) - (antlr-font-lock-tokenref-face, antlr-font-lock-literal-face): New - backward-compatibility aliases for renamed faces. + (antlr-font-lock-tokenref-face, antlr-font-lock-literal-face): + New backward-compatibility aliases for renamed faces. (antlr-default-face, antlr-keyword-face, antlr-syntax-face) (antlr-ruledef-face, antlr-tokendef-face, antlr-ruleref-face) (antlr-tokenref-face, antlr-literal-face): Variables renamed to remove "font-lock-". Use renamed antlr-mode faces. - (antlr-font-lock-additional-keywords): Use renamed faces. Replace - literal face-names with face variable references. + (antlr-font-lock-additional-keywords): Use renamed faces. + Replace literal face-names with face variable references. * buff-menu.el (Buffer-menu-buffer): Remove "-face" suffix from face name. @@ -27387,7 +27387,7 @@ * emacs-lisp/cl.el (acons, pairlis): Add docstring. -2005-05-23 Martin Stjernholm <bug-cc-mode@gnu.org> +2005-05-23 Martin Stjernholm <mast@lysator.liu.se> CC Mode update to 5.30.10: @@ -27417,7 +27417,7 @@ * progmodes/cc-engine.el (c-guess-basic-syntax): Fix anchoring in `objc-method-intro' and `objc-method-args-cont'. -2005-05-23 Alan Mackenzie <bug-cc-mode@gnu.org> +2005-05-23 Alan Mackenzie <acm@muc.de> CC Mode update to 5.30.10: @@ -28294,8 +28294,8 @@ 2005-05-11 Stefan Monnier <monnier@iro.umontreal.ca> - * files.el (executable-find): Move from executable.el. Use - locate-file. + * files.el (executable-find): Move from executable.el. + Use locate-file. * progmodes/executable.el (executable-find): Move to files.el. * font-lock.el (font-lock-fontify-keywords-region): Use a marker @@ -28524,8 +28524,8 @@ * term/mac-win.el: Don't define or bind scroll bar functions if x-toolkit-scroll-bars is t. - (x-select-text, x-get-selection-value): Clear - x-last-selected-text-clipboard if x-select-enable-clipboard is + (x-select-text, x-get-selection-value): + Clear x-last-selected-text-clipboard if x-select-enable-clipboard is nil. (PRIMARY): Put mac-scrap-name property. (mac-select-convert-to-file-url): New function. @@ -30854,8 +30854,8 @@ Catch `dont-send' signal. (tramp-set-auto-save-file-modes): Set always permissions, because there might be an old auto-saved file belonging to another - original file. This could be a security threat. Reported by - Kjetil Kjernsmo <kjetil@kjernsmo.net>. + original file. This could be a security threat. + Reported by Kjetil Kjernsmo <kjetil@kjernsmo.net>. Check for Emacs 21.3.50 removed. * net/tramp-smb.el (all): Remove debug construct for @@ -31383,7 +31383,7 @@ 2005-03-07 Karl Chen <quarl@cs.berkeley.edu> - * align.el (align-rules-list): Added an alignment rule for CSS + * align.el (align-rules-list): Add an alignment rule for CSS declarations (applies to css-mode and html-mode buffers). 2005-03-07 Stefan Monnier <monnier@iro.umontreal.ca> @@ -32731,8 +32731,8 @@ * net/tramp-vc.el (tramp-vc-do-command, tramp-vc-do-command-new) (tramp-vc-simple-command): Call `tramp-handle-shell-command' but - `shell-command', because it isn't magic in XEmacs. Reported by - Adrian Aichner <adrian@xemacs.org>. + `shell-command', because it isn't magic in XEmacs. + Reported by Adrian Aichner <adrian@xemacs.org>. * net/tramp-smb.el (tramp-smb-file-name-handler-alist): Add entry for `substitute-in-file-name'. diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14 index eca5a5735b2..a4f3f2fb87b 100644 --- a/lisp/ChangeLog.14 +++ b/lisp/ChangeLog.14 @@ -5178,7 +5178,7 @@ * kmacro.el (kmacro-insert-counter): Doc fix. -2008-11-21 Ivan Shmakov <oneingray@gmail.com> (tiny change) +2008-11-21 Ivan Shmakov <oneingray@gmail.com> * progmodes/tcl.el (tcl-filter): Don't forcibly move point. diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15 index 6c60ebe63ca..9adac3ccb0c 100644 --- a/lisp/ChangeLog.15 +++ b/lisp/ChangeLog.15 @@ -8502,7 +8502,7 @@ * tutorial.el (help-with-tutorial): Hack safe file-local variables after reading the tutorial. -2010-08-06 Alan Mackenzie <bug-cc-mode@gnu.org> +2010-08-06 Alan Mackenzie <acm@muc.de> * progmodes/cc-cmds.el (c-mask-paragraph, c-fill-paragraph): Fix for the case that a C style comment has its delimiters alone on @@ -8844,9 +8844,9 @@ (sql-mode-menu): Add submenu to select connections. (sql-interactive-mode-menu): Add "Save Connection" item. (sql-add-product): Fix menu item. - (sql-get-product-feature): Improved error handling. + (sql-get-product-feature): Improve error handling. (sql--alt-buffer-part, sql--alt-if-not-empty): Remove. - (sql-make-alternate-buffer-name): Simplified. + (sql-make-alternate-buffer-name): Simplify. (sql-product-interactive): Handle missing product. (sql-connect): Support string keys, minor improvements. (sql-save-connection): New function. @@ -8908,7 +8908,7 @@ (sql-connection-alist): New variable. (sql-connect): New function. (sql--alt-buffer-part, sql--alt-if-not-empty) - (sql-make-alternate-buffer-name): Improved alternative buffer name. + (sql-make-alternate-buffer-name): Improve alternative buffer name. 2010-07-17 Thierry Volpiatto <thierry.volpiatto@gmail.com> @@ -9383,7 +9383,7 @@ `compose-mail-user-agent-warnings', instead of to the nonexistent `compose-mail-check-user-agent'. -2010-06-21 Alan Mackenzie <bug-cc-mode@gnu.org> +2010-06-21 Alan Mackenzie <acm@muc.de> Fix an indentation bug: @@ -9392,7 +9392,7 @@ of existing values. * progmodes/cc-engine.el (c-clear-<-pair-props-if-match-after) - (c-clear->-pair-props-if-match-before): now return t when they've + (c-clear->-pair-props-if-match-before): Now return t when they've cleared properties, nil otherwise. (c-before-change-check-<>-operators): Set c-new-beg/end correctly by taking account of the existing value. diff --git a/lisp/ChangeLog.16 b/lisp/ChangeLog.16 index 8f57360a0f6..14ee914179e 100644 --- a/lisp/ChangeLog.16 +++ b/lisp/ChangeLog.16 @@ -5052,7 +5052,7 @@ (w32-handle-dropped-file): Convert incoming dropped files from Windows paths to Cygwin ones before passing them on to the rest of Emacs. - (w32-drag-n-drop): New paramter new-frame. Simplify logic. + (w32-drag-n-drop): New parameter new-frame. Simplify logic. (w32-initialize-window-system): Assert we're not initialized twice. * term/x-win.el: Require cl-lib; add ourselves to display-format-alist. @@ -7534,7 +7534,7 @@ In doc-strings state whether the argument window has to denote a live, valid or any window. -2012-08-16 Phil Sainty <psainty@orcon.net.nz> (tiny change) +2012-08-16 Phil Sainty <psainty@orcon.net.nz> * progmodes/subword.el (subword-forward-function) (subword-backward-function, subword-forward-regexp) @@ -17100,7 +17100,7 @@ * vc/ediff-init.el (ediff-toggle-read-only-function): Use toggle-read-only. -2011-10-22 Alan Mackenzie <bug-cc-mode@gnu.org> +2011-10-22 Alan Mackenzie <acm@muc.de> Fix bug #9560, sporadic wrong indentation; improve instrumentation of c-parse-state. diff --git a/lisp/ChangeLog.3 b/lisp/ChangeLog.3 index 54ac0151c71..d8077e1fcd1 100644 --- a/lisp/ChangeLog.3 +++ b/lisp/ChangeLog.3 @@ -26,7 +26,7 @@ (find-file-read-only-other-window): Likewise. (find-file-read-only-other-frame): Likewise. - * timer.el (cancel-function-timers): Renamed from spurious duplicate + * timer.el (cancel-function-timers): Rename from spurious duplicate definition of cancel-timer. * add-log.el (find-change-log): Use file-chase-links. @@ -82,7 +82,7 @@ * paths.el (Info-default-directory-list): Take out ../../info. Avoid duplication. - (manual-formatted-dirlist, manual-formatted-dir-prefix): Deleted. + (manual-formatted-dirlist, manual-formatted-dir-prefix): Delete. * subr.el (baud-rate): Doc fix. @@ -137,7 +137,7 @@ Delete the "local thinking machines" definitions at the end since they caused compilation failure. - * cl.el (cl-member): Renamed from member. + * cl.el (cl-member): Rename from member. * time.el (display-time-day-and-date): Use defvar, not defconst. @@ -163,7 +163,7 @@ (timezone-make-date-sortable): Make autoload for this. (rmail-sort-by-recipient): Downcase the strings for sorting. (rmail-sort-by-recipient): Likewise. - (rmail-sort-by-lines): Renamed from rmail-sort-by-size-lines. + (rmail-sort-by-lines): Rename from rmail-sort-by-size-lines. Use numbers to sort by. (rmail-summary-...): New functions. Bind in rmail-summary-mode-map. (rmail-sort-from-summary): New function. @@ -172,10 +172,10 @@ Choose string< or < as predicate. Reorder messages by exchanging them, with inhibit-quit bound. (rmail-fetch-field): Start by widening. - (rmail-sortable-date-string): Deleted. + (rmail-sortable-date-string): Delete. (rmail-make-date-sortable): New function, used instead. - * paths.el (gnus-local-organization): Renamed from ...-your-... + * paths.el (gnus-local-organization): Rename from ...-your-... (gnus-local-domain): Likewise. 1993-05-26 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) @@ -185,8 +185,8 @@ (set-face-font): Only use x-resolve-font-name if FONT is a string. Copying a faces shouldn't resolve the font. - * paths.el (Info-default-directory-list): Add - configure-info-directory to this list. + * paths.el (Info-default-directory-list): + Add configure-info-directory to this list. 1993-05-26 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -247,15 +247,15 @@ 1993-05-25 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - * term/x-win.el (command-switch-alist, x-switch-definitions): Treat - `-i' like `-itype', as in Emacs 18. + * term/x-win.el (command-switch-alist, x-switch-definitions): + Treat `-i' like `-itype', as in Emacs 18. 1993-05-25 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * Version 19.8 released. - * startup.el (command-line-1): Don't handle `-i'. We're - abandoning the `insert file' meaning in favor of the `use a + * startup.el (command-line-1): Don't handle `-i'. + We're abandoning the `insert file' meaning in favor of the `use a bitmapped icon' meaning. * faces.el (set-face-font): Call x-resolve-font-name on the font @@ -265,8 +265,8 @@ * iso-syntax.el: Make downcase into a proper case table before passing it to set-standard-case-table. - * disp-table.el (standard-display-european): Doc fix. Make - it autoload. Make it respond to prefix arg like a minor mode. + * disp-table.el (standard-display-european): Doc fix. + Make it autoload. Make it respond to prefix arg like a minor mode. 1993-05-24 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -360,8 +360,8 @@ 1993-05-22 Jim Blandy (jimb@geech.gnu.ai.mit.edu) - * cl.el (cl-floor, cl-ceiling, cl-truncate, cl-round): Renamed - from floor, ceiling, truncate, and round; the old names conflict + * cl.el (cl-floor, cl-ceiling, cl-truncate, cl-round): + Rename from floor, ceiling, truncate, and round; the old names conflict with built-in functions. 1993-05-22 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -524,7 +524,7 @@ 1993-05-16 Richard Stallman (rms@mole.gnu.ai.mit.edu) - * texinfo.el (texinfo-chapter-level-regexp): Copied here. + * texinfo.el (texinfo-chapter-level-regexp): Copy here. 1993-05-17 Roland McGrath (roland@geech.gnu.ai.mit.edu) @@ -536,7 +536,7 @@ * gnus.el, gnuspost.el, gnusmail.el, gnusmisc.el, * nntp.el, nnspool.el, mhspool.el: Version 3.15 from Umeda. - * frame.el (toggle-scroll-bar): Renamed from toggle-vertical-scroll... + * frame.el (toggle-scroll-bar): Rename from toggle-vertical-scroll... 1993-05-16 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -623,14 +623,14 @@ * menu-bar.el (menu-bar-mode): New command. Use for initialization. * faces.el (make-face): Add interactive spec. - (set-default-font): Deleted. + (set-default-font): Delete. * isearch.el (isearch-mode-map): Handle any length vector in keymap. (isearch-char-to-string): Handle non-character events properly. 1993-05-14 Jim Blandy (jimb@geech.gnu.ai.mit.edu) - * subr.el (overlay-start, overlay-end, overlay-buffer): Removed. + * subr.el (overlay-start, overlay-end, overlay-buffer): Remove. * vc.el (vc-version-diff): Match parens. @@ -643,26 +643,26 @@ * emerge.el: Installed version 5 from drw. Merged in previous FSF changes, plus new changes: - (emerge-count-matches-string): Renamed from count-matches-string. + (emerge-count-matches-string): Rename from count-matches-string. (emerge-command-prefix): Now C-c C-c. - (emerge-shadow-key-definition): Deleted. + (emerge-shadow-key-definition): Delete. Callers use substitute-key-definition. - (emerge-recursively-substitute-key-definition): Deleted. + (emerge-recursively-substitute-key-definition): Delete. Callers use substitute-key-definition. - (emerge-unselect-hook): Renamed from emerge-unselect-hooks. + (emerge-unselect-hook): Rename from emerge-unselect-hooks. (emerge-files-internal): Use file-local-copy to handle remote files. (emerge-files-with-ancestor-internal): Likewise. - (emerge-remote-file-p): Deleted. + (emerge-remote-file-p): Delete. (emerge-abort): New command. - (describe-mode): Deleted. - (emerge-hash-string-into-string): Renamed from hash-string-into-string. - (emerge-unslashify-name): Renamed from unslashify-name. + (describe-mode): Delete. + (emerge-hash-string-into-string): Rename from hash-string-into-string. + (emerge-unslashify-name): Rename from unslashify-name. (emerge-write-and-delete): Don't write-file if file-out is nil. (emerge-setup-fixed-keymaps): Put emerge-abort on C-]. - (emerge-find-difference-diff): Renamed from emerge-find-difference. + (emerge-find-difference-diff): Rename from emerge-find-difference. (emerge-find-difference): New command. Now on `.'. - (emerge-diff-ok-lines-regexp): Renamed from emerge-diff-ok-lines. - (emerge-diff3-ok-lines-regexp): Renamed from emerge-diff3-ok-lines. + (emerge-diff-ok-lines-regexp): Rename from emerge-diff-ok-lines. + (emerge-diff3-ok-lines-regexp): Rename from emerge-diff3-ok-lines. 1993-05-13 Paul Eggert (eggert@twinsun.com) @@ -877,9 +877,9 @@ * comint.el (comint-previous-matching-input): New command, on M-r. (comint-next-matching-input): New command, on M-s. - (comint-previous-similar-input): Commented out. + (comint-previous-similar-input): Comment out. (comint-next-similar-input): Likewise. - (comint-previous-input-matching): Deleted. + (comint-previous-input-matching): Delete. (comint-last-input-match): Var commented out. (comint-mode): Don't make comint-last-input-match local. @@ -911,8 +911,8 @@ * help.el (help-for-help): Use lower case letters for help options. - * rect.el (string-rectangle): Renamed from fill-rectangle. - (string-rectangle-line): Renamed from fill-rectangle-line. + * rect.el (string-rectangle): Rename from fill-rectangle. + (string-rectangle-line): Rename from fill-rectangle-line. 1993-05-01 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -944,8 +944,8 @@ FORCE argument non-nil, so that we don't get an error if the mark isn't set yet. - * edebug.el (global-edebug-prefix, global-edebug-map): Add - autoload cookies for these, so they are present when Emacs starts + * edebug.el (global-edebug-prefix, global-edebug-map): + Add autoload cookies for these, so they are present when Emacs starts up. * edebug.el (global-edebug-map): Bind `C-x X d' to edebug-defun in @@ -957,7 +957,7 @@ * complete.el: New file. - * vc.el (vc-match-substring): Renamed from match-substring. + * vc.el (vc-match-substring): Rename from match-substring. (vc-parse-buffer): Use new name. * shell.el (shell-prompt-pattern): Undo last change. @@ -965,7 +965,7 @@ * files.el (file-truename): Redo esr's change. * loaddefs.el: Put arrow key bindings back to the ordinary Emacs cmds. - * simple.el (up-arrow, down-arrow, left-arrow, right-arrow): Deleted. + * simple.el (up-arrow, down-arrow, left-arrow, right-arrow): Delete. * simple.el (kill-line, next-line-add-newlines): Doc fix. (kill-whole-line): Doc fix. @@ -1089,42 +1089,42 @@ * gud.el: Set no-byte-compile local variable t to work around a byte-compiler bug. - (gud-def, global-map): Move C-x C-a commands to global map. Restore - original C-x SPC global binding. + (gud-def, global-map): Move C-x C-a commands to global map. + Restore original C-x SPC global binding. * vc.el (vc-diff): Get proper error message when you run this with no prefix arg on an empty buffer. (vc-directory): Better directory format --- replace the user and group IDs with locking-user (if any). - (vc-finish-logentry, vc-next-comment, vc-previous-comment): Replace - *VC-comment-buffer* with a ring vector. + (vc-finish-logentry, vc-next-comment, vc-previous-comment): + Replace *VC-comment-buffer* with a ring vector. 1993-04-25 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) - * simple.el (down-arrow): New function. Uses - next-line-add-newlines to suppress addition of new lines at end of + * simple.el (down-arrow): New function. + Uses next-line-add-newlines to suppress addition of new lines at end of buffer. (up-arrow): Alias of previous-line, added for consistency. These changes complete terminal-type-independent support for arrow keys. - * tex-mode.el (tex-compilation-parse-errors): Added. At the + * tex-mode.el (tex-compilation-parse-errors): Add. At the moment, this would have to be applied manually. It's not worth trying to integrate this with the rest of the mode more tightly until we decide whether and how compile's interface is going to change away from a closed subsystem. - * files.el (cd): Changed to use to resolve relative cd calls. - (cd-absolute): Added. This is actually the old cd code with a + * files.el (cd): Change to use to resolve relative cd calls. + (cd-absolute): Add. This is actually the old cd code with a changed doc string. - (parse-colon-path): Added. Path-to-string exploder --- may be + (parse-colon-path): Add. Path-to-string exploder --- may be useful elsewhere. * ring.el: Added and fixed documentation. (ring-rotate): Nuked. It was (a) unused, and (b) totally broken (as in, any attempt to use it died with a type error, and when I patched it to fix that I found its algorithm was broken). - (ring-ref): Added doc string. + (ring-ref): Add doc string. 1993-04-25 Jim Blandy (jimb@totoro.cs.oberlin.edu) @@ -1144,7 +1144,7 @@ 1993-04-23 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) - * bytecomp.el (define-function): Changed name back to defaliases + * bytecomp.el (define-function): Change name back to defaliases to get things in a known-good state. The unload patch had been half-applied, leading to lossage. @@ -1158,7 +1158,7 @@ * telnet.el: Commentary added. (telnet): Doc fix. - (rsh): Added entry point for rsh to remote host, per suggestion by + (rsh): Add entry point for rsh to remote host, per suggestion by Michael McNamara <mac@ardent.com>. No change to any other code. * info.el (Info-find-node, Info-insert-subfile): Do the right @@ -1166,15 +1166,15 @@ saving me lots of disk space. * simple.el: All fsets changed to defaliases. - (kill-forward-chars, kill-backward-chars): Deleted. These were + (kill-forward-chars, kill-backward-chars): Delete. These were internal subroutines used by delete-char and delete-backward-char before those functions were moved into the C kernel. Now nothing uses them. - (kill-line): Added kill-whole-line variable. Defaults to nil; a + (kill-line): Add kill-whole-line variable. Defaults to nil; a non-nil value causes a kill-line at the beginning of a line to kill the newline as well as the line. I find it very convenient. Emulates Unipress' &kill-lines-magic variable. - (next-line): Added next-line-add-newlines variable. If nil, + (next-line): Add next-line-add-newlines variable. If nil, next-line will not insert newlines when invoked at the end of a buffer. This obviates three LCD packages. (left-arrow, right-arrow): New functions. These do backward-char @@ -1182,7 +1182,7 @@ left or right as necessary to make sure point is visible. * loaddefs.el: All fsets changes to defaliases. - (global-map): Changed bindings of [left] and [right] to left-arrow and + (global-map): Change bindings of [left] and [right] to left-arrow and right-arrow respectively. 1993-04-22 Roland McGrath (roland@mole.gnu.ai.mit.edu) @@ -1240,7 +1240,7 @@ 1993-04-16 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) * electric.el (shrink-window-if-larger-than-buffer): - Moved to window.el. + Move to window.el. 1993-04-16 Jim Blandy (jimb@totoro.cs.oberlin.edu) @@ -1267,12 +1267,12 @@ 1993-04-14 Richard Stallman (rms@mole.gnu.ai.mit.edu) - * resume.el (resume-suspend-hook): Renamed from empty-args-file. + * resume.el (resume-suspend-hook): Rename from empty-args-file. Add autoload cookie. - (resume-emacs-args-buffer): Renamed. - (resume-write-buffer-to-file): Renamed. + (resume-emacs-args-buffer): Rename. + (resume-write-buffer-to-file): Rename. - * two-column.el (tc-dissociate): Renamed from tc-kill-association. + * two-column.el (tc-dissociate): Rename from tc-kill-association. Move binding to C-x 6 d. 1993-04-14 Roland McGrath (roland@churchy.gnu.ai.mit.edu) @@ -1291,7 +1291,7 @@ * gud.el (gud-mode): Created C-c synonym bindings in the GUD buffer's local map. - (gud-key-prefix): Changed to C-x C-a. + (gud-key-prefix): Change to C-x C-a. 1993-04-14 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) @@ -1307,11 +1307,11 @@ ability to browse package commentary sections and a completely point-and-shoot interface similar to Dired's. - * window.el (shrink-window-if-larger-than-buffer): Moved from + * window.el (shrink-window-if-larger-than-buffer): Move from electric.el to windows.el, minor bug fix. This is to avoid code duplication between vc.el, electric.el, and finder.el. - (ctl-x-map): Added C-x - and C-x + as experimental bindings for + (ctl-x-map): Add C-x - and C-x + as experimental bindings for shrink-window-if-larger-than-buffer and balance-windows respectively. Since shrink-window-if-larger-than-buffer has to live here anyhow, let users use it to manage screen space. @@ -1354,7 +1354,7 @@ 1993-04-10 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) - * gud.el (gdb, sdb, dbx): Improved prompting a la grep. + * gud.el (gdb, sdb, dbx): Improve prompting a la grep. * comint.el: Clean up cmu* uses in header comments. @@ -1380,8 +1380,8 @@ 1993-04-09 Jim Blandy (jimb@totoro.cs.oberlin.edu) - * subr.el (overlay-start, overlay-end, overlay-buffer): New - defsubsts. + * subr.el (overlay-start, overlay-end, overlay-buffer): + New defsubsts. * finder.el (finder-by-keyword): Build an alist to pass to completing-read, instead of building an invalid obarray. @@ -1443,7 +1443,7 @@ (compile-internal): Make it the process's filter. * compile.el (compilation-error-regexp-alist): - Fixed MIPS CC regexp to match file + Fix MIPS CC regexp to match file names longer than one char. (compilation-parse-errors): Error if compilation-error-regexp-alist is nil. @@ -1473,7 +1473,7 @@ * compile.el (compilation-filter): New function. (compile-internal): Make it the process's filter. - * compile.el (compilation-error-regexp-alist): Fixed MIPS CC + * compile.el (compilation-error-regexp-alist): Fix MIPS CC regexp to match file names longer than one char. (compilation-parse-errors): Error if compilation-error-regexp-alist is nil. @@ -1492,7 +1492,7 @@ (add-change-log-entry): FILE-NAME frobnicating code moved there; call it. * vc.el (vc-comment-to-change-log): - Renamed from vc-comment-to-changelog. + Rename from vc-comment-to-changelog. Take optional arg and pass it to find-change-log. Added docstring and interactive spec. @@ -1505,7 +1505,7 @@ Apollo cc regexp: make "s optional, and don't anchor to bol. * compile.el (compilation-error-regexp-alist): - Changed MIPS RISC CC regexp (last one) to + Change MIPS RISC CC regexp (last one) to be anchored at bol, and to never match multiple lines. 1993-04-03 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) @@ -1528,7 +1528,7 @@ * mpuz.el (mpuz-try-letter): Use read-char to read digit. Use message directly also. Use downcase. - (mpuz-read-map): Deleted. + (mpuz-read-map): Delete. * dired.el (dired-unmark-all-files): Read the arg as just a char. @@ -1614,7 +1614,7 @@ 1993-03-29 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) * vc.el (vc-next-action, vc-print-log, vc-diff, vc-revert-buffer): - Improved logic for parent buffer finding. + Improve logic for parent buffer finding. (vc-cancel-version): Bug fix. @@ -1627,7 +1627,7 @@ * fill.el (fill-individual-paragraphs): When skipping mail headers, skip to a blank line. - * env.el (setenv): Renamed back from putenv. + * env.el (setenv): Rename back from putenv. * replace.el (regexp-history): New history list. (occur, flush-lines, keep-lines, how-many): Use it. @@ -1638,7 +1638,7 @@ 1993-03-28 Noah Friedman (friedman@splode.com) * setenv.el: Renamed to env.el. Provide `env', not `setenv'. - (setenv): Renamed to `putenv', which is the more proper complement + (setenv): Rename to `putenv', which is the more proper complement of `getenv'. `setenv' retained as an alias. Make VALUE parameter optional; if not set, remove VARIABLE from process-environment. @@ -1664,10 +1664,10 @@ * makefile.el: Added autoload cookie for entry point. - * files.el (auto-mode-alist): Added pairs for .ms, .man, .mk, + * files.el (auto-mode-alist): Add pairs for .ms, .man, .mk, [Mm]akefile, .lex. - * electric.el (shrink-window-if-larger-than-buffer): Added doc + * electric.el (shrink-window-if-larger-than-buffer): Add doc string. Made argument optional, because window-buffer does the right thing with nil. @@ -1691,8 +1691,8 @@ * rlogin.el: Updated copyright year and added autoload cookies. (rlogin): Set process marker to beginning of buffer. - (rlogin-filter): Use unwind-protect to restore match-data. Use - insert-before-markers instead of insert to keep input and output + (rlogin-filter): Use unwind-protect to restore match-data. + Use insert-before-markers instead of insert to keep input and output from getting garbled. Delete spurious ?\C-m chars in output instead of replacing them with ?\ . @@ -1710,26 +1710,26 @@ 1993-03-27 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) - * lpr.el (printify-buffer): Added, debugged from Roland McGrath's + * lpr.el (printify-buffer): Add, debugged from Roland McGrath's printify-buffer code in LCD. - * cookie.el (cookie): Enhanced it to handle both LINS files and + * cookie.el (cookie): Enhance it to handle both LINS files and UNIX fortune files. - * rect.el (fill-rectangle): Added. Inspired by Lynn Slater's + * rect.el (fill-rectangle): Add. Inspired by Lynn Slater's insert-box package in LCD, but the interface and implementation are different. - * loaddefs.el (ctl-x-map): Added binding for fill-rectangle. + * loaddefs.el (ctl-x-map): Add binding for fill-rectangle. - * buff-menu.el (Buffer-menu-toggle-read-only): Added, per Rob + * buff-menu.el (Buffer-menu-toggle-read-only): Add, per Rob Austein's suggestion in the LCD package bm-toggle.el. - * subr.el (add-hook): Added optional arg to cause hook to be + * subr.el (add-hook): Add optional arg to cause hook to be appended rather than prepended to the hook list. This obviates the 23 different hook-bashing packages in LCD. - * subr.el (current-word): Added. Lots of help and default-generator + * subr.el (current-word): Add. Lots of help and default-generator functions in LCD use it, and it's remarkably difficult to get right, especially given the new syntax primitives. @@ -1741,8 +1741,8 @@ 1993-03-26 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) - * yow.el (psychoanalyze-pinhead): Needed a prefrontal lobotomy. I - gave it one. + * yow.el (psychoanalyze-pinhead): Needed a prefrontal lobotomy. + I gave it one. * two-column.el: Added Commentary. @@ -1754,13 +1754,13 @@ 1993-03-25 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) - * lisp-mnt.el (lm-last-modified-date): Fixed return bug. + * lisp-mnt.el (lm-last-modified-date): Fix return bug. (lm-author, lm-maintainer): These now return cons pairs, not strings. * shell.el: Brent Benson's patch to support `cd -'. - * mh-e.el (mh-unshar): Added. + * mh-e.el (mh-unshar): Add. * emacsbug.el: Added a (provide 'emacsbug); lisp-mnt.el needs this. @@ -1873,8 +1873,8 @@ * time.el (display-time): Doc fix. - * isearch.el (isearch-switch-frame-handler): Call - handle-switch-frame instead of select-frame; it has been renamed. + * isearch.el (isearch-switch-frame-handler): + Call handle-switch-frame instead of select-frame; it has been renamed. * simple.el (comment-indent-function): New variable, intended to replace comment-indent-hook. @@ -1930,7 +1930,7 @@ 1993-03-18 Richard Stallman (rms@geech.gnu.ai.mit.edu) - * frame.el (make-frame): Renamed from new-frame. + * frame.el (make-frame): Rename from new-frame. (new-frame): Alias for make-frame. 1993-03-18 Edward M. Reingold (reingold@emr.cs.uiuc.edu) @@ -2048,8 +2048,8 @@ 1993-03-14 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - * sort.el (sort-float-fields, sort-numeric-fields): Use - string-to-number, not string-to-float or string-to-int. + * sort.el (sort-float-fields, sort-numeric-fields): + Use string-to-number, not string-to-float or string-to-int. * sort.el (sort-float-fields): Make this autoloaded. @@ -2080,7 +2080,7 @@ 1993-03-12 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) - * loaddefs.el (global-map): Fixed a typo in the binding of + * loaddefs.el (global-map): Fix a typo in the binding of [kp-backtab]. * term/x-win.el: Added library headers back in. Didn't touch @@ -2122,8 +2122,8 @@ and featureful interface across many different keyboard types. * loaddefs.el (global-map): Natural default keybindings set up for - almost all supported keysyms other than function keys. All - other keysyms are now default-bound to a function which explains + almost all supported keysyms other than function keys. + All other keysyms are now default-bound to a function which explains that the key is not bound to anything, then raises an error. * term/README: Terminal package conventions and standard keysym @@ -2144,8 +2144,8 @@ * term/news.el: Cleaned up, headers added. - * term/sun.el: Headers added, [again] changed to [redo]. This - package is a hairball and should probably be scrapped if we + * term/sun.el: Headers added, [again] changed to [redo]. + This package is a hairball and should probably be scrapped if we can find or built a better one. * term/tvi970.el: Headers added, [enter] changed to [kp-enter]. @@ -2170,7 +2170,7 @@ * help.el: Added binding and menu line for new `P' package-finder command. Won't actually take effect till the next Emacs build. - * vc.el (vc-backend-checkin): Fixed bizarre POM-dependent bug + * vc.el (vc-backend-checkin): Fix bizarre POM-dependent bug introduced into VC by a bad patch. This was one for the books....badly corrupted vc-checkin code somehow mostly functioned for three days. The Code That Would Not Die... @@ -2252,7 +2252,7 @@ 1993-03-08 Richard Stallman (rms@mole.gnu.ai.mit.edu) * subr.el (posn-timestamp, posn-col-row, posn-point, posn-window) - (event-end, event-start, mouse-movement-p): Moved from mouse.el. + (event-end, event-start, mouse-movement-p): Move from mouse.el. * mouse.el: Functions moved to subr.el. 1993-03-07 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -2363,7 +2363,7 @@ 1993-03-05 Richard Stallman (rms@mole.gnu.ai.mit.edu) * disp-table.el: Add autoload comments. - (rope-to-vector): Deleted. + (rope-to-vector): Delete. (describe-display-table): Don't use rope-to-vector. * compare-w.el (compare-windows): Use compare-buffer-substrings. @@ -2424,7 +2424,7 @@ (rmail-undelete-previous-message, rmail-delete-forward) (rmail-get-new-mail, rmail-show-message): Update summary buffer if any. Call rmail-maybe-display-summary to put it back on screen. - (rmail-only-expunge): Renamed from rmail-expunge. + (rmail-only-expunge): Rename from rmail-expunge. (rmail-expunge): New function. (rmail-message-recipients-p, rmail-message-regexp-p): New functions. (rmail-summary-exists, rmail-summary-displayed): New functions. @@ -2470,7 +2470,7 @@ 1993-03-01 Richard Stallman (rms@mole.gnu.ai.mit.edu) * frame.el: Doc fixes. - (set-pointer-color): Renamed to set-mouse-color. + (set-pointer-color): Rename to set-mouse-color. (set-border-color): New function. * info.el (Info-insert-dir): Make menu items in Top node @@ -2510,8 +2510,8 @@ 1993-02-26 Richard Stallman (rms@mole.gnu.ai.mit.edu) - * frame.el (auto-raise-mode): Renamed from toggle-auto-raise. - (auto-lower-mode): Renamed from toggle-auto-lower. + * frame.el (auto-raise-mode): Rename from toggle-auto-raise. + (auto-lower-mode): Rename from toggle-auto-lower. 1993-02-26 Jim Blandy (jimb@totoro.cs.oberlin.edu) @@ -2550,8 +2550,8 @@ * gud.el (gud-break): With a prefix argument, set a temporary breakpoint. - (gud-apply-from-source): New argument ARGS, to pass to FUNC. Now - it's really like `apply'. + (gud-apply-from-source): New argument ARGS, to pass to FUNC. + Now it's really like `apply'. (gud-set-break): Add another argument to this method. Document it in the section describing how the methods are supposed to be used. @@ -2614,11 +2614,11 @@ * frame.el (frame-initialize): Fix error syntax. (toggle-horizontal-scroll-bar): Likewise. - (toggle-horizontal-scroll-bar): Renamed from set-horizontal-bar. + (toggle-horizontal-scroll-bar): Rename from set-horizontal-bar. (toggle-vertical-scroll-bar): Likewise. (toggle-auto-lower, toggle-auto-raise): Likewise. (set-foreground-color, set-background-color): - Renamed from set-frame-{fore,back}ground. + Rename from set-frame-{fore,back}ground. 1993-02-15 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) @@ -2674,7 +2674,7 @@ 1993-02-11 Richard Stallman (rms@mole.gnu.ai.mit.edu) - * flow-ctrl.el (enable-flow-control...): Renamed from evade... + * flow-ctrl.el (enable-flow-control...): Rename from evade... (enable-flow-control): Add autoload. 1993-02-10 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -2691,7 +2691,7 @@ * fortran.el (fortran-prepare-abbrev-list-buffer): Put quote in front of first argument to `insert-abbrev-table-description'. - * fortran.el (fortran-is-in-string-p): Fixed incorrect behavior + * fortran.el (fortran-is-in-string-p): Fix incorrect behavior when in first statement of a buffer. 1993-02-08 Roland McGrath (roland@geech.gnu.ai.mit.edu) @@ -2737,7 +2737,7 @@ 1993-02-05 Roland McGrath (roland@geech.gnu.ai.mit.edu) - * comint.el (make-comint): Added docstring. + * comint.el (make-comint): Add docstring. 1993-02-05 Roland McGrath (roland@geech.gnu.ai.mit.edu) @@ -2766,7 +2766,7 @@ 1993-01-31 Roland McGrath (roland@geech.gnu.ai.mit.edu) * mailabbrev.el (mail-abbrev-end-of-buffer): - Changed interactive spec from "P" to "p". + Change interactive spec from "P" to "p". 1993-01-29 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -2789,7 +2789,7 @@ x-own-selection has been renamed to x-set-selection, and the order of its arguments has been reversed, for consistency with other lisp functions like put and aset. - * term/x-win.el (x-select-text): Adjusted. + * term/x-win.el (x-select-text): Adjust. (x-cut-buffer-or-selection-value): Check the primary selection, using x-selection, instead of checking the cut buffer again. @@ -2804,7 +2804,7 @@ x-own-selection has been renamed to x-set-selection, and the order of its arguments has been reversed, for consistency with other lisp functions like put and aset. - * term/x-win.el (x-select-text): Adjusted. + * term/x-win.el (x-select-text): Adjust. (x-cut-buffer-or-selection-value): Check the primary selection, using x-selection, instead of checking the cut buffer again. @@ -3070,13 +3070,13 @@ * etags.el: Many comments added and docstrings fixed. (tags-table-list): Elt of nil is not special. (tags-expand-table-name): Value of nil is not special. - (tags-next-table): Removed arg RESET; no caller used it. + (tags-next-table): Remove arg RESET; no caller used it. (visit-tags-table-buffer): Don't need to do tags-expand-table-name in or form. When table is invalid, only set tags-file-name to nil globally if its global value contained the losing table file name. (find-tag-tag): Return a string, not a list. (find-tag-noselect, find-tag, find-tag-other-window) - (find-tag-other-frame): Changed callers. + (find-tag-other-frame): Change callers. (etags-recognize-tags-table): Call etags-verify-tags-table, rather than duplicating its functionality. (visit-tags-table-buffer): When CONT is 'same, set it to nil after the @@ -3153,7 +3153,7 @@ 1992-12-09 Roland McGrath (roland@wookumz.gnu.ai.mit.edu) - * info.el (Info-{first,second,third,fourth,fifth}-menu-item): Removed. + * info.el (Info-{first,second,third,fourth,fifth}-menu-item): Remove. (Info-nth-menu-item): New function; bound to 1..9. 1992-12-08 Jim Blandy (jimb@totoro.cs.oberlin.edu) @@ -3167,8 +3167,8 @@ Just that. * ls-lisp.el (insert-directory): Just that. - * ange-ftp.el (ange-ftp-unhandled-file-name-directory): New - function. Set ange-ftp's `unhandled-file-name-property' to its + * ange-ftp.el (ange-ftp-unhandled-file-name-directory): + New function. Set ange-ftp's `unhandled-file-name-property' to its name. 1992-12-07 Jim Blandy (jimb@totoro.cs.oberlin.edu) @@ -3238,7 +3238,7 @@ * paths.el (rmail-spool-directory): Add dgux-unix to the list of systems which put their mail in "/usr/mail". - * lpr.el (lpr-command, lpr-switches): Removed strings starting + * lpr.el (lpr-command, lpr-switches): Remove strings starting with \newline; this file is loaded in loaddefs.el, and doesn't need to follow that convention. @@ -3351,8 +3351,8 @@ * fortran.el: Version 1.28.7a. Cleaned up some doc strings. - (fortran-abbrev-help, fortran-prepare-abbrev-list-buffer): Use - `insert-abbrev-table-description' and make buffer in abbrevs-mode. + (fortran-abbrev-help, fortran-prepare-abbrev-list-buffer): + Use `insert-abbrev-table-description' and make buffer in abbrevs-mode. * fortran.el: Version 1.28.7. Many changes since version 1.28.3. Added auto-fill-mode, support @@ -3366,7 +3366,7 @@ New functions to implement auto fill. (fortran-indent-line, fortran-reindent-then-newline-and-indent): - Added auto fill support. + Add auto fill support. (find-comment-start-skip, is-in-fortran-string-p): New functions. @@ -3376,7 +3376,7 @@ (fortran-indent-to-column): Use find-comment-start-skip instead of searching for `comment-start-skip'. - (fortran-mode, calculate-fortran-indent): Added indentation + (fortran-mode, calculate-fortran-indent): Add indentation for fortran 90 statements. (fortran-next-statement, fortran-previous-statement): Bug fixes. @@ -3431,7 +3431,7 @@ 1992-10-31 Richard Stallman (rms@mole.gnu.ai.mit.edu) - * files.el (make-directory): Renamed from make-directory-path. + * files.el (make-directory): Rename from make-directory-path. Optional argument says whether to create parent dirs. Invoke file-name handler here. (after-find-file): Delete code that offers to create dir. @@ -3469,7 +3469,7 @@ * info.el: Rename buffer-flush-undo to buffer-disable-undo. (Info-goto-emacs-key-command-node): Fix typo. - (Info-menu-item-sequence): Commented out. + (Info-menu-item-sequence): Comment out. (Info-follow-nearest-node): Use new event format. Select the window clicked on. @@ -3561,9 +3561,9 @@ * mailabbrev.el: Delete version 18 compatibility stuff. (mail-abbrevs, build-mail-abbrevs, rebuild-mail-abbrevs) - (merge-mail-abbrevs): Renamed `mail-aliases' to `mail-abbrevs'. - (mail-abbrev-end-of-buffer): Renamed from abbrev-hacking-end-of-buffer. - (mail-abbrev-next-line): Renamed from abbrev-hacking-next-line. + (merge-mail-abbrevs): Rename `mail-aliases' to `mail-abbrevs'. + (mail-abbrev-end-of-buffer): Rename from abbrev-hacking-end-of-buffer. + (mail-abbrev-next-line): Rename from abbrev-hacking-next-line. * isearch-mode.el (isearch-mode-map): Use sparse keymaps. Start printing-char loop at SPC. @@ -3729,7 +3729,7 @@ 1992-10-05 Richard Stallman (rms@mole.gnu.ai.mit.edu) - * ls-lisp.el (insert-directory): Renamed from dired-ls. + * ls-lisp.el (insert-directory): Rename from dired-ls. All other functions renamed to start with ls-lisp. * ls-lisp.el: New file from Kremer. @@ -3748,7 +3748,7 @@ * mouse.el: Begin adapting this to the new event format. (event-window, event-point, mouse-coords, mouse-timestamp): - Removed. + Remove. (event-start, event-end, posn-window, posn-point, posn-col-row) (posn-timestamp): New accessors; these are defsubsts. (mouse-delete-window, mouse-delete-other-windows) @@ -3783,7 +3783,7 @@ 1992-09-30 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - * gud.el (gud-last-frame): Added defvar for this. + * gud.el (gud-last-frame): Add defvar for this. 1992-09-29 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -3814,8 +3814,8 @@ Use x-get-cut-buffer and x-set-cut-buffer, instead of expecting x-selection-value to manipulate the cut buffers. - * term/x-win.el (x-cut-buffer-or-selection-value): Treat - selections whose value is the empty string like unset selections. + * term/x-win.el (x-cut-buffer-or-selection-value): + Treat selections whose value is the empty string like unset selections. This allows us to truncate cut buffers to the empty string (if the text is too large, say) without causing interprogram-paste-function to wipe out the latest kill. @@ -3841,13 +3841,13 @@ latter doesn't exist. (gud-dbx-debugger-setup): Use the argument `f', not the variable `file', which happens to be bound in the caller. - (gud-filter-insert): The variable `start' is never used. The - variable `moving' is unnecessary. The variable `old-buffer' and + (gud-filter-insert): The variable `start' is never used. + The variable `moving' is unnecessary. The variable `old-buffer' and the unwind-protect form are unneeded, since save-excursion can do their work. The binding of output-after-point should be done after switching to the process's buffer, not in whatever random buffer - happens to be current when the process filter is called. There's - no need to set the process mark if we've just inserted at its + happens to be current when the process filter is called. + There's no need to set the process mark if we've just inserted at its location using insert-before-markers. (gud-read-address): Don't bother setting the variable `result'; it is never used. @@ -3920,8 +3920,8 @@ * two-column.el (tc-window-width, tc-separator, tc-other): Add permanent-local property. - (tc-two-columns): Renamed from tc-split. - (tc-split): Renamed from tc-unmerge. Put it on C-x 6 s. + (tc-two-columns): Rename from tc-split. + (tc-split): Rename from tc-unmerge. Put it on C-x 6 s. Use make-local-variable on tc-separator. * spook.el (spook): Make it autoload. @@ -3929,7 +3929,7 @@ * gomoku.el (gomoku): Make it autoload. * mpuz.el: Fix setup of mpuz-read-map not to depend on keymap format. - (mpuz): Renamed from mult-puzzle. Make it autoload. + (mpuz): Rename from mult-puzzle. Make it autoload. * setenv.el (setenv): Doc fix. Make it autoload. @@ -3969,9 +3969,9 @@ * texinfo.el (texinfo-mode): Capitalize the mode name string. - * mail-extr.el (mail-undo-backslash-quoting): Renamed from undo-... - (mail-safe-move-sexp): Renamed from safe-... - (mail-variant-method): Renamed from variant-method. + * mail-extr.el (mail-undo-backslash-quoting): Rename from undo-... + (mail-safe-move-sexp): Rename from safe-... + (mail-variant-method): Rename from variant-method. * tq.el: Doc fixes. Make tq-create autoload. @@ -3994,7 +3994,7 @@ * prompt.el: File deleted. - * find-dired.el (start-process-shell-command): Deleted. + * find-dired.el (start-process-shell-command): Delete. * diff.el (diff-switches): Default is now -c. (diff-parse-differences): Use line beg as location of message. @@ -4028,7 +4028,7 @@ (search-last-string, search-last-regexp): Vars deleted. (search-highlight): No longer a user option. - * subr.el (baud-rate): Defined. + * subr.el (baud-rate): Define. (substitute-key-definition): Understand today's keymap format. New arg OLDMAP. Operate recursively on prefix keys. @@ -4060,7 +4060,7 @@ 1992-09-16 Joseph Arceneaux (jla@churchy.gnu.ai.mit.edu) - * isearch-mode.el (isearch-ring-advance-edit): Added missing + * isearch-mode.el (isearch-ring-advance-edit): Add missing closing paren to end of this function. 1992-09-16 Roland McGrath (roland@geech.gnu.ai.mit.edu) @@ -4087,7 +4087,7 @@ * simple.el (previous-history-element): Doc fix. * isearch-mode.el (isearch-event-data-type): - Renamed from isearch-events-exist. + Rename from isearch-events-exist. (isearch-frames-exist): Set properly in Emacs 18. (isearch-mode): Use baud-rate as variable, not function. (isearch-abort): Use nil as 2nd arg to `signal'. @@ -4137,8 +4137,8 @@ Don't try using length of keymap. (isearch-update): Handle unread-command-char properly for Emacs 19. (isearch-switch-frame-handler): Use select-frame to switch frames. - (isearch-pre-command-hook): Commented out. - (search-upper-case): Renamed from search-caps-disable-folding. + (isearch-pre-command-hook): Comment out. + (search-upper-case): Rename from search-caps-disable-folding. 1992-09-14 Roland McGrath (roland@geech.gnu.ai.mit.edu) @@ -4240,7 +4240,7 @@ * dired-aux.el (dired-add-entry, dired-insert-subdir-doinsert): Use insert-directory. * dired.el (dired-readin-insert): Use insert-directory. - (dired-ls, dired-ls-program): Deleted. + (dired-ls, dired-ls-program): Delete. 1992-09-12 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -4264,7 +4264,7 @@ * term/x-win.el (scroll-bar-mode): New function (and variable too). - * dired.el (dired-next-subdir, dired-subdir-index): Moved here + * dired.el (dired-next-subdir, dired-subdir-index): Move here * dired-aux.el: From here. * dired.el (dired-build-subdir-alist): Don't print msg after each dir. Clarify final message. @@ -4296,7 +4296,7 @@ 1992-09-08 Joseph Arceneaux (jla@geech.gnu.ai.mit.edu) - * mailabbrev.el (sendmail-pre-abbrev-expand-hook): Changed the + * mailabbrev.el (sendmail-pre-abbrev-expand-hook): Change the structure of this function: don't check to call mail-resolve-all-aliases unless we are actually in a header field where an abbrev should be expanded. @@ -4345,7 +4345,7 @@ 1992-09-02 Jim Blandy (jimb@pogo.cs.oberlin.edu) - * c-mode.el (c-auto-newline): Added backslashed before quotes in + * c-mode.el (c-auto-newline): Add backslashed before quotes in docstring. 1992-09-01 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -4446,7 +4446,7 @@ (mail-signature-file): This, since this is the way all the other lisp packages do it, and it's how people always say they want it on the mailing lists. - (mail-setup, mail-signature): Adjusted accordingly. + (mail-setup, mail-signature): Adjust accordingly. (mail): Doc fix. 1992-08-17 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -4544,9 +4544,9 @@ * calendar.el (calendar-interval): Fix doc string. - * calendar.el (calendar): Changed use of prefix arg--now it causes + * calendar.el (calendar): Change use of prefix arg--now it causes prompting for the month and year. - (regenerate-calendar-window): Renamed generate-calendar-window. + (regenerate-calendar-window): Rename generate-calendar-window. Changed optional argument from an offset from the current month to a month, year pair. (redraw-calendar, calendar-current-month, scroll-calendar-left) @@ -4562,7 +4562,7 @@ 1992-08-08 Jim Blandy (jimb@pogo.cs.oberlin.edu) - * frame.el (set-screen-width, set-screen-height): Changed these + * frame.el (set-screen-width, set-screen-height): Change these from fset aliases to actual functions, since they aren't supposed to take a frame argument, while set-frame-{width,height} do. @@ -4595,8 +4595,8 @@ * appt.el (appt-issue-message, appt-message-warning-time) (appt-audible, appt-visible, appt-display-mode-line) - (appt-msg-window, appt-display-duration, appt-display-diary): Added - ;;;###autoload cookies for these variables, since they are options + (appt-msg-window, appt-display-duration, appt-display-diary): + Add ;;;###autoload cookies for these variables, since they are options for the user to set. * tex-mode.el (tex-shell-file-name, tex-directory, tex-offer-save) (tex-run-command, latex-run-command, latex-block-names) @@ -4610,29 +4610,29 @@ * add-log.el (add-log-current-defun): Use eq instead of = when one side might be nil. - * compile.el (compilation-mode-map): Change - compilation-previous/next-file bindings to M-{ and M-}. + * compile.el (compilation-mode-map): + Change compilation-previous/next-file bindings to M-{ and M-}. 1992-08-05 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) * cl.el (*cl-valid-named-list-accessors*, *cl-valid-nth-offsets*) - (byte-compile-named-accessors): Deleted. + (byte-compile-named-accessors): Delete. (first, second, ... tenth, rest): Define these with defsubst, to get the same effect. - (byte-compile-ca*d*r): Deleted. + (byte-compile-ca*d*r): Delete. (caar, cadr, ..., cddddr): Define these using defsubst. Installed changes from Zawinski-Furuseth 2.04 to 2.07: * byte-run.el (dont-compile): Doc fix. (make-obsolete-variable): New function. - * bytecomp.el (byte-compile-log-1): Added new optional argument, + * bytecomp.el (byte-compile-log-1): Add new optional argument, FILL; if it is non-nil, reformat the error message. (byte-compile-warn): Use that flag. (byte-recompile-directory): Offer to recompile subdirectories. If prefix argument is zero, create .elc files for those .el files which lack them, without asking. - (byte-compile-output-form, byte-compile-output-docform): Disable - print-gensym while writing the form. + (byte-compile-output-form, byte-compile-output-docform): + Disable print-gensym while writing the form. (byte-compile-form): Warn if t or nil are called as functions. (byte-compile-variable-ref): Check for, and warn about, obsolete variable uses. @@ -4649,7 +4649,7 @@ * inf-lisp.el (inferior-lisp-filter-regexp, inferior-lisp-program) (inferior-lisp-load-command, inferior-lisp-prompt) - (inferior-lisp-mode-hook, inferior-lisp): Added ;;;###autoload + (inferior-lisp-mode-hook, inferior-lisp): Add ;;;###autoload cookies for these. * bytecomp.el (byte-compile-warnings): When choosing the default @@ -4685,8 +4685,8 @@ * info.el (Info-mode): scroll-up, scroll-down now do the right thing for preorder browsing when the beginning/end of the node - is visible. RET now goes to the next preorder node. These - changes make sequential reading of info subtrees easier. + is visible. RET now goes to the next preorder node. + These changes make sequential reading of info subtrees easier. 1992-08-04 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) @@ -4698,7 +4698,7 @@ * vc.el (vc-next-action, vc-register, vc-diff, vc-insert-headers) (vc-directory, vc-create-snapshot, vc-retrieve-snapshot) (vc-print-log, vc-revert-buffer, vc-cancel-version) - (vc-update-change-log): Added the ;;;###autoload cookies to these + (vc-update-change-log): Add the ;;;###autoload cookies to these functions, since they get bound to keys in the global keymap. * loadup.el: Load vc-hooks.el. @@ -4773,7 +4773,7 @@ (medit-zap-define-to-mdl): Change `medit-save-defun' to `medit-save-define'. (medit-save-region, medit-save-buffer, medit-zap-define-to-mdl): - Changed `medit-go-to-mdl' to `medit-goto-mdl'. Did anyone ever + Change `medit-go-to-mdl' to `medit-goto-mdl'. Did anyone ever try this code? 1992-08-02 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -4805,13 +4805,13 @@ (dired-create-files, dired-handle-overwrite): Rename overwrite-confirmed to dired-overwrite-confirmed. (dired-do-kill-lines): Handle prefix arg as number of lines to kill. - (dired-kill-line-or-subdir): Deleted. + (dired-kill-line-or-subdir): Delete. 1992-08-01 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - * mailabbrev.el [from jwz] (mail-interactive-insert-alias): Do - mail-aliases-setup if necessary before completing for interactive. - (build-mail-aliases): Changed parsing regexp. + * mailabbrev.el [from jwz] (mail-interactive-insert-alias): + Do mail-aliases-setup if necessary before completing for interactive. + (build-mail-aliases): Change parsing regexp. * compile.el (compilation-parse-errors): Take 2nd arg FIND-AT-LEAST. If non-nil, stop after parsing that many new errors. @@ -4826,7 +4826,7 @@ * comint.el: ring-* functions deleted--get them from ring.el. - * ring.el (ring-mod): Renamed from comint-mod. + * ring.el (ring-mod): Rename from comint-mod. Provide `ring', not history'. (make-ring, ring-p): Add autoloads. * history.el: Link deleted. @@ -4846,7 +4846,7 @@ Use buffer-disable-undo instead of buffer-flush-undo; the latter is obsolete. - * lpr.el (print-region-new-buffer): Added arguments START and END; + * lpr.el (print-region-new-buffer): Add arguments START and END; this used to use dynamic scope, but it makes things less readable. (print-region-1): Always call this with two arguments, not sometimes two and sometimes none. @@ -4877,7 +4877,7 @@ * hideif.el (hif-endif-to-ifdef): Fix munged comment which was interfering with parsing. - * hexl.el (hexl-next-line): Fixed up malformed let binding. + * hexl.el (hexl-next-line): Fix up malformed let binding. * bytecomp.el (byte-compile-file): Catch errors that occur during compilation, and record them in the compilation log. This allows @@ -5042,10 +5042,10 @@ 1992-07-28 Richard Stallman (rms@mole.gnu.ai.mit.edu) - * files.el (backup-extract-version): Copied from Emacs 18. + * files.el (backup-extract-version): Copy from Emacs 18. (find-backup-file-name): Use that. - * dired-aux.el (dired-clean-directory): Moved here. + * dired-aux.el (dired-clean-directory): Move here. (dired-map-dired-file-lines, dired-collect-file-versions) (dired-trample-file-versions): Likewise. * dired.el: Moved from here. @@ -5070,7 +5070,7 @@ * compile.el (compile-goto-error): Doc fix. - * etags.el (find-tag): Fixed prompt. + * etags.el (find-tag): Fix prompt. (tag-exact-match-p): Rewritten (again). * startup.el (command-line): Load site-start here. @@ -5082,7 +5082,7 @@ * completion.el: Moved to external-lisp. - * diff.el (diff-rcs, diff-sccs): Deleted. + * diff.el (diff-rcs, diff-sccs): Delete. 1992-07-27 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) @@ -5127,9 +5127,9 @@ 1992-07-26 Richard Stallman (rms@mole.gnu.ai.mit.edu) * diff.el (diff-backup): New function. - (diff-last-backup-file): Renamed from dired-last-backup-file. + (diff-last-backup-file): Rename from dired-last-backup-file. * dired-aux.el (dired-backup-diff): Use diff-backup. - (dired-last-backup-file): Moved and renamed. + (dired-last-backup-file): Move and renamed. * dired.el, dired-aux.el (dired-diff, dired-backup-diff): Doc fixes. * help.el (command-apropos): Fix call to apropos for new arg. @@ -5185,9 +5185,9 @@ * replace.el (perform-replace): Fix typo: match-after => match-again. (map-query-replace-regexp): Delete duplicate definition. - * subr.el (defun-inline): Commented out. + * subr.el (defun-inline): Comment out. - * comint.el (comint-input-ring*): Renamed from input-ring*. + * comint.el (comint-input-ring*): Rename from input-ring*. (ring-remove, ring-rotate): Use setcar, not set-car. * co-isearch.el: input-ring* renamed to comint-input-ring*. @@ -5227,7 +5227,7 @@ 1992-07-22 Richard Stallman (rms@mole.gnu.ai.mit.edu) * emerge.el (emerge-startup-hook, emerge-quit-hook): - Renamed from ...-hooks. + Rename from ...-hooks. * dired.el (dired-display-file): New command, on C-o. @@ -5282,15 +5282,15 @@ * c-mode.el (c-backslash-region): New command. (c-append-backslash, c-delete-backslash): New functions. * c++-mode.el (c++-macroize-region, backslashify-current-line): - Deleted. - (c++-comment-region, c++-uncomment-region): Deleted. + Delete. + (c++-comment-region, c++-uncomment-region): Delete. comment-region works just fine. - (c++-beginning-of-defun, c++-end-defun, c++-indent-defun): Deleted. - (c++-point-bol): Renamed from point-bol. - (c++-within-string-p): Renamed from within-string-p. - (c++-count-char-in-string): Renamed from count-char-in-string. - (fill-c++-comment): Renamed from fill-C-comment. - (c++-insert-header): Deleted. + (c++-beginning-of-defun, c++-end-defun, c++-indent-defun): Delete. + (c++-point-bol): Rename from point-bol. + (c++-within-string-p): Rename from within-string-p. + (c++-count-char-in-string): Rename from count-char-in-string. + (fill-c++-comment): Rename from fill-C-comment. + (c++-insert-header): Delete. 1992-07-21 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) @@ -5329,7 +5329,7 @@ * simple.el (end-of-buffer): If buffer end is on screen, don't scroll. - * c-mode.el (set-c-style): Deleted the first version of this function. + * c-mode.el (set-c-style): Delete the first version of this function. It was badly written. Modified the remaining version by adding new argument GLOBAL and setting the parameters locally if GLOBAL is nil. @@ -5343,7 +5343,7 @@ 1992-07-21 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - * frame.el (get-frame): Renamed to get-other-frame; get-frame + * frame.el (get-frame): Rename to get-other-frame; get-frame sounds like a parallel to get-buffer or get-process. * c-mode.el (set-c-style): Remove the extraneous copy of this @@ -5352,7 +5352,7 @@ * c++-mode.el (within-string-p): Use `%', not `mod', as the name of the modulus function. - * frame.el (frame-height, frame-width): Fixed several confusions + * frame.el (frame-height, frame-width): Fix several confusions here. * blackbox.el: When building blackbox-mode-map, locally rebind all @@ -5384,7 +5384,7 @@ (visit-tags-file): If find-file-noselect changed the file name, propagate the change to tags-file-name and tags-table-list. - * startup.el (command-line): Fixed typo in comment. + * startup.el (command-line): Fix typo in comment. 1992-07-20 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) @@ -5406,7 +5406,7 @@ (frame-configuration-to-register): New function. * loaddefs.el: Put them on C-x r w, C-x r f. * window.el (window-config-to-register, register-to-window-config): - Deleted, along with keybindings C-x 6 and C-x 7. + Delete, along with keybindings C-x 6 and C-x 7. 1992-07-19 Edward M. Reingold (reingold@emr.cs.uiuc.edu) @@ -5431,7 +5431,7 @@ (calendar-mode-map): Put it on a key. (calendar-mode): Describe it. - * cal-french.el (diary-french-date): Moved from diary.el and fixed + * cal-french.el (diary-french-date): Move from diary.el and fixed accent. * diary.el: Move dairy-french-date to cal-french.el and autoload it. @@ -5469,7 +5469,7 @@ * files.el (auto-mode-alist): Recognize .texi. - * rmail.el (rmail-delete-forward): Removed the feature + * rmail.el (rmail-delete-forward): Remove the feature of moving back if there's nowhere to go forward. 1992-07-17 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) @@ -5519,12 +5519,12 @@ form so that it returns a list containing the filename and the prefix argument, not just the prefix argument by itself. - * bytecomp.el (byte-compile-file): Changed reference to + * bytecomp.el (byte-compile-file): Change reference to byte-compile-report-call-tree to use display-call-tree. * bytecomp.el (byte-recompile-directory, byte-compile-file) (batch-byte-compile, byte-compile, compile-defun) - (display-call-tree): Added autoload cookies for these functions. + (display-call-tree): Add autoload cookies for these functions. 1992-07-16 Roland McGrath (roland@churchy.gnu.ai.mit.edu) @@ -5533,7 +5533,7 @@ 1992-07-16 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - * byte-run.el (defsubst): Removed extra closing paren at the end + * byte-run.el (defsubst): Remove extra closing paren at the end of this function. 1992-07-16 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) @@ -5567,7 +5567,7 @@ * bytecomp.el: Deleted support for running compiler in Emacs 18. Spell "Emacs 18" properly. (byte-compile-version): FSF 2.1. - (byte-compiler-valid-options): Deleted. + (byte-compiler-valid-options): Delete. (byte-compile-single-version): Always return nil. (byte-compiler-version-cond): Always return the argument. @@ -5588,7 +5588,7 @@ * buff-menu.el, bg-mouse.el, appt.el, abbrevlist.el, term/x-win.el, * term/wyse50.el, term/vt200.el, term/vt100.el: All uses changed. * screen.el (screen-height, screen-width, set-screen-height) - (set-screen-width): Defined as aliases for frame-height, + (set-screen-width): Define as aliases for frame-height, frame-width, set-frame-height, and set-frame-width. (set-frame-height, set-frame-width): Functions deleted; they are defined in frame.c. @@ -5613,8 +5613,8 @@ * rmailsort.el: Change copyright to FSF; update permission notice. * byte-run.el: Delete compatibility definition of make-byte-code. - (byte-compiler-options): Commented out. - (proclaim-inline, proclaim-notinline): Commented out. + (byte-compiler-options): Comment out. + (proclaim-inline, proclaim-notinline): Comment out. * byte-opt.el: Change several doc strings to comments. They had the wrong format anyway. @@ -5623,22 +5623,22 @@ * disass.el: Require just bytecomp, not byte-opt. * bytecomp.el (emacs-lisp-file-regexp): - Renamed from elisp-source-file-re. All uses changed. + Rename from elisp-source-file-re. All uses changed. (byte-compile-dest-file): Don't use that var. - (compile-defun): Renamed from elisp-compile-defun. + (compile-defun): Rename from elisp-compile-defun. (byte-compile-report-ops): Define unconditionally. It's a bad idea to make function definitions of moderate size conditional on anything. - (byte-compile-and-load-file): Commented out. + (byte-compile-and-load-file): Comment out. (byte-compiler-valid-options): - Renamed from byte-compiler-legal-options. + Rename from byte-compiler-legal-options. (byte-compile-overwrite-file): Variable deleted. (byte-compile-file): Don't use that var. (byte-compile-compatibility): - Renamed from byte-compile-emacs18-compatibility. + Rename from byte-compile-emacs18-compatibility. (byte-compile-generate-emacs19-bytecodes): Variable deleted. Use byte-compile-compatibility instead. - (byte-compiler-options-handler): Deleted. + (byte-compiler-options-handler): Delete. (byte-compile-body-do-effect, byte-compile-form-do-effect): Use defsubst, not proclaim-inline. @@ -5694,7 +5694,7 @@ * disass.el: New version of the disassembler, to fit with the new compiler. - * mouse.el (mouse-select-buffer-line): Removed extraneous setting + * mouse.el (mouse-select-buffer-line): Remove extraneous setting of the variable `the-buffer'; it's never used elsewhere. * mouse.el (mouse-kill): Don't set the mark; pass point and the @@ -5702,7 +5702,7 @@ 1992-07-09 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - * abbrev.el (write-abbrev-file): Removed extraneous interactive spec. + * abbrev.el (write-abbrev-file): Remove extraneous interactive spec. * screen.el (current-screen-configuration, set-screen-configuration): New functions. @@ -5713,8 +5713,8 @@ instead of `deiconify-screen'; the latter no longer exists. * files.el (find-backup-file-name): Replace the reference to - `backup-extract-version' with a literal `function' form. This - eliminates the use of dynamic binding, and allows us to remove + `backup-extract-version' with a literal `function' form. + This eliminates the use of dynamic binding, and allows us to remove backup-extract-version, which doesn't really want to be its own function. (backup-extract-version): Function removed. @@ -5766,7 +5766,7 @@ * tex-mode.el: Require comint instead of oshell. (tex-start-shell): Use comint, not oshell. - (tex-filter): Deleted function; no filter is now longer needed. + (tex-filter): Delete function; no filter is now longer needed. * tex-mode.el (tex-run-command, latex-run-command, slitex-run-command) (tex-bibtex-run-command, tex-dvi-print-command) @@ -5843,7 +5843,7 @@ 1992-06-28 Jim Blandy (jimb@pogo.cs.oberlin.edu) * completion.el (completion-separator-self-insert-autofilling): - Changed references to `auto-fill-hook' to `auto-fill-function'. + Change references to `auto-fill-hook' to `auto-fill-function'. * mh-e.el (mh-letter-mode): Same thing. * texinfo-upd.el (texinfo-update-node, texinfo-sequential-node-update): Same thing. @@ -5863,7 +5863,7 @@ calendar-daylight-savings-starts, calendar-daylight-savings-ends. Add autoload of calendar-sunrise-sunset. (calendar-mode): Add description of sunrise/sunset capability. - (calendar-version): Changed to 5. + (calendar-version): Change to 5. * diary.el: Autoload diary-sunrise-sunset and diary-sabbath-candles. @@ -5915,10 +5915,10 @@ (all-christian-calendar-holidays, all-islamic-calendar-holidays) (list-diary-entries-hook, diary-display-hook) (nongregorian-diary-listing-hook, nongregorian-diary-marking-hook) - (diary-list-include-blanks): Added autoload cookie for these; + (diary-list-include-blanks): Add autoload cookie for these; Reingold's distribution suggests that these variables are ones that you are especially likely to want to customize. - * holiday.el (holidays): Added autoload cookie for this. + * holiday.el (holidays): Add autoload cookie for this. 1992-06-25 Edward M. Reingold (reingold@emr.cs.uiuc.edu) @@ -5953,7 +5953,7 @@ * dired.el: Complete rewrite, mostly by sk@thp.uni-koeln.de. * dired-aux.el: Other parts of dired. - * files.el (enable-local-eval): Renamed from `ignore-local-eval'; + * files.el (enable-local-eval): Rename from `ignore-local-eval'; now has values like `enable-local-variables'. (hack-local-variables): Test `enable-local-eval' properly. @@ -5974,7 +5974,7 @@ 1992-06-21 Jim Blandy (jimb@pogo.cs.oberlin.edu) - * screen.el (ctl-x-5-map): Removed declaration and initialization + * screen.el (ctl-x-5-map): Remove declaration and initialization of this here; it's done in subr.el, alongside ctl-x-4-map. * autoload.el (generate-file-autoloads): If FILE is in the same @@ -6003,7 +6003,7 @@ 1992-06-18 Jim Blandy (jimb@pogo.cs.oberlin.edu) - * edebug.el (edebug-debug): Added autoload cookie for this. + * edebug.el (edebug-debug): Add autoload cookie for this. * etags.el (find-tag-other-frame): New function. Bind it to `C-x 5 .'. @@ -6043,7 +6043,7 @@ now the keymap `isearch-mode-map' controls special characters in isearch-mode. - * blackbox.el (blackbox): Added ;;;###autoload cookie. + * blackbox.el (blackbox): Add ;;;###autoload cookie. * add-log.el (change-log-mode): Integrated some code from the `change-log-mode' function in `text-mode.el'. Docstring now @@ -6085,7 +6085,7 @@ 1992-06-12 Joseph Arceneaux (jla@churchy.gnu.ai.mit.edu) - * simple.el (current-kill): Fixed misnamed parameter and + * simple.el (current-kill): Fix misnamed parameter and reorganized code slightly. 1992-06-11 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -6122,7 +6122,7 @@ 1992-06-08 Richard Stallman (rms@mole.gnu.ai.mit.edu) - * csharp.el (c-find-nesting): Renamed from csharp-find-nesting. + * csharp.el (c-find-nesting): Rename from csharp-find-nesting. Add autoload. All other functions in this file renamed to start with c-find-nesting. @@ -6204,7 +6204,7 @@ 1992-06-02 Roland McGrath (roland@geech.gnu.ai.mit.edu) * add-log.el: Fixed copyright years to not use a range. - (change-log-mode): Added docstring. + (change-log-mode): Add docstring. (add-change-log-entry): Put a space between the file name and "(function name):". Put a colon after the file name if we have found no function name. @@ -6247,7 +6247,7 @@ * fill.el (fill-region-as-paragraph): Treat } like closeparen. If a fill prefix is specified globally, always use that one. - * flow-ctrl.el (evade-flow-control-memstr=): Renamed from memstr=. + * flow-ctrl.el (evade-flow-control-memstr=): Rename from memstr=. 1992-05-31 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) @@ -6258,7 +6258,7 @@ 1992-05-31 Noah Friedman (friedman@splode.com) - * subr.el (lambda): Added docstring. + * subr.el (lambda): Add docstring. 1992-05-31 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) @@ -6286,7 +6286,7 @@ of writing out its code. * comint.el: Merged with Olin Shivers' comint version 2.03. - (comint-version): Changed accordingly. + (comint-version): Change accordingly. (comint-previous-input-matching): Bind this to c-m-r, rather than c-c c-r. (comint-exec-hook): Make this variable buffer-local. @@ -6300,8 +6300,8 @@ to "Non-echoed text: ". This conforms with the convention used by existing prompts, and gives more room to type stuff. - * comint.el (comint-last-input-start): New variable. In - particular, this helps support subprocesses that insist on echoing + * comint.el (comint-last-input-start): New variable. + In particular, this helps support subprocesses that insist on echoing their input. Added comments to porting guide indicating that this should probably not be used for implementing history stuff. (comint-mode): Create and initialize comint-last-input-start as a @@ -6340,9 +6340,9 @@ 1992-05-24 Edward M. Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (list-yahrzeit-dates): New function. - (hebrew-calendar-yahrzeit): Moved from diary.el. + (hebrew-calendar-yahrzeit): Move from diary.el. - * diary.el (hebrew-calendar-yahrzeit): Moved to calendar.el. + * diary.el (hebrew-calendar-yahrzeit): Move to calendar.el. (diary-ordinal-suffix): Give correct suffix for 111, 112, 113, 211, 212, 213, etc. @@ -6361,7 +6361,7 @@ below instead of manipulating the kill ring directly, since the functions correctly deal with interprogram cutting and pasting. (kill-new): New function. - (kill-append): Added doc string. Be sure to call the + (kill-append): Add doc string. Be sure to call the interprogram-cut-function on the new string. (current-kill): New function. (rotate-yank-pointer): New optional argument do-not-move, to @@ -6388,7 +6388,7 @@ how many characters were saved, and it's hard to interpret intuitively. - * screen.el (ctl-x-3-map): Renamed to ctl-x-5-map, and now bound + * screen.el (ctl-x-3-map): Rename to ctl-x-5-map, and now bound to C-x 5, not C-x 3. This makes a nicer analogy with C-x 4. Moving split-window-horizontally to C-x 3 also makes a nicer analogy with C-x 2. @@ -6503,7 +6503,7 @@ 1992-04-21 Jim Blandy (jimb@pogo.cs.oberlin.edu) - * doctor.el (doctor-svo): Deleted second expression from top let + * doctor.el (doctor-svo): Delete second expression from top let binding; it used to read "(let ((foo <exp> sent)) ...)"; let bindings can only have one expression. @@ -6649,7 +6649,7 @@ * compile.el (compilation-mode-hook): New variable. (compilation-mode): Run it. (compilation-search-path): Made user variable, added autoload cookie. - (compilation-window-height): Added autoload cookie. + (compilation-window-height): Add autoload cookie. 1992-02-27 Jim Blandy (jimb@pogo.cs.oberlin.edu) @@ -6720,7 +6720,7 @@ 1992-01-08 Jim Blandy (jimb@occs.cs.oberlin.edu) - * simple.el (temporary-goal-column): Added missing closing paren. + * simple.el (temporary-goal-column): Add missing closing paren. 1991-12-25 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -6752,7 +6752,7 @@ 1991-12-14 Eric S. Raymond (eric@mole.gnu.ai.mit.edu) - * etags.el (find-tag-noselect): Fixed subtle bug due to + * etags.el (find-tag-noselect): Fix subtle bug due to save-excursion. (tags-tag-match): New function, made smarter about exact matches. @@ -6803,7 +6803,7 @@ 1991-12-08 Richard Stallman (rms@mole.gnu.ai.mit.edu) * diff.el (diff-internal-diff): New subroutine. - (diff): Removed from here. + (diff): Remove from here. (diff-sccs, diff-rcs): New commands using diff-internal-diff. (diff-rcs-extension): New variable. @@ -6855,7 +6855,7 @@ 1991-11-06 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) * screen.el (screen-initialize, screen-notice-user-settings): - Renamed global-minibuffer-screen to default-minibuffer-screen. + Rename global-minibuffer-screen to default-minibuffer-screen. 1991-11-05 Edward M. Reingold (reingold@emr.cs.uiuc.edu) @@ -6864,8 +6864,8 @@ 1991-10-31 Richard Mlynarik (mly@peduncle) - * ebuff-menu.el (electric-buffer-menu-mode-map): Define - < and > to scroll-left and scroll-right per user suggestion. + * ebuff-menu.el (electric-buffer-menu-mode-map): + Define < and > to scroll-left and scroll-right per user suggestion. 1991-10-31 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) @@ -6881,7 +6881,7 @@ * cmushell.el: This is now the real shell.el. Removed the "cmu" prefix from names. - (shell): Marked this to be autoloaded. + (shell): Mark this to be autoloaded. 1991-10-29 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) @@ -6902,8 +6902,8 @@ 1991-10-26 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) * disass.el (disassemble): Correctly distinguish functions with no - interactive spec and functions that are (interactive). Correctly - extract components of explicit calls to byte-code (old-style + interactive spec and functions that are (interactive). + Correctly extract components of explicit calls to byte-code (old-style compiled functions). Correctly pass byte code of function to disassemble-1. (disassemble-1): Use nth to extract components of explicit call to @@ -6923,14 +6923,14 @@ 1991-10-15 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) - * info.el (Info-follow-nearest-node): Adjusted for new return + * info.el (Info-follow-nearest-node): Adjust for new return value format from coordinates-in-window-p. 1991-10-08 Roland McGrath (roland@albert.gnu.ai.mit.edu) * add-log.el (change-log-name): New fn. - (add-change-log-entry, add-change-log-entry-other-window): All - args optional. FILE-NAME defaults to new var + (add-change-log-entry, add-change-log-entry-other-window): + All args optional. FILE-NAME defaults to new var `change-log-default-name'. Give this var a local value in the buffer we were run from, pointing to the file we found. @@ -6972,7 +6972,7 @@ 1991-09-26 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - * map-ynp.el (map-y-or-n-p): Fixed for lists containing nil. + * map-ynp.el (map-y-or-n-p): Fix for lists containing nil. 1991-09-10 Roland McGrath (roland@wookumz.gnu.ai.mit.edu) @@ -7034,7 +7034,7 @@ * rmail.el (rmail-convert-to-babyl-format): Roland added the missing paren in the wrong place; fixed. - * screen.el (screen-initialize): Added missing `function' around + * screen.el (screen-initialize): Add missing `function' around lambda expression. 1991-08-20 Roland McGrath (roland@churchy.gnu.ai.mit.edu) @@ -7063,7 +7063,7 @@ 1991-08-17 Roland McGrath (roland@geech.gnu.ai.mit.edu) * doctor.el (doctor-strangelove): New fn. - (doctor-member): Removed. + (doctor-member): Remove. (doctor-doc): Use member instead of doctor-member. (doctor-rms): Restored. @@ -7073,7 +7073,7 @@ 1991-08-15 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) - * screen.el (screen-create-initial-screen): Renamed to + * screen.el (screen-create-initial-screen): Rename to screen-initialize. Arrange to cause errors if people try to create screens when no window system is running. @@ -7085,14 +7085,14 @@ * loaddefs.el (ctl-x-4-map): Move definition from here... * subr.el (ctl-x-4-map): To here. (ctl-x-3-map): New prefix. - (mouse-map): Deleted. + (mouse-map): Delete. * screen.el (new-screen-x-delta, new-screen-y-delta) - (new-screen-position): Removed. - (new-screen): Simplified. - (split-to-other-screen): Removed. + (new-screen-position): Remove. + (new-screen): Simplify. + (split-to-other-screen): Remove. (switch-to-buffer-other-screen, find-file-other-screen) - (find-file-read-only-other-screen, mail-other-screen): Moved, along + (find-file-read-only-other-screen, mail-other-screen): Move, along with their keybindings, to... * files.el (switch-to-buffer-other-screen, find-file-other-screen) (find-file-read-only-other-screen): Here... @@ -7136,11 +7136,11 @@ * screen.el, term/x-win.el: Renamed screen-default-alist to default-screen-alist. - (default-screen-alist): Moved declaration to screen.c; the + (default-screen-alist): Move declaration to screen.c; the screen creation subrs should consult this transparently. - * term/x-win.el (x-get-resources, x-pop-initial-window): Functions - deleted. Don't call them at the bottom of the file anymore. + * term/x-win.el (x-get-resources, x-pop-initial-window): + Functions deleted. Don't call them at the bottom of the file anymore. 1991-08-12 Roland McGrath (roland@geech.gnu.ai.mit.edu) @@ -7152,15 +7152,15 @@ 1991-08-12 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) * window.el (split-window-keep-point): New user option. - (split-window-vertically): Modified to support it. + (split-window-vertically): Modify to support it. * startup.el (command-line): Choose a default value for split-window-keep-point according to the baud rate. * term/x-win.el: Set split-window-keep-point. 1991-08-10 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) - * term/x-win.el (x-daemon-mode, x-establish-daemon-mode): Removed - these functions; we do this differently now. + * term/x-win.el (x-daemon-mode, x-establish-daemon-mode): + Remove these functions; we do this differently now. 1991-08-07 Roland McGrath (roland@geech.gnu.ai.mit.edu) @@ -7169,7 +7169,7 @@ 1991-08-05 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) - * screen.el (screen-creation-func): Renamed to + * screen.el (screen-creation-func): Rename to screen-creation-function, as per the convention. * screen.el (screen-creation-func): Do not initialize this @@ -7184,7 +7184,7 @@ * startup.el (pre-init-hook): New variable. (window-setup-hook): Doc fix. (command-line): Call pre-init-hook. - (command-line-1): Updated copyright date. + (command-line-1): Update copyright date. 1991-07-31 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) @@ -7193,7 +7193,7 @@ 1991-07-31 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - * screen.el (auto-new-screen-function): Renamed to + * screen.el (auto-new-screen-function): Rename to pop-up-screen-function. (buffer-in-other-screen): Use pop-up-screens, not auto-new-screen. @@ -7239,12 +7239,12 @@ * view.el: (define-key "C-xv" 'view-file). (view-file-other-window, view-buffer-other-window): New functions. - (view-prev-buffer): Renamed to view-return-here. + (view-prev-buffer): Rename to view-return-here. (view-exit): If view-return-here is a buffer, switch to it; if it is a window configuration, apply it. - * subr.el (search-forward-regexp, search-backward-regexp): Added - alternate names. + * subr.el (search-forward-regexp, search-backward-regexp): + Add alternate names. 1991-07-24 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) @@ -7256,7 +7256,7 @@ * isearch.el (isearch): If the user switches to a different screen, exit the isearch. - * isearch.el (isearch): Changed reference to `cmds' to use + * isearch.el (isearch): Change reference to `cmds' to use variable's new name `history'. 1991-07-23 Roland McGrath (roland@churchy.gnu.ai.mit.edu) @@ -7264,7 +7264,7 @@ * rmail.el (rmail-first-unseen-message): Make loop looking for unseen msgs not skip the first one. - * rmail.el (rmail-widen-to-current-msgbeg): Added missing close paren. + * rmail.el (rmail-widen-to-current-msgbeg): Add missing close paren. 1991-07-21 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) @@ -7286,7 +7286,7 @@ 1991-07-19 Roland McGrath (roland@albert.gnu.ai.mit.edu) - * files.el (save-some-buffers): Added save-excursions around code + * files.el (save-some-buffers): Add save-excursions around code that does set-buffer. 1991-07-15 Roland McGrath (roland@churchy.gnu.ai.mit.edu) @@ -7297,7 +7297,7 @@ (find-tag-tag): Pass 'tags-completion-alist as TABLE to completing-read, so the table is built on demand. - * sendmail.el (mail-do-fcc): Added missing close paren. + * sendmail.el (mail-do-fcc): Add missing close paren. 1991-07-15 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) @@ -7313,8 +7313,8 @@ * fortran.el version 1.28.3 Now works in either mode when `tab-width' is not 8. - (fortran-electric-line-number, fortran-indent-to-column): Use - `fortran-minimum-statement-indent' instead of 8. + (fortran-electric-line-number, fortran-indent-to-column): + Use `fortran-minimum-statement-indent' instead of 8. (fortran-current-line-indentation): Now skips over line number and whitespace correctly when tab-width is not 8. @@ -7331,7 +7331,7 @@ * startup.el (command-line): Remove the arguments from command-line-args as we process them. - (command-line-1): Removed code to ignore the arguments processed + (command-line-1): Remove code to ignore the arguments processed in command-line, because they're all deleted now. * replace.el (occur): Set tem to the location of the match before @@ -7351,7 +7351,7 @@ 1991-07-09 Roland McGrath (roland@albert.gnu.ai.mit.edu) - * map-ynp.el (map-y-or-n-p): Fixed lossage on ? or random char. + * map-ynp.el (map-y-or-n-p): Fix lossage on ? or random char. 1991-07-08 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -7368,8 +7368,8 @@ * fortran.el: Added ;;;###autoload definition for fortran-tab-mode-default variable. - * fortran.el (fortran-numerical-continuation-char): Replace - (backward-line 1) with (forward-line -1) since backward-line is + * fortran.el (fortran-numerical-continuation-char): + Replace (backward-line 1) with (forward-line -1) since backward-line is defined only in edt. (fortran-previous-statement): Fix error in parens. (fortran-indent-to-column): Likewise. @@ -7378,7 +7378,7 @@ * files.el (save-some-buffers): Use map-y-or-n-p return value. - * map-ynp.el (map-y-or-n-p): Fixed bug that caused first elt on ! + * map-ynp.el (map-y-or-n-p): Fix bug that caused first elt on ! hit not get acted on. 1991-07-04 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -7390,7 +7390,7 @@ 1991-07-01 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - * map-ynp.el (map-y-or-n-p): Fixed misplaced paren. + * map-ynp.el (map-y-or-n-p): Fix misplaced paren. Fixed list-eating bug. 1991-07-01 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -7425,7 +7425,7 @@ 1991-06-20 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - * subr.el (ignore): Added docstring for this; it appears as a key + * subr.el (ignore): Add docstring for this; it appears as a key binding, so it ought to be described. 1991-06-19 Roland McGrath (roland@albert.gnu.ai.mit.edu) @@ -7443,16 +7443,16 @@ 1991-06-12 Roland McGrath (roland@albert.gnu.ai.mit.edu) - * upd-copyr.el (update-copyright): Fixed typo in help text. + * upd-copyr.el (update-copyright): Fix typo in help text. 1991-05-26 Roland McGrath (roland@albert.gnu.ai.mit.edu) - * disass.el (disassemble-internal): Fixed typo string? -> stringp. + * disass.el (disassemble-internal): Fix typo string? -> stringp. 1991-05-26 Edward M. Reingold (reingold@emr.cs.uiuc.edu) - * holiday.el (calendar-holiday-function-passover-etc): Correct - date and spelling of Yom HaAtzma'ut. + * holiday.el (calendar-holiday-function-passover-etc): + Correct date and spelling of Yom HaAtzma'ut. 1991-05-23 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) @@ -7501,14 +7501,14 @@ screen-default-alist alone; don't use x-switches-specified. (x-read-resources): New function to read the X defaults and put them in screen-default-alist. Call this function at the bottom. - * screen.el (death-function): Removed, because this is now handled + * screen.el (death-function): Remove, because this is now handled better in startup.el. (pop-initial-screen): Don't do a condition-case to call death-function. 1991-05-18 Jim Blandy (jimb@pogo.gnu.ai.mit.edu) - * macros.el (apply-macro-to-region-lines): Added a save-excursion + * macros.el (apply-macro-to-region-lines): Add a save-excursion around the macro invocation, so that the macro doesn't need to stay on the same line. @@ -7614,7 +7614,7 @@ * find-dired.el (find-dired-filter): Don't search; use forward-line instead. - (find-dired-filter, find-dired-sentinel): Changed docstrings to + (find-dired-filter, find-dired-sentinel): Change docstrings to comments. 1991-05-11 Roland McGrath (roland@albert.gnu.ai.mit.edu) @@ -7755,8 +7755,8 @@ Now supports tab or fixed format style of continuation control and indentation. In tab style, lines start with a tab, or a line number followed by a tab. If the first character after the tab is - a digit from 1 to 9, the line is a continuation line. When - entering fortran mode for a file, the first line that begins with + a digit from 1 to 9, the line is a continuation line. + When entering fortran mode for a file, the first line that begins with 6 spaces or a tab is found. The buffer is then set respectively to either fixed format or tab format style. The mode may be toggled with the command fortran-tab-mode. @@ -7965,7 +7965,7 @@ 1991-02-25 Paul Hilfinger (hilfingr@hilfinger.cs.nyu.edu) - * fill.el (fill-individual-paragraphs): Changed response to mailp + * fill.el (fill-individual-paragraphs): Change response to mailp to effect only leading lines in a region (was getting confused about colons embedded in ordinary text). Changed method of moving to next paragraph in the main loop to use forward-paragraph @@ -7978,7 +7978,7 @@ 1991-02-23 Roland McGrath (mcgrath@cygint.cygnus.com) - * compile.el (next-error): Fixed bug in rms's optimization. + * compile.el (next-error): Fix bug in rms's optimization. 1991-02-23 Richard Stallman (rms@mole.ai.mit.edu) @@ -8040,7 +8040,7 @@ 1991-02-04 Jim Blandy (jimb@gnu.ai.mit.edu) - * simple.el (eval-current-buffer): Removed, since it has been + * simple.el (eval-current-buffer): Remove, since it has been reintroduced to the C code. 1991-02-02 Jim Blandy (jimb@gnu.ai.mit.edu) @@ -8114,8 +8114,8 @@ * bibtex.el: Expanded the various bibtex-field-* patterns to allow fields like 'title = poft # "Fifth Triquaterly" # random-conf,'. Needs to have more work done to accept all cases. Added code for - the bibtex 'crossref' command, which subsumes other options. Made - field ordering different when this option on. Also allow user to + the bibtex 'crossref' command, which subsumes other options. + Made field ordering different when this option on. Also allow user to have a list of field to be added to all entries (bibtex-mode-user-optional-fields). Merged in Bengt Martensson's changes. @@ -8148,13 +8148,13 @@ 1991-01-08 Roland McGrath (roland@albert.ai.mit.edu) - * compile.el (compilation-parse-errors): Fixed maintenance of + * compile.el (compilation-parse-errors): Fix maintenance of last-linenum, so dups are really found. 1991-01-08 Jim Blandy (jimb@pogo.ai.mit.edu) - * bytecomp.el (byte-compile-byte-code-maker): Since - byte-compile-lambda is free to return the original lambda + * bytecomp.el (byte-compile-byte-code-maker): + Since byte-compile-lambda is free to return the original lambda expression, we'd better be prepared to handle things that aren't bytecode objects. @@ -8242,8 +8242,8 @@ 1990-12-20 Chris Hanson (cph@kleph) - * texnfo-upd.el (texinfo-update-menu-region-beginning): Change - code that searches for "top" node so it returns the position of + * texnfo-upd.el (texinfo-update-menu-region-beginning): + Change code that searches for "top" node so it returns the position of the beginning of the node line. Always search from the buffer's start when looking for that node. (texinfo-make-one-menu): Bump forward over the outer node line. @@ -8317,7 +8317,7 @@ 1990-12-12 Roland McGrath (roland@albert.ai.mit.edu) - * compile.el (compilation-error-buffer): Removed. + * compile.el (compilation-error-buffer): Remove. (compilation-last-buffer): Now last buffer in which any of: started compilation; C-x `; C-c C-c; was done. (compile-internal): Don't set compilation-error-buffer. @@ -8340,7 +8340,7 @@ error-message, and regexp-alist. (compile-internal): Do it here, after calling compilation-mode. - * compile.el (compilation-error-list): Changed elt format. + * compile.el (compilation-error-list): Change elt format. (compilation-parse-errors): Don't find files when parsing. Instead record ((DIR . FILE) . LINENO) structures to describe each error. @@ -8401,35 +8401,35 @@ 1990-11-30 Mike Newton (newton@gumby.cs.caltech.edu) - * bibtex.el (start comments): Added earlier comments of Bengt + * bibtex.el (start comments): Add earlier comments of Bengt Martensson. Some of the changes listed below are originally his (including clean-entry, OPTkey and OPTannote, the function renaming and the preamble code). - * bibtex.el (bibtex-field-* patterns): Expanded to allow fields + * bibtex.el (bibtex-field-* patterns): Expand to allow fields like 'title = poft # "Fifth Triquaterly" # random-conf,'. Needs to have more work done to accept all cases. - * bibtex.el (bibtex-clean-entry-zap-empty-opts): Added. + * bibtex.el (bibtex-clean-entry-zap-empty-opts): Add. - * bibtex.el (bibtex-include-OPTcrossref): Added. If set, changes + * bibtex.el (bibtex-include-OPTcrossref): Add. If set, changes order of the lists presented to luser. - * bibtex.el (bibtex-include-OPTkey & bibtex-include-OPTannote): Added. + * bibtex.el (bibtex-include-OPTkey & bibtex-include-OPTannote): Add. * bibtex.el (bibtex-mode-user-optional-fields): Can be set to a list of field the user wants to add to entries. - * bibtex.el (bibtex-mode documentation string): Updated for new changes, + * bibtex.el (bibtex-mode documentation string): Update for new changes, DEAthesis added back in, bibtex-preamble call added. * bibtex.el (bibtex-entry): Add OPTkey/annote. If OPTcrossref set then put it in. - * bibtex.el (bibtex-make-entry): Renamed bibtex-make-field. + * bibtex.el (bibtex-make-entry): Rename bibtex-make-field. - * bibtex.el (bibtex-make-optional-entry): Renamed - bibtex-make-optional-field. + * bibtex.el (bibtex-make-optional-entry): + Rename bibtex-make-optional-field. * bibtex.el (bibtex-Article): Change order of presentation if OPTcrossref is set. @@ -8443,16 +8443,16 @@ * bibtex.el (bibtex-InProceedings): Change order of presentation if OPTcrossref is set. - * bibtex.el (bibtex-MastersThesis): Added "note". + * bibtex.el (bibtex-MastersThesis): Add "note". - * bibtex.el (bibtex-preamble): Added. + * bibtex.el (bibtex-preamble): Add. * bibtex.el (bibtex-inside-field): Only go backwards if quote is there. - * bibtex.el (bibtex-clean-entry): Added call to + * bibtex.el (bibtex-clean-entry): Add call to bibtex-clean-entry-zap-empty-opts, OPT field testing for errors. - * bibtex.el (bibtex-x-help): Added options Conference and preamble, + * bibtex.el (bibtex-x-help): Add options Conference and preamble, restored DEAthesis. 1990-11-30 Richard Stallman (rms@mole.ai.mit.edu) @@ -8552,7 +8552,7 @@ (insert-hebrew-diary-entry, insert-monthly-hebrew-diary-entry) (insert-yearly-hebrew-diary-entry, insert-islamic-diary-entry) (insert-monthly-islamic-diary-entry) - (insert-yearly-islamic-diary-entry): Modified so that if a prefix arg + (insert-yearly-islamic-diary-entry): Modify so that if a prefix arg is supplied these make nonmarking diary entries; otherwise the entries made are marking. (insert-block-diary-entry, insert-anniversary-diary-entry) @@ -8572,27 +8572,27 @@ 1990-11-06 Ed Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (sexp-diary-entry-symbol): New variable. - (cursor-to-iso-calendar-date): Simplified, slightly. - (cursor-to-calendar-day-of-year): Fixed punctuation. - (cursor-to-french-calendar-date): Moved French names to arrays. + (cursor-to-iso-calendar-date): Simplify, slightly. + (cursor-to-calendar-day-of-year): Fix punctuation. + (cursor-to-french-calendar-date): Move French names to arrays. * diary.el (list-sexp-diary-entries, diary-sexp-entry, diary-cyclic) (diary-hebrew-date, diary-iso-date, diary-day-of-year) (diary-float, diary-islamic-date, diary-anniversary, diary-block) (diary-french-date, diary-omer, diary-yahrzeit, diary-parasha) (diary-rosh-hodesh, hebrew-calendar-parasha-name): New functions. - (list-diary-entries): Added call to (list-sexp-diary-entries) and + (list-diary-entries): Add call to (list-sexp-diary-entries) and fixed an obscure error that caused a diary entry to be missed if it was preceded by an empty entry of the same style. - (list-hebrew-diary-entries, list-islamic-diary-entries): Fixed an + (list-hebrew-diary-entries, list-islamic-diary-entries): Fix an obscure error that caused a diary entry to be missed if it was preceded by an empty entry of the same style. - (mark-islamic-calendar-date-pattern): Renamed some local variables + (mark-islamic-calendar-date-pattern): Rename some local variables more appropriately. 1990-11-05 Roland McGrath (roland@geech.ai.mit.edu) - * compile.el (compilation-window-height): Added defconst for this, + * compile.el (compilation-window-height): Add defconst for this, since it somehow disappeared. * compile.el: Unoverhauled. Restored from old 19 compile.el, plus @@ -8622,7 +8622,7 @@ called to generate a name for a compilation buffer. Passed one arg, the name of the major mode of the buffer. (compile-internal): Use it. [From tale's changes:] - (compile): Moved window enlarging to compile-internal. + (compile): Move window enlarging to compile-internal. (compile-internal): Don't use with-output-to-temp-buffer. Use display-buffer instead. @@ -8704,10 +8704,10 @@ 1990-10-23 David Lawrence (tale@pogo.ai.mit.edu) - * emerge.el (emerge-setup, emerge-setup-with-ancestor): Moved - insert-buffer calls back before call to emerge-extract-diffs where + * emerge.el (emerge-setup, emerge-setup-with-ancestor): + Move insert-buffer calls back before call to emerge-extract-diffs where the merge-buffer really needs to have something in it. - (emerge-extract-diffs,emerge-extract-diffs3): Moved errant + (emerge-extract-diffs,emerge-extract-diffs3): Move errant kill-buffer which interfered with return value of functions. 1990-10-22 David Lawrence (tale@pogo.ai.mit.edu) @@ -8782,7 +8782,7 @@ (texinfo-menu-locate-entry-p, texinfo-copy-menu-title) (texinfo-update-menu-region-beginning, texinfo-update-menu-region-end): Handle `@ifinfo' as well as comment line following node line. - (texinfo-multiple-files-update and aux. files): Added to handle + (texinfo-multiple-files-update and aux. files): Add to handle multi-file Texinfo sources. 1990-10-18 Richard Stallman (rms@mole.ai.mit.edu) @@ -8830,9 +8830,9 @@ * dired.el (dired-compress, dired-uncompress): Put output from subprocess in a buffer to display it. - * appt.el (fix-time): Deleted. - (appt-select-lowest-window): Renamed from select-lowest-window. - (appt-visible): Renamed from appt-visable. + * appt.el (fix-time): Delete. + (appt-select-lowest-window): Rename from select-lowest-window. + (appt-visible): Rename from appt-visable. * time.el (display-time-filter): Run display-time-hook. @@ -8842,10 +8842,10 @@ 1990-10-08 Ed Reingold (reingold@emr.cs.uiuc.edu) - * holiday.el (calendar-holiday-function-hebrew): Fixed minor problem + * holiday.el (calendar-holiday-function-hebrew): Fix minor problem with the code to short-circuit the calculations to save time. - * diary.el (mark-hebrew-calendar-date-pattern): Fixed minor problem + * diary.el (mark-hebrew-calendar-date-pattern): Fix minor problem with the code to short-circuit the calculations to save time. 1990-10-08 Richard Stallman (rms@mole.ai.mit.edu) @@ -8957,7 +8957,7 @@ 1990-09-18 Richard Stallman (rms@mole.ai.mit.edu) - * doctor.el (doctor-caddr, doctor-cadr, doctor-cddr): Renamed. + * doctor.el (doctor-caddr, doctor-cadr, doctor-cddr): Rename. 1990-09-13 Richard Stallman (rms@mole.ai.mit.edu) @@ -8979,7 +8979,7 @@ 1990-09-10 Ed Reingold (reingold@emr.cs.uiuc.edu) * diary.el (list-diary-entries, list-hebrew-diary-entries) - (list-islamic-diary-entries): Fixed to use add-to-diary-list. + (list-islamic-diary-entries): Fix to use add-to-diary-list. 1990-09-10 Chris Hanson (cph@kleph) @@ -9039,7 +9039,7 @@ * diary.el (mark-diary-entries, mark-islamic-diary-entries) (mark-hebrew-diary-entries): Eliminated use of constant alists for month and day names. - (prepare-fancy-diary-buffer): Fixed the way holidays are displayed + (prepare-fancy-diary-buffer): Fix the way holidays are displayed when there are no diary entries but lots of holidays. (ordinary-list-diary-hook, add-to-diary-list): New functions. @@ -9049,21 +9049,21 @@ Changed reference at beginning of file from the report to the published version of the paper. Changed all calls to `mod' to call `%' to avoid problem with cl. - (calendar-date-string): Added optional parameter `nodayname'. - (cursor-to-islamic-calendar-date): Fixed so that + (calendar-date-string): Add optional parameter `nodayname'. + (cursor-to-islamic-calendar-date): Fix so that calendar-date-string doesn't try find the day name. - (cursor-to-hebrew-calendar-date): Fixed so that + (cursor-to-hebrew-calendar-date): Fix so that calendar-date-string doesn't try find the day name. nongregorian-diary-marking-hook: Fixed typo in doc string. - (calendar-mode): Fixed a typo in doc string. + (calendar-mode): Fix a typo in doc string. (cursor-to-iso-calendar-date): Made message consistent with similar functions for Julian, Islamic, Hebrew, and French calendars. - (calendar-absolute-from-gregorian): Simplified calculation. - (calendar-mark-today): Changed today mark to `=' to avoid + (calendar-absolute-from-gregorian): Simplify calculation. + (calendar-mark-today): Change today mark to `=' to avoid confusion with the default holiday mark. (calendar-julian-from-absolute): Rewrote parallel to other functions. (calendar-islamic-from-absolute): Rewrote parallel to other functions. - (calendar-forward-day): Fixed movement when cursor is not on a date + (calendar-forward-day): Fix movement when cursor is not on a date and arg is negative. Added description of new `if' form to doc string for calendar-holidays. @@ -9074,10 +9074,10 @@ * holiday.el: Changed all calls to `mod' to call `%' to avoid problem with cl. - (calendar-holiday-function-rosh-hashanah-etc): Fixed grammatical + (calendar-holiday-function-rosh-hashanah-etc): Fix grammatical error in a comment. - (calendar-holiday-function-hebrew): Fixed typo in doc string. - (calendar-holiday-function-islamic): Fixed typo in doc string. + (calendar-holiday-function-hebrew): Fix typo in doc string. + (calendar-holiday-function-islamic): Fix typo in doc string. (calendar-holiday-function-if): New function. 1990-09-06 Richard Stallman (rms@mole.ai.mit.edu) @@ -9114,12 +9114,12 @@ * loaddefs.el: (gnus, gnus-post-news): Autoload gnus. (sendnews, postnews): fset to gnus-post-news instead of news-post-news. - (rnews, news-post-news): Removed autoloads. + (rnews, news-post-news): Remove autoloads. * gnus.el: New file. - (gnus-make-newsrc-file): Removed. + (gnus-make-newsrc-file): Remove. (gnus-read-newsrc-file): Work without above. - (gnus-Info-directory): Removed. + (gnus-Info-directory): Remove. (gnus-Info-find-node): Work without above. (lots of variables): Made non-interactive. Some doc fixes. @@ -9151,7 +9151,7 @@ (fortran-current-line-indentation): Only skip over continuation char or line number for statements. It was giving back wrong values for statements which started in columns 1-6. - (fortran-mode-version): Removed. + (fortran-mode-version): Remove. 1990-08-28 David Lawrence (tale@pogo.ai.mit.edu) @@ -9161,8 +9161,8 @@ copy-vector. Calling copy-sequence does the job. (defsetf for point): Point's inverse is goto-char. Of course, what do we do with the other basic types of Emacs Lisp? - (member): Another, perhaps counterproductive, speed hack. When - test or testnot are symbols (hopefully, non-null), they are + (member): Another, perhaps counterproductive, speed hack. + When test or testnot are symbols (hopefully, non-null), they are replaced by their symbol-function slots. This presumably reduces one indirection per each funcall in the inner loop. (byte-compile-named-list-accessors): Another byte-compile @@ -9172,7 +9172,7 @@ (with-keyword-args): Macro that simplifies most of the handling of klists. The only neglected functionality is that no supplied-p forms exist (although that is true also of lambda lists in Emacs Lisp). - (cl-eval-print-last-sexp): Added half-hearted support for -, +, + (cl-eval-print-last-sexp): Add half-hearted support for -, +, ++, +++, *, **, ***, /, //, ///; and cleared the mvalues mechanism at every call. (declare, proclaim, the): Make some more CL codes easy to load. @@ -9183,7 +9183,7 @@ (byte-compile-ca*d*r): New function, used as a handler from byte-compile-form to eliminate the extra call to the c*r functions in compiled code. - (adjoin, map): Changed to use `memq' instead of `member', too. + (adjoin, map): Change to use `memq' instead of `member', too. (case, ecase): Via a change in case-clausify, these macros now generate tests using the primitive `memq', instead of the heavier `member'. @@ -9203,8 +9203,8 @@ functions. (build-klist): Better error messages. (psetf): Rewrote, patterned after the new psetq. - (psetq): Added early check for even number of arguments. This - causes a better error message than previously. + (psetq): Add early check for even number of arguments. + This causes a better error message than previously. (defstruct, parse$defstruct$options): asp@CS.CMU.EDU (James Aspnes) reported that defstruct wasn't handling properly the use of accessors of an :included definition applied to instances of @@ -9252,8 +9252,8 @@ *Completions* not *Help*. * help.el (describe-mode): Use Dale Worley's version to also show - minor mode documentation if argument is given. Fset - defining-keyboard-macro to start-keyboard-macro so its + minor mode documentation if argument is given. + Fset defining-keyboard-macro to start-keyboard-macro so its documentation can be found. Currently does not work with auto-fill-mode because of the hook nature of its minor mode indicator variable. @@ -9357,7 +9357,7 @@ 1990-07-26 David Lawrence (tale@pogo.ai.mit.edu) * c-mode.el (c-auto-newline): Doc addition. - (electric-c-terminator): Removed bogus set-marker. + (electric-c-terminator): Remove bogus set-marker. (electric-c-sharp-sign): Make sure c-auto-newline is nil for call to electric-c-terminator. @@ -9464,7 +9464,7 @@ * compile.el (grep): Use `grep-command' to also hold args for grep, like compile-command. - * simple.el (kill-ring-save): Fixed to not reference free + * simple.el (kill-ring-save): Fix to not reference free variable `verbose' but to just unconditionally echo message. (shell-command): Use new `last-shell-command' interactively. (shell-command-on-region): Use new `last-shell-command-on-region' @@ -9478,7 +9478,7 @@ 1990-06-23 Randall Smith (randy@substantia-nigra) - * dired.el (dired-flag-regexp-files): Added function to flag all + * dired.el (dired-flag-regexp-files): Add function to flag all files matching a REGEXP for deletion. (): Bound this function to key "F" in dired-mode ("D" was already taken). @@ -9506,8 +9506,8 @@ * isearch.el (isearch): Do exit on meta keys. Also exit on function keys and mouse clicks. * loaddefs.el (search-exit-char): Change back to escape. - (search-ring-advance-char): Moved from isearch.el. - (search-ring-retreat-char): Renamed from ...-recline-char and moved. + (search-ring-advance-char): Move from isearch.el. + (search-ring-retreat-char): Rename from ...-recline-char and moved. * float.el: Provide 'float. @@ -9561,7 +9561,7 @@ updated all existing menus (very time consuming). (texinfo-all-menus-update, texinfo-every-node-update): - Added a save-excursion to each so that point does not move when + Add a save-excursion to each so that point does not move when you update the menus or nodes. * texinfmt.el (texinfo-format-parse-args): Expand arguments so @@ -9572,16 +9572,16 @@ * backquote.el (bq-splicequote): Correctly splice in elements when followed by constant elements; don't list the constant elements. - * add-log.el (add-change-log-entry): Fixed match test for full name. + * add-log.el (add-change-log-entry): Fix match test for full name. - * lpr.el (print-buffer): Removed an extra trailing parenthesis. + * lpr.el (print-buffer): Remove an extra trailing parenthesis. 1990-05-30 David Lawrence (tale@geech) * comint.el (comint-load-hook): Superseded by eval-after-load. - * inf-lisp.el (lisp-eval-region, lisp-compile-region): Use - temporary files instead of send-string to avoid problems with pty + * inf-lisp.el (lisp-eval-region, lisp-compile-region): + Use temporary files instead of send-string to avoid problems with pty buffering. * tex-mode.el (tex-close-latex-block): Allow whitespace after @@ -9629,7 +9629,7 @@ * informat.el (Info-tagify): Give status messages before and after tagifying. - (batch-info-validate): Removed status messages around Info-tagify. + (batch-info-validate): Remove status messages around Info-tagify. * rmailout.el (rmail-output): Check for From:, Really-From: and Sender: fields, in that order, and run mail-strip-quoted-names on @@ -9637,13 +9637,13 @@ 1990-05-21 Richard Stallman (rms@mole.ai.mit.edu) - * buff-menu.el (Buffer-menu-buffer): Simplified. + * buff-menu.el (Buffer-menu-buffer): Simplify. Set Buffer-menu-buffer-column initially. 1990-05-18 Robert J. Chassell (bob@apple-gunkies) * page-ext.el (pages-addresses-file-name): - Renamed from addresses-file-name. + Rename from addresses-file-name. 1990-05-17 Robert J. Chassell (bob@apple-gunkies) @@ -9990,12 +9990,12 @@ * screen.el (iconify-function, iconify-emacs, deiconify-function): New functions. - * files.el (save-some-buffers): Removed last parameter skip-list. + * files.el (save-some-buffers): Remove last parameter skip-list. Now this checks for buffer-local variable save-buffers-skip to determine whether or not to avoid asking to save the buffer. - * rmail.el (rmail-mode): Removed skip-list stuff. + * rmail.el (rmail-mode): Remove skip-list stuff. (rmail-variables): make-local-variable save-buffers-skip. - * compile.el (compile): Removed additional parameter to save-buffers. + * compile.el (compile): Remove additional parameter to save-buffers. 1990-02-26 David Lawrence (tale@pogo.ai.mit.edu) @@ -10004,21 +10004,21 @@ display-time-string. (rmail-pop-up): Default display-time-hook to automatically retrieve new mail if the variable rmail-pop-up is non-nil. - (add-clock-handler): Removed; superseded by timer.el. + (add-clock-handler): Remove; superseded by timer.el. * loaddefs.el: Removed add-clock-handler. 1990-02-25 David Lawrence (tale@pogo.ai.mit.edu) * c++-mode.el: New file. - (point-bol): Removed this function. + (point-bol): Remove this function. * loaddefs.el: Autoload C++-mode. (auto-mode-alist): c++-mode for .C and .cc files. 1990-02-25 Joseph Arceneaux (jla@gnu.ai.mit.edu) - * lisp-mode.el (indent-sexp): Changed opoint to last-point. + * lisp-mode.el (indent-sexp): Change opoint to last-point. Very strange, I thought I'd already fixed this. * screen.el: New file. @@ -10048,11 +10048,11 @@ * files.el (file-newest-backup): Return either the name of an existing backup file or nil if none exists. - * server.el (server-program): Renamed from "server" to "emacsserver". + * server.el (server-program): Rename from "server" to "emacsserver". 1990-02-20 Joseph Arceneaux (jla@gnu.ai.mit.edu) - * fill.el (fill-region-as-paragraph): Fixed regexp typo in call to + * fill.el (fill-region-as-paragraph): Fix regexp typo in call to re-search-forward. 1990-02-19 David Lawrence (tale@pogo.ai.mit.edu) @@ -10110,9 +10110,9 @@ * calendar.el (french-calendar-leap-year-p): Rewritten with corrected rule. - (calendar-absolute-from-french): Fixed comments. + (calendar-absolute-from-french): Fix comments. (calendar-french-from-absolute): Rewrote using calendar-sum. - (cursor-to-french-calendar-date): Simplified and corrected spelling. + (cursor-to-french-calendar-date): Simplify and corrected spelling. 1990-02-06 Richard Stallman (rms@mole.ai.mit.edu) @@ -10151,9 +10151,9 @@ 1990-01-27 Ed Reingold (reingold@emr.cs.uiuc.edu) - * calendar.el (scroll-calendar-left): Fixed so it works when the cursor + * calendar.el (scroll-calendar-left): Fix so it works when the cursor is not positioned on a day. - (cursor-to-calendar-day-of-year): Fixed so that "day" is properly + (cursor-to-calendar-day-of-year): Fix so that "day" is properly pluralized, depending how many days remain in the year. (french-calendar-leap-year-p): New function. (french-calendar-last-day-of-month): New function. @@ -10222,14 +10222,14 @@ 1990-01-11 Ed Reingold (reingold@emr.cs.uiuc.edu) - * diary.el (list-diary-entries): Deleted several lines of extraneous + * diary.el (list-diary-entries): Delete several lines of extraneous code and added `nongregorian-diary-listing-hook' to the list of hooks called@the end; this is for use in including Hebrew, Islamic, Julian, or ISO diary entries. A similar `nongregorian-diary-marking-hook' was added to the list of hooks called at the end of mark-diary-entries for the same reason. - (diary-name-pattern): Fixed the documentation and added an optional + (diary-name-pattern): Fix the documentation and added an optional parameter FULLNAME which insists on the full spelling of the name; this is also for use in marking Hebrew or Islamic diary entries (those month names are not unique in the first three characters). @@ -10241,8 +10241,8 @@ (list-islamic-diary-entries): New function. (mark-islamic-calendar-date-pattern): New function. - (list-diary-entries): Added nongregorian-diary-listing-hook. - (mark-diary-entries): Added nongregorian-diary-marking-hook. + (list-diary-entries): Add nongregorian-diary-listing-hook. + (mark-diary-entries): Add nongregorian-diary-marking-hook. * calendar.el: Added documentation for the hooks described above. @@ -10256,7 +10256,7 @@ 1990-01-08 Robert J. Chassell (bob@apple-gunkies.ai.mit.edu) * texnfo-upd.el (texinfo-update-node, texinfo-sequential-node-update): - Fixed auto-fill-hook bug. + Fix auto-fill-hook bug. 1990-01-08 Joseph Arceneaux (jla@spiff) @@ -10265,7 +10265,7 @@ 1990-01-08 Ed Reingold (reingold@emr.cs.uiuc.edu) * calendar.el (calendar-date-is-visible-p): - Fixed so it does not switch to the calendar buffer. + Fix so it does not switch to the calendar buffer. * diary.el (prepare-fancy-diary-buffer): Compute the list of holidays only once for each three-month period, not once for each date @@ -10275,12 +10275,12 @@ 1990-01-07 Ed Reingold (reingold@emr.cs.uiuc.edu) * calendar.el: Fixed the value of list-diary-entries-hook. - (regenerate-calendar-window): Changed (update-display) to (sit-for 0). + (regenerate-calendar-window): Change (update-display) to (sit-for 0). Corrected several instances of "dairy" to "diary". - (describe-calendar-mode): Added this function to issue the message + (describe-calendar-mode): Add this function to issue the message "Preparing..." to `?' key in calendar-mode because it's so incredibly slow for describe-mode to prepare the help buffer. - (calendar-holidays): Fixed the examples in the doc-string. + (calendar-holidays): Fix the examples in the doc-string. * diary.el: Corrected several instances of "dairy" to "diary". @@ -10323,7 +10323,7 @@ (calendar-iso-from-absolute): New function. (calendar-absolute-from-iso): New function. - (cursor-to-iso-calendar-date): Added `D' calendar command to give + (cursor-to-iso-calendar-date): Add `D' calendar command to give the day number in the Gregorian year and number of days remaining. (mark-diary-entries): Made two-digit abbreviated years acceptable in diary entries. Changed possible diary entry styles: DAY @@ -10338,11 +10338,11 @@ (all functions containing the word `hebrew'). (list-diary-entries, mark-diary-entries) (include-other-diary-files, mark-included-diary-files): - Added the possibility of `shared diary files' with a recursive + Add the possibility of `shared diary files' with a recursive include mechanism like the C preprocessor. (list-calendar-holidays): Eliminated the 'special class of holidays, rewriting the entire mechanism to make it more general. - (calendar-holiday-function-float): Changed the 'float class of + (calendar-holiday-function-float): Change the 'float class of holidays so that negative values count backward from end of month: 5 is no longer used for the last occurrence of a day in a month; -1 is used instead. @@ -10408,8 +10408,8 @@ 1989-12-11 David Lawrence (tale@cocoa-puffs) - * telnet.el: Converted to use comint. Removed - delete-char-or-send-eof and telnet-copy-last-input. Added + * telnet.el: Converted to use comint. + Removed delete-char-or-send-eof and telnet-copy-last-input. Added telnet-mode-hook. Modified telnet-filter to insert-before-markers at the process-mark. @@ -10418,8 +10418,8 @@ * prolog.el: Converted to use comint. Replaced copy-keymap for copy-alist of comint-mode-map. - * kermit.el: Converted to use comint. Replaced - kermit-clean-filter with a more efficient version. + * kermit.el: Converted to use comint. + Replaced kermit-clean-filter with a more efficient version. * comint.el: Added optional arguments ``terminator'' and ``delete'' to comint-send-input, for processes that want to see @@ -10449,7 +10449,7 @@ 1989-12-05 David Lawrence (tale@wheat-chex) * comint.el (new file): - Added FSF copyright. + Add FSF copyright. Moved bindings off of C-c LETTER. Cleaned up references to cmu* files. Made comint-send-input do unconditional end-of-line before processing. @@ -10594,7 +10594,7 @@ * x-mouse.el (x-paste-text): push-mark before inserting text. (x-insert-selection, x-select): - Moved these functions over from mouse.el. + Move these functions over from mouse.el. 1989-10-12 Richard Stallman (rms@mole.ai.mit.edu) @@ -10768,7 +10768,7 @@ 1989-09-11 Robert J. Chassell (bob@apple-gunkies.ai.mit.edu) * texinfo.el (texinfo-update-node, texinfo-make-menu) - (texinfo-master-menu, texinfo-sequential-node-update): Added functions + (texinfo-master-menu, texinfo-sequential-node-update): Add functions to insert or update the next, previous, and up node pointers in a Texinfo file, or alternatively to insert node pointers as a depth-first traversal---sequentially through the file, each pointing to the next @@ -10953,7 +10953,7 @@ 1989-07-12 Joseph Arceneaux (jla@spiff) - * lisp.el (insert-parentheses): Changed conditions for pre- and + * lisp.el (insert-parentheses): Change conditions for pre- and post- insertion of blanks. * bytecomp.el (byte-compile-file): If current buffer is in @@ -11072,7 +11072,7 @@ 1989-06-08 Joseph Arceneaux (jla@apple-gunkies.ai.mit.edu) - * term/x-win.el (new-screen): Added this function, which is the default + * term/x-win.el (new-screen): Add this function, which is the default auto-screen function. It uses new variables new-screen-x-delta and new-screen-y-delta. (next-multiscreen-window, previous-multiscreen-window): @@ -11200,7 +11200,7 @@ 1989-05-15 Joseph Arceneaux (jla@apple-gunkies.ai.mit.edu) - * tags.el (next-file): Fixed typo: " *next-file*" --> "*next-file*" + * tags.el (next-file): Fix typo: " *next-file*" --> "*next-file*" 1989-05-14 Richard Stallman (rms@mole.ai.mit.edu) @@ -11280,7 +11280,7 @@ confusing and incompatible with xterm. * mouse.el (mouse-scroll, mouse-del-char, mouse-kill-line) - (narrow-window-to-region, mouse-window-to-region): Added these + (narrow-window-to-region, mouse-window-to-region): Add these new functions. 1989-05-08 Richard Stallman (rms@mole.ai.mit.edu) @@ -11439,7 +11439,7 @@ * replace.el (occur-mode-goto-occurrence): Insure arg to count-lines is@start of line. - * replace.el (occur): Removed an extraneous save-excursion. + * replace.el (occur): Remove an extraneous save-excursion. * replace.el (perform-replace): Make ! undo as a unit. @@ -11530,7 +11530,7 @@ (view-exit): Restore old mode from those local variables. Apply specified fn to buffer that was viewed. This is on C-c and q. - (view-command-loop): Deleted. + (view-command-loop): Delete. (view-window-size): Now applies to selected window. * startup.el (normal-top-level): Use PWD envvar to set default dir. @@ -11651,8 +11651,8 @@ (bibtex-enclosing-reference, bibtex-enclosing-regexp, bibtex-flash-entr) (bibtex-flash-head, bibtex-inside-field, bibtex-make-optional-entry) (bibtex-remove-OPT): New functions. - (bibtex-find-it, bibtex-make-OPT-entry, bibtex-next-position): Deleted. - (kill-current-line): Deleted. + (bibtex-find-it, bibtex-make-OPT-entry, bibtex-next-position): Delete. + (kill-current-line): Delete. (bibtex-mode-map): C-c keys to make entries moved to C-c C-e. (general): Use regexps instead of simple-minded cursor motion. New keys include C-c C-p, C-c C-n, C-c C-k, C-c C-d, C-c C-c, TAB, LF. @@ -12400,7 +12400,7 @@ * compile.el (grep): Use grep-command for program. * loaddefs.el (grep-command): New variable. - (compile-command): Moved to compile.el. + (compile-command): Move to compile.el. * c-mode.el (electric-c-terminator): Make insertpos a marker. diff --git a/lisp/ChangeLog.7 b/lisp/ChangeLog.7 index 5636b6355c4..816f6142cf2 100644 --- a/lisp/ChangeLog.7 +++ b/lisp/ChangeLog.7 @@ -13,10 +13,10 @@ * speedbar.el (speedbar-timer-fn): Disable updating if the frame is an icon, or if the user is using the minibuffer. - (speedbar-key-map): Added Q binding to destroy the frame. - (speedbar-easymenu-definition-trailer): Added Quit item. + (speedbar-key-map): Add Q binding to destroy the frame. + (speedbar-easymenu-definition-trailer): Add Quit item. (speedbar-frame-mode): Set the frame position at creation time. - (speedbar-file-unshown-regexp): Added .# lock files. + (speedbar-file-unshown-regexp): Add .# lock files. 1998-08-18 Kenichi Handa <handa@etl.go.jp> @@ -56,8 +56,8 @@ 1998-08-17 Kenichi Handa <handa@etl.go.jp> - * international/mule-cmds.el (set-language-environment): Reset - syntax and case table to the defaults if the value of + * international/mule-cmds.el (set-language-environment): + Reset syntax and case table to the defaults if the value of unibyte-syntax key is nil. 1998-08-16 Richard Stallman <rms@psilocin.ai.mit.edu> @@ -86,8 +86,8 @@ * international/mule-cmds.el (language-info-alist): Doc-string modified. - (set-language-info-alist): Fix typo in doc-string. Update - setup-language-environment-map unconditionally. + (set-language-info-alist): Fix typo in doc-string. + Update setup-language-environment-map unconditionally. (mule-keymap): Key bindings for set-selection-coding-system and set-next-selection-coding-system. (set-coding-system-map): Add items of set-selection-coding-system @@ -110,13 +110,13 @@ 1998-08-14 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de> - * international/mule-cmds.el (select-safe-coding-system): If - default-coding-system is no-conversion return that, it is always + * international/mule-cmds.el (select-safe-coding-system): + If default-coding-system is no-conversion return that, it is always safe. 1998-08-13 Eric Ludlam <zappo@mescaline.gnu.org> - * speedbar.el (speedbar-frame-parameters): Removed scroll-bar-width. + * speedbar.el (speedbar-frame-parameters): Remove scroll-bar-width. 1998-08-13 Richard Stallman <rms@psilocin.ai.mit.edu> @@ -124,9 +124,9 @@ * dired-aux.el (dired-do-rename-regexp): Doc fix. - * midnight.el (midnight-float-time): Renamed from float-time. - (midnight-time-float): Renamed from time-float. - (midnight-buffer-display-time): Renamed from buffer-display-time. + * midnight.el (midnight-float-time): Rename from float-time. + (midnight-time-float): Rename from time-float. + (midnight-buffer-display-time): Rename from buffer-display-time. (midnight-mode): Specify :initialize. Use nil as default value. * complete.el (PC-do-completion): Exclude ./ and ../ from completion. @@ -201,14 +201,14 @@ (read-language-name): Handle the case that the arg KEY is nil. (describe-language-environment): Handle input-method property. - * international/quail.el (quail-start-translation): If - enable-multibyte-characters is nil, convert multibyte character to + * international/quail.el (quail-start-translation): + If enable-multibyte-characters is nil, convert multibyte character to unibyte. (quail-start-conversion): Likewise. * language/: All files under this directory modified as below. - (setup-XXX-environment): Just call set-language-environment. If - they used to do some other jobs than what done by + (setup-XXX-environment): Just call set-language-environment. + If they used to do some other jobs than what done by set-language-environment, those jobs are done in setup-XXX-environment-internal now. ("LANGUAGE-ENVIRONMENT"): Delete property setup-function or change @@ -278,7 +278,7 @@ 1998-08-08 Eric M. Ludlam <zappo@ultranet.com> * speedbar.el (speedbar-edit-line, speedbar-buffer-kill-buffer) - (speedbar-buffer-revert-buffer): Updated buffer finding regex to + (speedbar-buffer-revert-buffer): Update buffer finding regex to handle the [?] tag. (speedbar-find-selected-file): New function. (speedbar-clear-current-file): Uses `speedbar-find-selected-file'. @@ -364,18 +364,18 @@ (quail-start-translation): Handle the case the arg KEY is nil. Bind echo-keystrokes and help-char. Initialize quail-current-str to "". If input-method-use-echo-area is non-nil, call - read-key-sequence with appropriate PROMPT arg. Setup - last-command-event by local variable `keyseq'. Generate an event + read-key-sequence with appropriate PROMPT arg. + Setup last-command-event by local variable `keyseq'. Generate an event list form quail-current-str. If input-method-exit-on-first-char is non-nil, return only the first event. - (quail-start-conversion): Likewise. Initialize - quail-conversion-str to "". Generate an event list form + (quail-start-conversion): Likewise. + Initialize quail-conversion-str to "". Generate an event list form quail-conversion-str. (quail-update-translation): Expect that the function given by (quail-update-translation-function) returns a new control-flag. - Handle the case the length of quail-current-key is 1. Use - string-as-unibyte if enable-multibyte-characters is nil. Always - assures that quail-current-str is Lisp string. + Handle the case the length of quail-current-key is 1. + Use string-as-unibyte if enable-multibyte-characters is nil. + Always assures that quail-current-str is Lisp string. (quail-self-insert-command): Use `or' instead of `unless'. (quail-update-current-translations): Always assures that quail-current-str is Lisp string. @@ -429,14 +429,14 @@ 1998-08-04 Eric Ludlam <zappo@mescaline.gnu.org> - * speedbar.el (speedbar-refresh): Removed special code to remove + * speedbar.el (speedbar-refresh): Remove special code to remove the speedbar update message. Not necessary here. (speedbar-timer-fn): Add code to remove the updating message and thus restore the minibuffer. - (speedbar-center-buffer-smartly): Fixed center error to handle + (speedbar-center-buffer-smartly): Fix center error to handle the whole buffer. (speedbar-delete-subblock): Rewrote to be more robust, less clever. - (speedbar-timer-fn): Removed short display time for messages. + (speedbar-timer-fn): Remove short display time for messages. 1998-08-04 Dave Love <d.love@dl.ac.uk> @@ -445,8 +445,8 @@ 1998-08-04 Eli Zaretskii <eliz@delysid.gnu.org> - * international/mule.el (find-new-buffer-file-coding-system): When - inhibit-eol-conversion is non-nil and the buffer didn't already + * international/mule.el (find-new-buffer-file-coding-system): + When inhibit-eol-conversion is non-nil and the buffer didn't already set a fully-qualified coding system, force -unix eol-type. 1998-08-04 Richard Stallman <rms@psilocin.ai.mit.edu> @@ -469,15 +469,15 @@ 1998-08-03 Eric Ludlam <zappo@mescaline.gnu.org> - * info.el (Info-speedbar-hierarchy-buttons): Improved the speedbar + * info.el (Info-speedbar-hierarchy-buttons): Improve the speedbar frame management. - * speedbar.el (speedbar-update-current-file): Added call to + * speedbar.el (speedbar-update-current-file): Add call to `speedbar-center-buffer-smartly' to improve the display. (speedbar-center-buffer-smartly) Fixed off-by-one error in window height calculation. (speedbar-hack-buffer-menu): New function. - (speedbar-frame-parameters): Removed scroll bar width. + (speedbar-frame-parameters): Remove scroll bar width. (speedbar-frame-mode): Change pointer shape for X and W32 window-systems only. When window-system is pc, bind the speedbar frame name to "Speedbar", and select that frame so it is @@ -488,8 +488,8 @@ (speedbar-directory-buttons-follow): Support both upper- and lower-case drive letters. Use directory-sep-char instead of a literal backslash. - (speedbar-reconfigure-keymaps): Call - `easy-menu-remove' before reconfiguring for a new menu bar. + (speedbar-reconfigure-keymaps): + Call `easy-menu-remove' before reconfiguring for a new menu bar. (speedbar-previous-menu): New Variable. (speedbar-frame-plist): Remove pointers. (speedbar-refresh): Prevent the mark from being deactivated. @@ -505,8 +505,8 @@ * international/kkc.el (kkc-lookup-cache): Initialize it to nil. (kkc-lookup-cache-tag): New constant. - (kkc-lookup-key): If kkc-lookup-cache is nil, initialize it. Use - kkc-init-file-name. + (kkc-lookup-key): If kkc-lookup-cache is nil, initialize it. + Use kkc-init-file-name. (kkc-region): Fix previous change. Call kkc-error on error. (kkc-shorter-conversion, kkc-longer-phrase): New functions. (kkc-keymap): Bind them to "I" and "O" respectively. @@ -547,8 +547,8 @@ * language/cyril-util.el (cyrillic-encode-koi8-r-char): New function. (cyrillic-encode-alternativnyj-char): New function. - * language/cyrillic.el (cyrillic-koi8-r-decode-table): New - variable. + * language/cyrillic.el (cyrillic-koi8-r-decode-table): + New variable. (cyrillic-koi8-r-encode-table): Likewise. (ccl-decode-koi8): Use cyrillic-koi8-r-decode-table. (ccl-encode-koi8): Use cyrillic-koi8-r-encode-table. @@ -558,10 +558,10 @@ charset-origin-alist properties. (cyrillic-alternativnyj-decode-table): New variable. (cyrillic-alternativnyj-encode-table): Likewise. - (ccl-decode-alternativnyj): Use - cyrillic-alternativnyj-decode-table. - (ccl-encode-alternativnyj): Use - cyrillic-alternativnyj-encode-table. + (ccl-decode-alternativnyj): + Use cyrillic-alternativnyj-decode-table. + (ccl-encode-alternativnyj): + Use cyrillic-alternativnyj-encode-table. (ccl-encode-alternativnyj-font): Likewise. (cyrillic-alternativnyj-nonascii-translation-table): New variable. ("Cyrillic-ALT"): Add nonascii-translation-table and @@ -615,8 +615,8 @@ * emacs-lisp/cl-indent.el (lisp-indent-defun-method): New variable. (common-lisp-indent-function): Use it. (lisp-indent-259): Uncomment the `&lambda' code. - (top-level let): Remove duplicate `catch' and `block'. Use - `&lambda' when appropriate. Now the lambda lists are indented + (top-level let): Remove duplicate `catch' and `block'. + Use `&lambda' when appropriate. Now the lambda lists are indented appropriately. 1998-07-30 Richard Stallman <rms@psilocin.ai.mit.edu> @@ -697,7 +697,7 @@ 1998-07-27 Richard Stallman <rms@psilocin.ai.mit.edu> * textmodes/flyspell.el (flyspell-emacs-popup): - Renamed from flyspell-gnuemacs-popup. Callers changed. + Rename from flyspell-gnuemacs-popup. Callers changed. (push): Macro deleted. Callers changed to do it explicitly. (flyspell-incorrect-face, flyspell-duplicate-face): Use defface. (flyspell-incorrect-color): Variable deleted. @@ -705,7 +705,7 @@ (flyspell-underline-p): Variable deleted. (flyspell-font-lock-make-face): Function deleted. (flyspell-mark-duplications-flag): - Renamed from flyspell-doublon-as-error-flag. + Rename from flyspell-doublon-as-error-flag. (flyspell-mode-on): Delete the debugging message. (flyspell-mode-off): Delete the debugging message. (flyspell-mode-on): Set flyspell-generic-check-word-p @@ -796,16 +796,16 @@ 1998-07-25 Kenichi Handa <handa@etl.go.jp> * international/mule.el (auto-coding-alist): New variable. - (set-auto-coding): Argument FILENAME is added. Check - auto-coding-alist at first. + (set-auto-coding): Argument FILENAME is added. + Check auto-coding-alist at first. * international/kkc.el (kkc-region): Unwind-protect the conversion process. (kkc-show-conversion-list-update): Pay attention to the length of kkc-show-conversion-list-index-chars. - * international/mule-cmds.el (find-multibyte-characters): New - function. + * international/mule-cmds.el (find-multibyte-characters): + New function. (select-safe-coding-system): Highlight characters which can't be encoded. Show list of such characters also in *Warning* buffer. @@ -822,10 +822,10 @@ (crisp-last-last-command): Doc fix. (mark-something): Function deleted. (crisp-mark-line): Avoid using mark-something. - (crisp-region-active): Renamed from region-active. - (crisp-set-clipboard): Renamed from copy-primary-selection. - (crisp-kill-region): Renamed from kill-primary-selection. - (crisp-yank-clipboard): Renamed from yank-clipboard-selection. + (crisp-region-active): Rename from region-active. + (crisp-set-clipboard): Rename from copy-primary-selection. + (crisp-kill-region): Rename from kill-primary-selection. + (crisp-yank-clipboard): Rename from yank-clipboard-selection. * files.el (basic-save-buffer-2): New function. (basic-save-buffer-1): Use basic-save-buffer-2, @@ -850,8 +850,8 @@ 1998-07-23 Ken'ichi Handa <handa@melange.gnu.org> - * international/quail.el (quail-start-translation): Call - this-single-command-raw-keys instead of this-single-command-keys. + * international/quail.el (quail-start-translation): + Call this-single-command-raw-keys instead of this-single-command-keys. (quail-start-conversion): Likewise. 1998-07-23 Kenichi Handa <handa@etl.go.jp> @@ -862,8 +862,8 @@ not isearch-printing-char, don't read multibyte chars from minibuffer, but just call isearch-process-search-char. - * international/quail.el (quail-start-translation): Use - this-single-command-keys to get raw events instead of + * international/quail.el (quail-start-translation): + Use this-single-command-keys to get raw events instead of listify-key-sequence. (quail-start-conversion): Likewise. @@ -878,7 +878,7 @@ (imenu-extract-index-name-function, imenu-default-goto-function) (imenu-sort-function, imenu-prev-index-position-function): Likewise. - * ange-ftp.el (ange-ftp-reread-dir): Renamed from `re-read'. + * ange-ftp.el (ange-ftp-reread-dir): Rename from `re-read'. Old name defined as alias. Doc fix. 1998-07-21 Kenichi Handa <handa@etl.go.jp> @@ -888,8 +888,8 @@ (kkc-terminate): Update kkc-overlay-head correctly. (kkc-cancel): Don't call kkc-terminate, but set kkc-converting to nil. - * international/quail.el (quail-simple-translation-keymap): Typo - in doc-string fixed. + * international/quail.el (quail-simple-translation-keymap): + Typo in doc-string fixed. (quail-start-translation): Check start position of quail-overlay before calling quail-overlay-region-events. (quail-start-conversion): Likewise. @@ -915,8 +915,8 @@ * isearch.el (isearch-input-method-function): New variable. (isearch-input-method-local-p): New variable. - (isearch-mode): Setup the above two variable. Set - input-method-function to nil locally. + (isearch-mode): Setup the above two variable. + Set input-method-function to nil locally. (isearch-done): Restore the previous value of input-method-function. @@ -939,7 +939,7 @@ * international/kkc.el (kkc-region): Fix the return value. * international/isearch-x.el - (isearch-toggle-specified-input-method): Adjusted for the change + (isearch-toggle-specified-input-method): Adjust for the change in isearch.el. (isearch-toggle-input-method): Likewise. (isearch-minibuffer-local-map): New variable. @@ -949,8 +949,8 @@ characters from minibuffer with the keymap isearch-minibuffer-local-map. - * international/mule-cmds.el (read-multilingual-string): Don't - activate an input method in the current buffer, but just bind + * international/mule-cmds.el (read-multilingual-string): + Don't activate an input method in the current buffer, but just bind current-input-method. * language/japan-util.el (japanese-replace-region): New function. @@ -964,7 +964,7 @@ 1998-07-17 Simon Marshall <simon@gnu.org> - * lazy-lock.el (lazy-lock-fontify-after-visage): Renamed from + * lazy-lock.el (lazy-lock-fontify-after-visage): Rename from lazy-lock-fontify-after-outline. (lazy-lock-install-hooks): Add it to hs-hide-hook too. (lazy-lock-unstall): Remove it from hs-hide-hook too. @@ -989,14 +989,14 @@ * international/kkc.el (kkc-show-conversion-list-index-chars): Default value changed. - (kkc-keymap): Renamed from kkc-mode-map. Key binding for + (kkc-keymap): Rename from kkc-mode-map. Key binding for kkc-non-kkc-command are deleted. (kkc-mode): This function deleted. (kkc-canceled): This variable deleted. (kkc-converting): New variable. (kkc-region): 3rd optional arg is deleted. Completely rewritten to adjust for the change in quail.el. - (kkc-terminate, kkc-cancel): Adjusted for the change of + (kkc-terminate, kkc-cancel): Adjust for the change of kkc-region. (kkc-non-kkc-command): This function deleted. (kkc-select-from-list): Use last-input-event instead of @@ -1008,16 +1008,16 @@ (quail-current-str, quail-current-translations): Likewise. (quail-reset-conversion-region): This variable deleted. (quail-use-package): Call quail-activate at the tail. - (quail-translation-keymap, quail-simple-translation-keymap): Key - bindings for quail-execute-non-quail-command deleted. + (quail-translation-keymap, quail-simple-translation-keymap): + Key bindings for quail-execute-non-quail-command deleted. (quail-conversion-keymap): Likewise. Add key bindings for quail-self-insert-command. (quail-delete-overlays): Check overlay-start for overlays before deleting them. (quail-mode): This function deleted. (quail-inactivate, quail-activate): New functions. - (quail-saved-current-map, quail-saved-current-buffer): These - variables deleted. + (quail-saved-current-map, quail-saved-current-buffer): + These variables deleted. (quail-toggle-mode-temporarily, quail-execute-non-quail-command): These functions deleted. (quail-exit-conversion-mode, quail-prefix-arg): These variables @@ -1032,9 +1032,9 @@ (quail-start-conversion): New function. (quail-terminate-translation): Just set quail-translating to nil. (quail-update-translation): Put some events back to - unread-input-method-events instead of unread-command-events. Call - quail-error instead of error. - (quail-self-insert-command): Adjusted for the change of + unread-input-method-events instead of unread-command-events. + Call quail-error instead of error. + (quail-self-insert-command): Adjust for the change of quail-start-translation. (quail-next-translation): Don't call quail-execute-non-quail-command, instead, put an event back of @@ -1079,7 +1079,7 @@ (crisp-mode-map): Make this a sparse keymap parented from current-global-map. (crisp-mode-original-keymap): Don't copy the keymap. - (crisp-last-last-command): Renamed from last-last-command. defvar it. + (crisp-last-last-command): Rename from last-last-command. defvar it. (crisp-mode): Honor ARG. (crisp-kill-line, crisp-copy-line): When a region isn't highlighted, @@ -1145,7 +1145,7 @@ 1998-07-12 Richard Stallman <rms@psilocin.ai.mit.edu> * international/mule.el (set-selection-coding-system): - Renamed from set-clipboard-coding-system. + Rename from set-clipboard-coding-system. Set the variable's new name, selection-coding-system. * mail/rmailout.el (rmail-output-to-rmail-file): @@ -1155,9 +1155,9 @@ * speedbspec.el: Deleted; now integrated into speedbar.el. * speedbar.el: More commentary. - (speedbar-xemacsp): Moved definition. - (speedbar-initial-expansion-mode-list): Was - `speedbar-initial-expansion-list' and now has multiple modes. + (speedbar-xemacsp): Move definition. + (speedbar-initial-expansion-mode-list): + Was `speedbar-initial-expansion-list' and now has multiple modes. (speedbar-stealthy-function-list): Now has mode labels. (speedbar-initial-expansion-list-name) (speedbar-previously-used-expansion-list-name) @@ -1165,27 +1165,27 @@ (speedbar-tag-hierarchy-method, speedbar-tag-split-minimum-length) (speedbar-tag-regroup-maximum-length) (speedbar-hide-button-brackets-flag): New variables. - (speedbar-special-mode-expansion-list): Updated documentation. + (speedbar-special-mode-expansion-list): Update documentation. (speedbar-navigating-speed, speedbar-update-speed): Phasing out. - (speedbar-vc-indicator): Removed space from this var. + (speedbar-vc-indicator): Remove space from this var. (speedbar-indicator-separator, speedbar-obj-do-check) (speedbar-obj-to-do-point, speedbar-obj-indicator, speedbar-obj-alist) (speedbar-indicator-regex): New variables. (speedbar-directory-unshown-regexp): New variable. - (speedbar-supported-extension-expressions): Added more extensions. + (speedbar-supported-extension-expressions): Add more extensions. (speedbar-add-supported-extension) (speedbar-add-ignored-path-regexp): Made interactive. (speedbar-update-flag): Nil w/ no window system. - (speedbar-file-key-map): Moved some key bindings from + (speedbar-file-key-map): Move some key bindings from `speedbar-key-map' to this map. (speedbar-make-specialized-keymap): New function. (speedbar-file-key-map): New key map. - (speedbar-easymenu-definition-special): Updated to new functions. - (speedbar-easymenu-definition-trailer): Changed conditional part. - (speedbar-frame-mode): Removed commented code, fixed W32 cursor + (speedbar-easymenu-definition-special): Update to new functions. + (speedbar-easymenu-definition-trailer): Change conditional part. + (speedbar-frame-mode): Remove commented code, fixed W32 cursor bug, Updated to better handle terminal frames. (speedbar-switch-buffer-attached-frame): New function. - (speedbar-mode): Updated documentation, no local keymap, + (speedbar-mode): Update documentation, no local keymap, correct `temp-buffer-show-function' use, enable mouse-tracking. (speedbar-show-info-under-mouse): New function. (speedbar-reconfigure-keymaps): Was `speedbar-reconfigure-menubar'. @@ -1195,9 +1195,9 @@ (speedbar-restricted-move, speedbar-restricted-next) (speedbar-restricted-prev, speedbar-navigate-list) (speedbar-forward-list, speedbar-backward-list): New commands. - (speedbar-refresh): Updated message printing & verbosity. - (speedbar-item-load): Updated message. - (speedbar-item-byte-compile): Updated doc & reset scanners. + (speedbar-refresh): Update message printing & verbosity. + (speedbar-item-load): Update message. + (speedbar-item-byte-compile): Update doc & reset scanners. (speedbar-item-info): Overhauled with more details. (speedbar-item-copy): Update messages. (speedbar-generic-item-info): New function. @@ -1245,7 +1245,7 @@ * mail/rmail.el: No longer depends on speedbspec for byte compile. (rmail-speedbar-match-folder-regexp): New variable. - (rmail-speedbar-menu-items): Updated speedbar menu items. + (rmail-speedbar-menu-items): Update speedbar menu items. (rmail-speedbar-key-map): New keymap. (rmail-install-speedbar-variables): New function. Install speedbar keymap only when speedbar is loaded. @@ -1264,13 +1264,13 @@ * gud.el (gud-speedbar-key-map): New variable. (gud-install-speedbar-variables): New function Install speedbar keymap only when speedbar is loaded. - (gud-gdb-get-stackframe): Added ":" to regex for c++. + (gud-gdb-get-stackframe): Add ":" to regex for c++. 1998-07-09 Sam Steingold <sds@usa.net> * emacs-lisp/cl-indent.el: Indent `handler-case' correctly. - * font-lock.el (lisp-font-lock-keywords): Fontify - `handler-case', `ccase', `ctypecase', `assert', `error'. + * font-lock.el (lisp-font-lock-keywords): + Fontify `handler-case', `ccase', `ctypecase', `assert', `error'. 1998-07-09 Andrew Innes <andrewi@harlequin.co.uk> @@ -1342,8 +1342,8 @@ 1998-07-05 Richard Stallman <rms@psilocin.ai.mit.edu> - * mail/mail-utils.el (rmail-dont-reply-to): Understand - about doublequotes; don't be fooled by commas inside them. + * mail/mail-utils.el (rmail-dont-reply-to): + Understand about doublequotes; don't be fooled by commas inside them. 1998-07-04 Richard Stallman <rms@psilocin.ai.mit.edu> @@ -1378,7 +1378,7 @@ 1998-07-03 Espen Skoglund <espensk@stud.cs.uit.no> - * pascal.el (pascal-insert-block): Fixed space-deletion bug in + * pascal.el (pascal-insert-block): Fix space-deletion bug in front of the "begin" string. (pascal-beg-of-defun): Used to locate the beginning of a function incorrectly when a function contained several begin-end blocks. @@ -1398,7 +1398,7 @@ * dos-vars.el (dos-printer): Obsolete variable deleted. (dos-ps-printer): Likewise. - * dos-w32.el (direct-print-region-function): Renamed from + * dos-w32.el (direct-print-region-function): Rename from dos-print-region-function. Added &rest keyword. (print-region-function): Set to direct-print-region-function. (lpr-headers-switches): Initialize. @@ -1441,12 +1441,12 @@ 1998-07-03 Eric Ludlam <zappo@mescaline.gnu.org> - * emacs-lisp/checkdoc.el (checkdoc): Updated commentary. - (checkdoc-autofix-flag): Updated doc. - (checkdoc-force-docstrings-flag): Updated doc. + * emacs-lisp/checkdoc.el (checkdoc): Update commentary. + (checkdoc-autofix-flag): Update doc. + (checkdoc-force-docstrings-flag): Update doc. (checkdoc-force-history-flag): New flag. - (checkdoc-triple-semi-comment-check-flag): Fixed name. - (checkdoc-spellcheck-documentation-flag): Fixed doc. + (checkdoc-triple-semi-comment-check-flag): Fix name. + (checkdoc-spellcheck-documentation-flag): Fix doc. (checkdoc-ispell-lisp-words): Update default value. (checkdoc-generate-compile-warnings-flag, checkdoc-proper-noun-list) (checkdoc-proper-noun-regexp, checkdoc-symbol-words): New variables. @@ -1458,22 +1458,22 @@ Cursor now sits next to the error, forcing scrolling if needed, and using a better centering algorithm, and much better error navigation after choosing "f"ix. - (checkdoc-next-error): Added parameter ENABLE-FIX. + (checkdoc-next-error): Add parameter ENABLE-FIX. (checkdoc-next-message-error, checkdoc-recursive-edit): New functions. (checkdoc-start): Was `checkdoc', uses new note taking system. (checkdoc-current-buffer, checkdoc-continue, checkdoc-comments): - Updated to use new note taking system. + Update to use new note taking system. (checkdoc-rogue-spaces, checkdoc-rogue-space-check-engine): - Added INTERACT parameter, uses new warnings functions. + Add INTERACT parameter, uses new warnings functions. (checkdoc-message-text, checkdoc-defun): - Updated to use new note taking system. + Update to use new note taking system. (checkdoc-ispell-current-buffer, checkdoc-ispell-interactive): Fix doc. (checkdoc-ispell-message-text, checkdoc-ispell-start): New function. (checkdoc-create-error, checkdoc-error-text, checkdoc-error-start) (checkdoc-error-end, checkdoc-error-unfixable): New functions. - (checkdoc-minor-keymap): Updated keybinds to new interactive functions, + (checkdoc-minor-keymap): Update keybinds to new interactive functions, completely re-arranged the minor-mode menu. - (checkdoc-this-string-valid): Moved no doc-string warning here, + (checkdoc-this-string-valid): Move no doc-string warning here, and added autofix if a comment already exists there. (checkdoc-this-string-valid-engine): Fix doc, robusted doc finder. All previously returned errors now call `checkdoc-create-error'. @@ -1497,7 +1497,7 @@ for history and commentary. All previously returned errors now call `checkdoc-create-error'. Message spelling and format. (checkdoc-message-text-search): - Moved parts to `checkdoc-message-text-next-string'. + Move parts to `checkdoc-message-text-next-string'. (checkdoc-message-text-next-string): New function. (checkdoc-message-text-engine): All previously returned errors now call `checkdoc-create-error'. Can find/skip 'format' call @@ -1506,12 +1506,12 @@ (checkdoc-y-or-n-p): New function. (checkdoc-autofix-ask-replace): Update doc. Protect match-data. Correctly handle `checkdoc-autofix-flag' of 'never. New behavior - with `checkdoc-autofix-flag' of 'automatic-then-never. Better - overlay handling. - (checkdoc-output-font-lock-keywords): Updated to new output format. + with `checkdoc-autofix-flag' of 'automatic-then-never. + Better overlay handling. + (checkdoc-output-font-lock-keywords): Update to new output format. (checkdoc-pending-errors): New variable. - (checkdoc-find-error): Updated to new output format. - (checkdoc-start-section, checkdoc-error): Improved the output. + (checkdoc-find-error): Update to new output format. + (checkdoc-start-section, checkdoc-error): Improve the output. (checkdoc-show-diagnostics): Smarter show algorithm. 1998-07-03 Kenichi Handa <handa@etl.go.jp> @@ -1563,12 +1563,12 @@ * derived.el (derived-mode-hooks-name): Use -hook, not -hooks, in mode hook name. - (derived-mode-hook-name): Renamed from ...-hooks; caller changed. + (derived-mode-hook-name): Rename from ...-hooks; caller changed. 1998-07-01 Ken'ichi Handa <handa@melange.gnu.org> - * international/mule.el (mule-version): Changed to 4.0. - (mule-version-date): Updated. + * international/mule.el (mule-version): Change to 4.0. + (mule-version-date): Update. 1998-06-30 Richard Stallman <rms@psilocin.ai.mit.edu> @@ -1679,7 +1679,7 @@ * language/korea-util.el (isearch-toggle-korean-input-method) (isearch-hangul-switch-symbol-ksc, isearch-hangul-switch-hanja): New functions. - (korean-key-bindings): Renamed from exit-korean-environment-data. + (korean-key-bindings): Rename from exit-korean-environment-data. Initialized appropriately. (setup-korean-environment): Setup key bindings according to korean-key-bindings. @@ -1714,10 +1714,10 @@ of `find-function-noselect'. (find-function-search-for-symbol): `regexp-quote' the symbol name: needed to find-function `mapcar*' for example. - (find-function-noselect): Improved docstring. Don't include + (find-function-noselect): Improve docstring. Don't include `library' in let. Use `symbol-file' instead of `describe-symbol-find-file'. - (find-function-read): Renamed from `find-function-read-function'. + (find-function-read): Rename from `find-function-read-function'. With optional arg now read a variable. (find-function-read): Separate `completing-read' calls for variables and functions. @@ -1746,7 +1746,7 @@ (find-variable-other-window): Remove most of docstring and add reference to `find-variable' instead. (find-variable-other-frame): Ditto. - (find-function-on-key): Simplified. Removed stuff now taken care + (find-function-on-key): Simplify. Removed stuff now taken care of by interactive "k". (find-function-at-point): New function. (find-variable-at-point): Ditto. @@ -1768,7 +1768,7 @@ 1998-06-24 Andrew Innes <andrewi@mescaline.gnu.org> - * dos-w32.el (null-device): Renamed from grep-null-device. + * dos-w32.el (null-device): Rename from grep-null-device. 1998-06-24 Richard Stallman <rms@psilocin.ai.mit.edu> @@ -1795,8 +1795,8 @@ (ange-ftp-generate-anonymous-password): Use `other' widget type. * autoinsert.el (auto-insert, auto-insert-query): Use `other' widget type. - * bookmark.el (bookmark-save-flag, bookmark-version-control): Use - `other' widget type. + * bookmark.el (bookmark-save-flag, bookmark-version-control): + Use `other' widget type. * comint.el (comint-input-autoexpand): Use `other' widget type. * complete.el (PC-first-char): Use `other' widget type. * cus-edit.el (custom-magic-show): Use `other' widget type. @@ -1855,8 +1855,8 @@ 1998-06-23 Ken'ichi Handa <handa@melange.gnu.org> - * international/fontset.el (x-style-funcs-alist): Remove - duplicated code. + * international/fontset.el (x-style-funcs-alist): + Remove duplicated code. 1998-06-23 Richard Stallman <rms@psilocin.ai.mit.edu> @@ -1896,8 +1896,8 @@ `composition'. Add property `jisx0208' to Japanese hankaku characters. (japanese-kana-table): Add more data. (japanese-symbol-table): Change the order of elements. - (japanese-katakana-region): Adjusted for the above changes. Check - character code properties directly here. + (japanese-katakana-region): Adjust for the above changes. + Check character code properties directly here. (japanese-hiragana-region): Likewise. (japanese-hankaku-region): Likewise. (japanese-zenkaku-region): Likewise. @@ -1983,8 +1983,8 @@ 1998-06-20 Kenichi Handa <handa@etl.go.jp> - * international/fontset.el (x-style-funcs-alist): If - x-make-font-demibold or x-make-font-bold return nil, don't try + * international/fontset.el (x-style-funcs-alist): + If x-make-font-demibold or x-make-font-bold return nil, don't try further style modification. * international/encoded-kb.el (encoded-kbd-self-insert-sjis): @@ -2003,8 +2003,8 @@ ethio-mode-map, and function ethio-mode. (exit-ethiopic-environment-data): New variable. (setup-ethiopic-environment): Recode information of changed key - bindings in exit-ethiopic-environment-data. Add - ethio-select-a-translation to quail-mode-hook. + bindings in exit-ethiopic-environment-data. + Add ethio-select-a-translation to quail-mode-hook. (exit-ethiopic-environment): New function. (ethio-find-file): Don't check ethio-mode. (ethio-write-file): Likewise. @@ -2067,7 +2067,7 @@ * international/mule.el (set-auto-coding): Redo the previous change. - * tar-mode.el (tar-extract): Adjusted for the change of the spec + * tar-mode.el (tar-extract): Adjust for the change of the spec of set-auto-coding-function. 1998-06-14 Richard Stallman <rms@psilocin.ai.mit.edu> @@ -2154,8 +2154,8 @@ * faces.el (set-face-font): Pay attention to fontset. (set-face-font-auto): Call resolve-fontset-name. - * international/fontset.el (instantiate-fontset): Delete - duplicated call of x-complement-fontset-spec. Call new-fontset + * international/fontset.el (instantiate-fontset): + Delete duplicated call of x-complement-fontset-spec. Call new-fontset with a correct argument. (x-compose-font-name): Argument name adjusted for the doc-string. (x-complement-fontset-spec): Don't alter the contents of the @@ -2163,8 +2163,8 @@ (x-style-funcs-alist): The format changed. (x-modify-font-name): New function. (create-fontset-from-fontset-spec): The arg STYLE-VARIANT-P is - changed to STYLE-VARIANT, the format also changed. Use - x-modify-font-name instead of calling functions in + changed to STYLE-VARIANT, the format also changed. + Use x-modify-font-name instead of calling functions in x-style-funcs-alist directly. (instantiate-fontset): Use x-modify-font-name instead of calling functions in x-style-funcs-alist directly. @@ -2283,8 +2283,8 @@ 1998-06-09 Ed Reingold <reingold@cs.uiuc.edu> - * calendar/cal-tex.el (cal-tex-list-diary-entries): Set - diary-display-hook correctly. + * calendar/cal-tex.el (cal-tex-list-diary-entries): + Set diary-display-hook correctly. * calendar/cal-menu.el (calendar-mouse-holidays) (calendar-mouse-view-diary-entries) @@ -2342,8 +2342,8 @@ 1998-06-08 Andrew Innes <andrewi@harlequin.co.uk> - * ange-ftp.el (ange-ftp-file-name-completion): Use - ange-ftp-this-dir instead of literal "/" when calling real + * ange-ftp.el (ange-ftp-file-name-completion): + Use ange-ftp-this-dir instead of literal "/" when calling real completion function. 1998-06-08 Richard Stallman <rms@psilocin.ai.mit.edu> @@ -2450,8 +2450,8 @@ 1998-06-05 Andrew Innes <andrewi@harlequin.co.uk> - * jka-compr.el (jka-compr-write-region): Ensure - `last-coding-system-used' is updated, so that basic-save-buffer + * jka-compr.el (jka-compr-write-region): + Ensure `last-coding-system-used' is updated, so that basic-save-buffer sees the right value. 1998-06-05 Richard Stallman <rms@gnu.org> @@ -2531,8 +2531,8 @@ * docref.el: Deleted in view of current approach to doc strings. - * startup.el (normal-top-level-add-subdirs-to-load-path): Ignore - CVS directories too. + * startup.el (normal-top-level-add-subdirs-to-load-path): + Ignore CVS directories too. 1998-06-02 Richard Stallman <rms@gnu.org> @@ -2571,15 +2571,15 @@ 1998-06-01 Per Starbäck <starback@update.uu.se> - * apropos.el (apropos-variable): Fixed argument to apropos-command. + * apropos.el (apropos-variable): Fix argument to apropos-command. (apropos-command): Let `var-predicate' have higher priority than `do-all'. 1998-06-01 Dave Love <fx@gnu.org> * textmodes/sgml-mode.el (sgml-font-lock-keywords-1): Add -. as - NMCHARs. Elide upper case (see font-lock-defaults). Generalize - comment declaration not to exclude markup. + NMCHARs. Elide upper case (see font-lock-defaults). + Generalize comment declaration not to exclude markup. 1998-05-31 Richard Stallman <rms@gnu.org> @@ -2602,8 +2602,8 @@ 1998-05-31 Alan Shutko <shutkoa@ugsolutions.com> - * emacs-lisp/easy-mmode.el (easy-mmode-define-minor-mode): Add - missing format arg. + * emacs-lisp/easy-mmode.el (easy-mmode-define-minor-mode): + Add missing format arg. 1998-05-30 Dave Love <fx@gnu.org> @@ -2626,17 +2626,17 @@ 1998-05-30 Michael Kifer <kifer@cs.sunysb.edu> * ediff-mult.el (ediff-mark-for-hiding-at-pos) - (ediff-mark-for-operation-at-pos): Renamed from + (ediff-mark-for-operation-at-pos): Rename from ediff-mark-for-hiding, ediff-mark-for-operation. (ediff-mark-session-for-hiding, ediff-mark-session-for-operation) - (ediff-unmark-all-for-operation, ediff-unmark-all-for-hiding): New - functions. - (ediff-setup-meta-map): Changed bindings. + (ediff-unmark-all-for-operation, ediff-unmark-all-for-hiding): + New functions. + (ediff-setup-meta-map): Change bindings. * viper-cmd.el (viper-backward-Word, viper-skip-separators): Bugfix. (viper-switch-to-buffer, viper-switch-to-buffer-other-window): Bugfix. * viper-util.el (viper-skip-syntax): Bug fix for eob/bob cases. - * viper-mous.el (viper-surrounding-word): Added '_' to alpha modifiers. + * viper-mous.el (viper-surrounding-word): Add '_' to alpha modifiers. 1998-05-30 Ralph Schleicher <rs@purple.UL.BaWue.DE> @@ -2700,8 +2700,8 @@ 1998-05-27 Ed Reingold <reingold@cs.uiuc.edu> - * calendar/calendar.el (calendar-buffer-list): Add - other-calendars-buffer. + * calendar/calendar.el (calendar-buffer-list): + Add other-calendars-buffer. (calendar-mode): Use activate-menubar-hook only in a window system. 1998-05-27 Dave Love <fx@gnu.org> @@ -2794,13 +2794,13 @@ * emacs-lisp/byte-opt.el (byte-boolean-vars): Add print-escape-nonascii. - * emacs-lisp/autoload.el (generate-file-autoloads): Set - print-escape-nonascii when printing autoload form. + * emacs-lisp/autoload.el (generate-file-autoloads): + Set print-escape-nonascii when printing autoload form. 1998-05-25 Kenichi HANDA <handa@etl.go.jp> - * international/mule.el (set-coding-priority): Call - set-coding-priority-internal at the tail. + * international/mule.el (set-coding-priority): + Call set-coding-priority-internal at the tail. 1998-05-24 Stephen Eglen <stephen@cns.ed.ac.uk> @@ -2924,12 +2924,12 @@ Use translation-table, not character-translation-table, as char-table subtype. (define-translation-table): - Renamed from define-character-translation-table. + Rename from define-character-translation-table. * mule-util.el: Likewise. * mule-conf.el: Likewise. (standard-translation-table-for-decode) (standard-translation-table-for-encode): - Renamed from standard-character-translation-table-... + Rename from standard-character-translation-table-... 1998-05-21 Richard Stallman <rms@psilocin.ai.mit.edu> @@ -2965,17 +2965,17 @@ 1998-05-21 Eli Zaretskii <eliz@mescaline.gnu.org> - * arc-mode.el (archive-file-name-invalid-regexp): Remove. All - users changed to use file-name-invalid-regexp instead. + * arc-mode.el (archive-file-name-invalid-regexp): Remove. + All users changed to use file-name-invalid-regexp instead. * files.el (file-name-invalid-regexp): New variable, moved here from arc-mode.el. 1998-05-21 Richard Stallman <rms@psilocin.ai.mit.edu> * progmodes/vhdl-mode.el (vhdl-customize-colors): - Renamed from vhdl-use-default-colors, and sense reversed. + Rename from vhdl-use-default-colors, and sense reversed. (vhdl-customize-faces): - Renamed from vhdl-use-default-faces, and sense reversed. + Rename from vhdl-use-default-faces, and sense reversed. (vhdl-font-lock-init, vhdl-ps-init): Implement those changes. (vhdl-submit-bug-report): Use new variable names. @@ -2994,10 +2994,10 @@ FONTLIST). (x-style-funcs-alist): New variable. (create-fontset-from-fontset-spec): 2nd optional arg is changed - from STYLE to STYLE-VARIANT-P. The meaning also changed. Delete - unused code. Adjusted for the change of + from STYLE to STYLE-VARIANT-P. The meaning also changed. + Delete unused code. Adjusted for the change of uninstantiated-fontset-alist. - (instantiate-fontset): Adjusted for the change of + (instantiate-fontset): Adjust for the change of uninstantiated-fontset-alist. * international/mule.el (make-coding-system): If ISO2022 based @@ -3039,21 +3039,21 @@ 1998-05-20 Kenichi Handa <handa@etl.go.jp> - * international/fontset.el (x-font-name-charset-alist): New - variable. + * international/fontset.el (x-font-name-charset-alist): + New variable. (register-alternate-fontnames): Doc-string modified. (x-complement-fontset-spec): Likewise. - (x-complement-fontset-spec): Delete unused local variable. Delete - ad hoc code for Latin-1, instead refer to + (x-complement-fontset-spec): Delete unused local variable. + Delete ad hoc code for Latin-1, instead refer to x-font-name-charset-alist. (uninstantiated-fontset-alist): Format changed (BASE-FONTSET -> FONTLIST). (x-style-funcs-alist): New variable. (create-fontset-from-fontset-spec): 2nd optional arg is changed - from STYLE to STYLE-VARIANT-P. The meaning also changed. Delete - unused code. Adjusted for the change of + from STYLE to STYLE-VARIANT-P. The meaning also changed. + Delete unused code. Adjusted for the change of uninstantiated-fontset-alist. - (instantiate-fontset): Adjusted for the change of + (instantiate-fontset): Adjust for the change of uninstantiated-fontset-alist. * international/mule.el (make-coding-system): If ISO2022 based @@ -3083,7 +3083,7 @@ * international/mule-cmds.el: Several doc fixes. (get-language-info, set-language-info): Rename argument. (set-language-info-alist): Likewise. - (find-coding-systems-region-subset-p): Renamed from subset-p. + (find-coding-systems-region-subset-p): Rename from subset-p. (find-coding-systems-region): Use new name. (register-input-method): Rename argument. (activate-input-method): If INPUT-METHOD is nil, deactivate. @@ -3179,13 +3179,13 @@ (checkdoc-message-text-search, checkdoc-message-text-engine): New functions. (checkdoc-this-string-valid-engine): - Added ambiguous function/symbol checking. Added new auto-fix + Add ambiguous function/symbol checking. Added new auto-fix for missing parameters. 1998-05-16 Richard Stallman <rms@psilocin.ai.mit.edu> * international/mule-cmds.el (find-coding-systems-region-subset-p): - Renamed from subset-p. + Rename from subset-p. (find-coding-systems-for-charsets): Call changed. 1998-05-16 Dan Nicolaescu <done@ece.arizona.edu> @@ -3217,7 +3217,7 @@ Use expand-file-name on it. * files.el (temporary-file-directory): - Renamed from system-tmp-directory. + Rename from system-tmp-directory. Value is now a directory name, not a file name. * dired-aux.el (dired-mark-subdir-files): Doc fix. @@ -3298,10 +3298,10 @@ All callers changed. (archive-unique-fname): New function. (archive-maybe-copy): Use it. - (archive-maybe-copy, archive-write-file): Bind - coding-system-for-write to no-conversion. - (archive-maybe-update, archive-mode-revert): Bind - coding-system-for-read to no-conversion. + (archive-maybe-copy, archive-write-file): + Bind coding-system-for-write to no-conversion. + (archive-maybe-update, archive-mode-revert): + Bind coding-system-for-read to no-conversion. (archive-maybe-update): Remain at the same line in the archive listing, after updating the archive. Print the buffer name of the archive to be saved. @@ -3309,8 +3309,8 @@ read-only. Don't set buffer-file-type. Remove the write-contents hook for remote archives. Warn about read-only archives inside other archives. - (archive-write-file-member): Handle remote archives. Restore - value of last-coding-system-used. + (archive-write-file-member): Handle remote archives. + Restore value of last-coding-system-used. (archive-*-write-file-member): Handle archives inside other archives. Save the value of last-coding-system-used. (archive-write-file): New optional variable FILE: where to write @@ -3442,10 +3442,10 @@ 1998-05-08 Richard Stallman <rms@psilocin.gnu.org> - * ps-print.el (ps-alist-position): Renamed from ps-position. + * ps-print.el (ps-alist-position): Rename from ps-position. Look for ITEM as the car of an element. (ps-font-number): Use ps-alist-position. - (ps-font-alist): Renamed from ps-font-list. + (ps-font-alist): Rename from ps-font-list. * mail/reporter.el (reporter-bug-hook): Use rfc822-goto-eoh. @@ -3520,13 +3520,13 @@ 1998-05-06 Sam Steingold <sds@usa.net> - * window.el (quit-window): Fixed FRAME to be the frame and + * window.el (quit-window): Fix FRAME to be the frame and never window. 1998-05-06 Michael Kifer <kifer@cs.sunysb.edu> * ediff-init.el (ediff-highlight-all-diffs, ediff-use-faces): - Changed the defaults. + Change the defaults. 1998-05-06 Richard Stallman <rms@psilocin.gnu.org> @@ -3577,7 +3577,7 @@ 1998-05-05 Simon Marshall <simon@gnu.org> - * font-lock.el (lisp-font-lock-keywords-1): Fixed 1998-04-24 change; + * font-lock.el (lisp-font-lock-keywords-1): Fix 1998-04-24 change; moved defpackage to here from lisp-font-lock-keywords-2. 1998-05-05 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de> @@ -3613,7 +3613,7 @@ Now checks for toolbar support before referring toolbars. * ediff-init.el (ediff-has-toolbar-support-p, ediff-use-toolbar-p): - Moved here from ???. + Move here from ???. * ediff-vers.el (cvs-run-ediff-on-file-descriptor): Set default-directory. @@ -3663,8 +3663,8 @@ * progmodes/compile.el (compilation-directory-stack): Doc fix. (compilation-mode): Accept optional parameter and initialize mode-name from it. - (compile-internal): Pass name-of-mode to compilation-mode. Don't - set mode-name here. + (compile-internal): Pass name-of-mode to compilation-mode. + Don't set mode-name here. (compilation-minor-mode): Don't let mode-line-process change. (compilation-next-error-locus): Use forward-char instead of move-to-column. @@ -3723,11 +3723,11 @@ 1998-05-02 Andre Spiegel <spiegel@inf.fu-berlin.de> - * vc-hooks.el (vc-parse-cvs-status): Optimized. Ignore - "Locally Removed" files. + * vc-hooks.el (vc-parse-cvs-status): Optimize. + Ignore "Locally Removed" files. * vc.el (vc-fetch-cvs-status): Don't specify DIR on the command line. - (vc-dired-hook): Optimized for CVS. + (vc-dired-hook): Optimize for CVS. 1998-05-02 Richard Stallman <rms@psilocin.gnu.org> @@ -3776,19 +3776,19 @@ (file-cache-add-directory): Checks to see if directory exists before adding it. Non-existing directories are simply skipped. - * generic.el (generic): Added defgroup declaration. + * generic.el (generic): Add defgroup declaration. (generic-make-keywords-list): Uses regexp-opt. (generic-mode-set-font-lock): Uses regexp-opt. - * generic-x.el (generic-x): Added defgroup declaration. + * generic-x.el (generic-x): Add defgroup declaration. - * generic-x.el (generic-bat-mode-setup-function): Fixed comment-start + * generic-x.el (generic-bat-mode-setup-function): Fix comment-start variable. - * generic-x.el (generic-define-mswindows-modes): Enable - hosts-generic-mode and apache-generic-mode. + * generic-x.el (generic-define-mswindows-modes): + Enable hosts-generic-mode and apache-generic-mode. (generic-define-unix-modes): Enable alias-generic-mode. - (java-properties-generic-mode): Changed regexp to allow property + (java-properties-generic-mode): Change regexp to allow property and value to be separated by whitespace or an equal sign. (alias-generic-mode): Check generic-extras-enable-list before defining this mode. @@ -3815,8 +3815,8 @@ (universal-coding-system-argument): Use buffer-file-coding-system as default. - * international/quail.el (quail-show-translations): Show - followable keys in alphabetic order. + * international/quail.el (quail-show-translations): + Show followable keys in alphabetic order. 1998-04-29 Richard Stallman <rms@psilocin.gnu.org> @@ -3937,10 +3937,10 @@ (ispell-dictionary-alist): Now customizable. Fixed type of custom variables: ispell-help-in-bufferp. (ispell-use-framepop-p): New variable. - (ispell-dictionary-alist): Added dictionaries: castellano, castellano8 + (ispell-dictionary-alist): Add dictionaries: castellano, castellano8 czech, esperanto, esperanto-tex, norsk, russian. Capitalize XEmacs correctly, and change lucid to xemacs in code. - (ispell-menu-lucid): Renamed to ispell-menu-xemacs. + (ispell-menu-lucid): Rename to ispell-menu-xemacs. Changed string compares for version number to be correct for XEmacs. Fixed to work with string properties. (ispell-recursive-edit-marker): New marker saving return point. @@ -4003,7 +4003,7 @@ 1998-04-28 Inge Frick <inge@nada.kth.se> - * emacs-lisp/easymenu.el (easy-menu-define-key): Fixed bug with BEFORE + * emacs-lisp/easymenu.el (easy-menu-define-key): Fix bug with BEFORE argument. Now it works also if you repeat an identical call to easy-menu-define-key. @@ -4099,7 +4099,7 @@ * emacs-lisp/cl-indent.el: Indent defpackage correctly. - * font-lock.el (lisp-font-lock-keywords-2): Added `defpackage'. + * font-lock.el (lisp-font-lock-keywords-2): Add `defpackage'. 1998-04-23 Geoff Voelker <voelker@cs.washington.edu> @@ -4126,17 +4126,17 @@ * easymenu.el: Use new menu item format. Don't simulate button prefix. (easy-menu-create-menu): Understand also keywords :active, :label and :visible. Don't worry about button prefix. - (easy-menu-button-prefix): Modified value. + (easy-menu-button-prefix): Modify value. (easy-menu-do-add-item): Extensive changes to use new menu item format. (easy-menu-define-key, easy-menu-always-true): New functions. - (easy-menu-make-symbol): Don't use indirection for symbols. Property - `menu-alias' not set. - (easy-menu-filter, easy-menu-update-button): Deleted. + (easy-menu-make-symbol): Don't use indirection for symbols. + Property `menu-alias' not set. + (easy-menu-filter, easy-menu-update-button): Delete. (easy-menu-add-item): Don't worry about button prefix. - (easy-menu-remove-item): Don't worry about button prefix. Use - `easy-menu-define-key'. - (easy-menu-is-button, easy-menu-have-button): Deleted. - (easy-menu-real-binding, easy-menu-change-prefix): Deleted. + (easy-menu-remove-item): Don't worry about button prefix. + Use `easy-menu-define-key'. + (easy-menu-is-button, easy-menu-have-button): Delete. + (easy-menu-real-binding, easy-menu-change-prefix): Delete. 1998-04-23 Richard Stallman <rms@psilocin.gnu.org> @@ -4177,8 +4177,8 @@ 1998-04-22 Eli Zaretskii <eliz@delysid.gnu.org> - * term/pc-win.el (x-select-text, x-get-selection-value): Replace - win16 with w16. + * term/pc-win.el (x-select-text, x-get-selection-value): + Replace win16 with w16. 1998-04-22 Dave Love <fx@gnu.org> @@ -4244,9 +4244,9 @@ 1998-04-20 Piet van Oostrum <piet@cs.ruu.nl> - * smtpmail.el (smtpmail-send-it): Deleted all code related + * smtpmail.el (smtpmail-send-it): Delete all code related to Resent-To: processing. - (smtpmail-deduce-address-list): Changed the search for + (smtpmail-deduce-address-list): Change the search for Resent-\(To\|Cc\|Bcc\) headers. (smtpmail-do-bcc): Delete Resent-Bcc: headers. @@ -4308,11 +4308,11 @@ 1998-04-20 Kenichi Handa <handa@etl.go.jp> - * international/ccl.el (ccl-compile-unify-character): Inhibit - unification tables specified by integer value. + * international/ccl.el (ccl-compile-unify-character): + Inhibit unification tables specified by integer value. (ccl-compile-translate-single-map): Likewise. (ccl-compile-multiple-map-function): Likewise. - (ccl-compile-translate-multiple-map): Modified for nested tables. + (ccl-compile-translate-multiple-map): Modify for nested tables. (ccl-dump-iterate-multiple-map): Handle the case that ID is not integer. (ccl-dump-translate-multiple-map): Likewise. @@ -4323,8 +4323,8 @@ * international/mule.el (make-coding-system): If TYPE is 4, FLAGS can be a cons of CCL-PROGRAM symbols. - * international/quail.el (quail-start-translation): Bind - prefix-arg to current-prefix-arg. + * international/quail.el (quail-start-translation): + Bind prefix-arg to current-prefix-arg. (quail-mode): Doc-string modified. * language/cyrillic.el: FLAGS arguments for make-coding-system @@ -4367,7 +4367,7 @@ * which-func.el (which-func): Add defgroup. - * emacs-lisp/checkdoc.el (checkdoc): Added :version. + * emacs-lisp/checkdoc.el (checkdoc): Add :version. * play/gametree.el (gametree): Likewise. @@ -4442,8 +4442,8 @@ (ange-ftp-file-name-all-completions): Handle Windows filenames. (file-name-handler-alist) [windows-nt]: Add patterns for name with drive letters. - (ange-ftp-dired-call-process, ange-ftp-call-chmod): Use - dired-chmod-program. + (ange-ftp-dired-call-process, ange-ftp-call-chmod): + Use dired-chmod-program. (ange-ftp-disable-netrc-security-check) [windows-nt]: Disable by default. (ange-ftp-real-expand-file-name-actual): New function. @@ -4504,8 +4504,8 @@ (cperl-beautify-levels): New command. (cperl-electric-keyword): Allow here-docs contain `=head1' and friends for keyword expansion. - Fix for broken `font-lock-unfontify-region-function'. Should - preserve `syntax-table' properties even with `lazy-lock'. + Fix for broken `font-lock-unfontify-region-function'. + Should preserve `syntax-table' properties even with `lazy-lock'. (cperl-indent-region-fix-else): New command. (cperl-fix-line-spacing): New command. (cperl-invert-if-unless): New command (C-c C-t and in Menu). @@ -4517,7 +4517,7 @@ Workaround for another `font-lock's `syntax-table' text-property bug. `zerop' could be applied to nil. At last, may work with `font-lock' without setting `cperl-font-lock'. - (cperl-indent-region-fix-constructs): Renamed from + (cperl-indent-region-fix-constructs): Rename from `cperl-indent-region-fix-constructs'. (cperl-fix-line-spacing): Could be triggered inside strings, would not know what to do with BLOCKs of map/printf/etc. @@ -4535,9 +4535,9 @@ (cperl-set-style-back): Old value of style is memorized when choosing a new style, may be restored from the same menu. Mode-documentation added to micro-docs. - (cperl-praise): Updated. + (cperl-praise): Update. (cperl-toggle-construct-fix): New command. Added on C-c C-w and menu. - (auto-fill-mode): Added on C-c C-f and menu. + (auto-fill-mode): Add on C-c C-f and menu. (cperl-style-alist): `PerlStyle' style added. (cperl-find-pods-heres): Message for termination of scan corrected. (cperl-speed): New variable with hints. @@ -4592,8 +4592,8 @@ * arc-mode.el (archive-extract-by-stdout): Don't use binary-process-output. Bind coding-system-for-read `undecided', - so coding system is determined on the fly. Bind - inherit-process-coding-system to t. + so coding system is determined on the fly. + Bind inherit-process-coding-system to t. (archive-dos-members): Remove. (archive-extract): Don't call archive-check-dos. Handle pkunzip errors. @@ -4690,7 +4690,7 @@ * vc.el (vc-next-action-on-file): Don't check out after registering. This is two steps instead of one, and the second does not make sense under CVS. - (vc-next-action): Changed doc string to reflect the above. + (vc-next-action): Change doc string to reflect the above. 1998-04-14 Andreas Schwab <schwab@mescaline.gnu.org> @@ -4804,7 +4804,7 @@ 1998-04-09 Andre Spiegel <spiegel@inf.fu-berlin.de> - * vc.el (vc-next-action): Fixed bug that prevented registering + * vc.el (vc-next-action): Fix bug that prevented registering files using C-x v v. 1998-04-09 Stephen Eglen <stephen@gnu.org> @@ -4843,7 +4843,7 @@ * gud.el (jdb): Do proper analysis of classes defined in a Java source. This removes the restriction of one class per file. - (gud-jdb-package-of-file): Removed. Replaced with parsing routines. + (gud-jdb-package-of-file): Remove. Replaced with parsing routines. (gud-jdb-skip-whitespace): New function. (gud-jdb-skip-single-line-comment): New function. (gud-jdb-skip-traditional-or-documentation-comment): New function. @@ -4914,7 +4914,7 @@ (fortran-mode): Make `fill-column' buffer-local; set `fill-paragraph-function', `indent-region-function', `indent-line-function'. - (calculate-fortran-indent): Renamed to `fortran-calculate-indent'. + (calculate-fortran-indent): Rename to `fortran-calculate-indent'. (fortran-split-line): Simplify. (fortran-remove-continuation): New function. (fortran-join-line): Use it. @@ -4967,18 +4967,18 @@ * language/japanese.el: Set exit-function to exit-japanese-environment for Japanese environment. - * language/japan-util.el (setup-japanese-environment): Setup - sentence-end suitable for Japanese text. + * language/japan-util.el (setup-japanese-environment): + Setup sentence-end suitable for Japanese text. (exit-japanese-environment): New function. - * international/mule-cmds.el (subset-p): Renamed from + * international/mule-cmds.el (subset-p): Rename from find-safe-coding-system-list-subset-p. - (find-coding-systems-region, find-coding-systems-string): New - functions. - (find-coding-systems-for-charsets): Renamed from + (find-coding-systems-region, find-coding-systems-string): + New functions. + (find-coding-systems-for-charsets): Rename from find-safe-coding-system. This is now a helper function of the above two. - (select-safe-coding-system): Adjusted for the above changes. + (select-safe-coding-system): Adjust for the above changes. 1998-04-05 Per Abrahamsen <abraham@dina.kvl.dk> @@ -4997,14 +4997,14 @@ hook, not a local variable. * vc.el (vc-merge, vc-backend-merge): New functions. - (vc-resolve-conflicts): Added optional parameters for buffer names. + (vc-resolve-conflicts): Add optional parameters for buffer names. (vc-branch-p): New function. - * vc-hooks.el (vc-prefix-map): Added "m" for vc-merge. + * vc-hooks.el (vc-prefix-map): Add "m" for vc-merge. * vc.el (vc-ensure-vc-buffer): New function. - (vc-registration-error): Replaced by the above. Updated all callers. - (file-executable-p-18, file-regular-p-18): Removed. + (vc-registration-error): Replace by the above. Updated all callers. + (file-executable-p-18, file-regular-p-18): Remove. 1998-04-05 Richard Stallman <rms@psilocin.gnu.org> @@ -5066,15 +5066,15 @@ 1998-04-03 Andre Spiegel <spiegel@inf.fu-berlin.de> * vc-hooks.el (vc-parse-cvs-status): New function. - (vc-fetch-master-properties): Moved cvs status retrieval to + (vc-fetch-master-properties): Move cvs status retrieval to the above. (vc-backend): If a file is not registered, remember that by setting the property to `none'. (vc-name): Use the mechanism of vc-backend to compute the value. (vc-after-save): Don't access vc-backend property directly. - * vc.el (vc-next-action-dired): Use dired-do-redisplay. Handle - window configuration correctly. + * vc.el (vc-next-action-dired): Use dired-do-redisplay. + Handle window configuration correctly. (vc-next-action): Save window configuration for vc-next-action-dired. (vc-finish-logentry): Only kill log buffer if it does exist. (vc-dired-mode): Rewritten so that it works entirely through @@ -5082,9 +5082,9 @@ ordinary dired. (vc-dired-hook): New function. (vc-state-info, vc-dired-reformat-line): Adapted. - (vc-dired-update, vc-dired-update-line): Removed. + (vc-dired-update, vc-dired-update-line): Remove. (vc-directory): Rewritten. - (vc-directory-18): Removed. + (vc-directory-18): Remove. (vc-dired-mark-locked): New function, bound to "*l" in vc-dired-mode. (vc-do-command): Only compute vc-name if it is really needed. (vc-fetch-cvs-status): New function. @@ -5121,7 +5121,7 @@ * help.el: Make hyperlinks for cross-reference info intuited from *Help* buffer. - (help-font-lock-keywords): Removed. + (help-font-lock-keywords): Remove. (help-mode-map): Define keys for navigating hyperlinks. (help-xref-stack, help-xref-stack-item): New permanent-local variables. @@ -5138,8 +5138,8 @@ New variables. (help-setup-xref, help-make-xrefs, help-xref-button) (help-xref-interned, help-xref-mode, help-follow-mouse) - (help-xref-go-back, help-go-back, help-follow, help-next-ref): New - functions. + (help-xref-go-back, help-go-back, help-follow, help-next-ref): + New functions. 1998-04-02 Richard Stallman <rms@psilocin.gnu.org> @@ -5216,7 +5216,7 @@ (iswitchb-complete): Use iswitchb-common-match-string rather than recomputing the value. (iswitchb-toggle-ignore): Recompute list of buffers. - (iswitchb-init-XEmacs-trick): Renamed from iswitchb-init-Xemacs-trick. + (iswitchb-init-XEmacs-trick): Rename from iswitchb-init-Xemacs-trick. 1998-03-31 Andre Spiegel <spiegel@inf.fu-berlin.de> @@ -5300,8 +5300,8 @@ 1998-03-25 Simon Marshall <simon@gnu.org> - * font-lock.el (c-font-lock-keywords-2): Added "sizeof". - (c++-font-lock-keywords-2): Added "export" and "typename". + * font-lock.el (c-font-lock-keywords-2): Add "sizeof". + (c++-font-lock-keywords-2): Add "export" and "typename". * lazy-lock.el (lazy-lock-fontify-after-scroll) (lazy-lock-fontify-after-trigger): Use new window-end UPDATE arg @@ -5324,8 +5324,8 @@ 1998-03-23 Andreas Schwab <schwab@gnu.org> - * xt-mouse.el (xterm-mouse-translate, xterm-mouse-event): Replace - obsolete `concat with integer' by format. + * xt-mouse.el (xterm-mouse-translate, xterm-mouse-event): + Replace obsolete `concat with integer' by format. * rsz-mini.el (resize-minibuffer-mode): Make it a proper minor mode: toggle resize-minibuffer mode when called without argument. @@ -5341,8 +5341,8 @@ 1998-03-22 Johan Vromans <jvromans@squirrel.nl> - * complete.el (PC-expand-many-files): Apply - completion-ignored-extensions. + * complete.el (PC-expand-many-files): + Apply completion-ignored-extensions. 1998-03-21 Richard Stallman <rms@psilocin.gnu.org> @@ -5361,8 +5361,8 @@ when user tries to check-in, but file on disk has changed. (vc-do-command): Rewrote doc string. Consider LAST argument only if FILE is non-nil. - (vc-add-triple, vc-record-rename, vc-lookup-file): Find - vc-name-assoc-file based on vc-name of FILE. + (vc-add-triple, vc-record-rename, vc-lookup-file): + Find vc-name-assoc-file based on vc-name of FILE. (vc-backend-admin, vc-rename-file): Handle the SCCS PROJECTDIR feature. @@ -5406,8 +5406,8 @@ 1998-03-18 Dave Love <fx@gnu.org> - * emacs-lisp/lisp-mode.el (lisp-fill-paragraph): Adjust - paragraph-start in default filling case so that filling doc + * emacs-lisp/lisp-mode.el (lisp-fill-paragraph): + Adjust paragraph-start in default filling case so that filling doc strings works. 1998-03-18 Andre Spiegel <spiegel@inf.fu-berlin.de> @@ -5446,9 +5446,9 @@ 1998-03-16 Peter Breton <pbreton@ne.mediaone.net> * generic-x.el: Customize. - (fvwm-generic-mode): Added new keywords, and .fvwm2rc config file. - (ini-generic-mode): Changed regexps so that value can contain equal signs. - (java-manifest-generic-mode): Added new keywords. + (fvwm-generic-mode): Add new keywords, and .fvwm2rc config file. + (ini-generic-mode): Change regexps so that value can contain equal signs. + (java-manifest-generic-mode): Add new keywords. 1998-03-16 Alfred Correira <ACorreir@pervasive-sw.com> @@ -5496,9 +5496,9 @@ * locate.el (locate-current-line-number): No longer interactive. * dirtrack.el: Customized. - (dirtrack-forward-slash): Renamed from `forward-slash'. - (dirtrack-backward-slash): Renamed from `backward-slash'. - (dirtrack-replace-slash): Renamed from `replace-slash'. + (dirtrack-forward-slash): Rename from `forward-slash'. + (dirtrack-backward-slash): Rename from `backward-slash'. + (dirtrack-replace-slash): Rename from `replace-slash'. * emacs-lisp/elp.el (elp-version): Now 3.2. @@ -5587,17 +5587,17 @@ (undo-start): New args BEG and END. (undo): If arg or active region, pass args to undo-start. - * mouse.el (mouse-buffer-menu-maxlen): Renamed from + * mouse.el (mouse-buffer-menu-maxlen): Rename from mouse-menu-buffer-maxlen. 1998-03-10 Eric M. Ludlam <zappo@ultranet.com> - * checkdoc.el (checkdoc-continue): Removed check for doc string. + * checkdoc.el (checkdoc-continue): Remove check for doc string. (checkdoc-this-string-valid-engine): Smarter keycode check regexp. 1998-03-10 Carsten Dominik <cd@delysid.gnu.org> - * textmodes/reftex.el (reftex-mode-map): Added keybinding for + * textmodes/reftex.el (reftex-mode-map): Add keybinding for `reftex-mouse-view-crossref' to `S-mouse-2'. 1998-03-09 Carsten Dominik <cd@delysid.gnu.org> @@ -5634,7 +5634,7 @@ 1998-03-08 Carsten Dominik <cd@gnu.org> * textmodes/reftex.el (reftex-offer-label-menu) - (reftex-select-item): Removed match-everywhere interpretation. + (reftex-select-item): Remove match-everywhere interpretation. 1998-03-08 Carsten Dominik <cd@gnu.org> @@ -5660,8 +5660,8 @@ (vc-resynch-buffer): When operating on the current buffer, don't use save-excursion, because that would undo the effects of the above functions. - (vc-clear-headers): Fixed regexp. - (vc-resynch-window): Deleted code that removed vc-find-file-hook + (vc-clear-headers): Fix regexp. + (vc-resynch-window): Delete code that removed vc-find-file-hook temporarily. This was unnecessary, because find-file-hooks are not called when the buffer is reverted. @@ -5671,7 +5671,7 @@ 1998-03-07 Richard Stallman <rms@psilocin.gnu.org> - * subr.el (read-passwd): Renamed from read-password. + * subr.el (read-passwd): Rename from read-password. New second arg CONFIRM. * wid-edit.el (widget-choice-value-create): If there is an @@ -5684,7 +5684,7 @@ * dos-fns.el, find-file.el, follow.el, ispell4.el, shadowfile.el: * tempo.el, tmm.el, vcursor.el, xscheme.el: Customize. -1998-03-06 Barry A. Warsaw <cc-mode-help@python.org> +1998-03-06 Barry A. Warsaw <bwarsaw@cnri.reston.va.us> * Release 5.21 @@ -5697,7 +5697,7 @@ * progmodes/cc-engine.el (c-inside-bracelist-p): Fix for enum test. * progmodes/cc-mode.el (c-initialize-cc-mode): - Moved require's to top level. + Move require's to top level. * progmodes/cc-cmds.el (c-fill-paragraph): Bind fill-paragraph-function to nil when calling fill-paragraph, @@ -5711,8 +5711,8 @@ the same relative position. Fill comment before point if there's nothing else on the same line. Fill block comments after code a little better. Try harder to find a good fill-prefix when point - is on a block comment ender line. Use - c-Java-javadoc-paragraph-start in block comments in Java mode. + is on a block comment ender line. + Use c-Java-javadoc-paragraph-start in block comments in Java mode. Leave block comment ender alone when c-hanging-comment-ender-p is nil and point is on that line. Detect paragraph-separate in multiparagraph comments. Fix for bug that may strip the `*' off @@ -5733,8 +5733,8 @@ always bol. It's always bol when on the top level, however. Changed cases: 5A.5, 5I, 14A. - * progmodes/cc-engine.el (c-forward-token-1, c-backward-token-1): New - functions to move by tokens. + * progmodes/cc-engine.el (c-forward-token-1, c-backward-token-1): + New functions to move by tokens. (c-guess-basic-syntax): Fixes for Java 1.1 array initialization brace lists. @@ -5791,19 +5791,19 @@ 1998-03-06 Kenichi Handa <handa@etl.go.jp> - * international/titdic-cnv.el (titdic-convert): Use - set-buffer-multibyte. + * international/titdic-cnv.el (titdic-convert): + Use set-buffer-multibyte. * international/quail.el (quail-defrule-internal): New arg REPLACE. (quail-defrule): Call quail-defrule-internal with REPLACE t. 1998-03-05 Peter Breton <pbreton@ne.mediaone.net> - * generic.el (generic-mode-ini-file-find-file-hook): Use - and-s instead of if-s. - (generic-use-find-file-hook): Changed from defvar to defcustom. - (generic-lines-to-scan): Changed from defvar to defcustom. - (generic-find-file-regexp): Changed from defvar to defcustom. + * generic.el (generic-mode-ini-file-find-file-hook): + Use and-s instead of if-s. + (generic-use-find-file-hook): Change from defvar to defcustom. + (generic-lines-to-scan): Change from defvar to defcustom. + (generic-find-file-regexp): Change from defvar to defcustom. 1998-03-05 Ivar Rummelhoff <ivarr@ifi.uio.no> @@ -5829,14 +5829,14 @@ configuration if the same command (changing the window configuration) is applied several times in a row. - * winner.el (winner-switch): Removed the command + * winner.el (winner-switch): Remove the command `winner-switch' (and the variables connected to it), since because of the change above, any "switching package" may now be used without disturbing winner-mode too much. * winner.el: Use list syntax for key definitions. - * winner.el (winner-change-fun): Removed the pushnew + * winner.el (winner-change-fun): Remove the pushnew command, so that `cl' will not have to be loaded. * winner.el (winner-set-conf): Introduced "wrapper" around @@ -5969,12 +5969,12 @@ * subr.el (sref): Typo in doc-string fixed. - * international/mule-cmds.el (set-default-coding-systems): Set - default-file-name-coding-system. Doc-string modified. + * international/mule-cmds.el (set-default-coding-systems): + Set default-file-name-coding-system. Doc-string modified. (prefer-coding-system): Doc-string modified. - * language/japan-util.el (setup-japanese-environment): Set - default-file-name-coding-system to japanese-iso-8bit. + * language/japan-util.el (setup-japanese-environment): + Set default-file-name-coding-system to japanese-iso-8bit. 1998-03-02 Richard Stallman <rms@psilocin.gnu.org> @@ -6004,18 +6004,18 @@ 1998-03-01 Peter Breton <pbreton@ne.mediaone.net> * locate.el (locate-update): New function. - (locate-current-line-number): Renamed from `current-line'. + (locate-current-line-number): Rename from `current-line'. (locate-default-make-command-line): Use list, not cons. - (locate): Added a `save-window-excursion' form. + (locate): Add a `save-window-excursion' form. (locate): Used an `apply' form for the start-process call. (locate-mode): Now has a `revert-buffer-function'. (locate-do-setup): Now longer deletes window. (locate-header-face): Use underline, not region. (locate-update-command): New option. - (locate-command): Changed from defvar to defcustom. - (locate-make-command-line): Changed from defvar to defcustom. - (locate-fcodes-file): Changed from defvar to defcustom. - (locate-mouse-face): Changed from defvar to defcustom. + (locate-command): Change from defvar to defcustom. + (locate-make-command-line): Change from defvar to defcustom. + (locate-fcodes-file): Change from defvar to defcustom. + (locate-mouse-face): Change from defvar to defcustom. 1998-02-28 Richard Stallman <rms@psilocin.gnu.org> @@ -6048,8 +6048,8 @@ 1998-02-27 Karl Heuer <kwzh@gnu.org> * dired-x.el (dired-do-toggle): Function moved to dired.el. - * dired.el (dired-do-toggle): Moved here from dired-x.el. - (dired-mode-map): Changed dired-do-toggle from "T" to "t". + * dired.el (dired-do-toggle): Move here from dired-x.el. + (dired-mode-map): Change dired-do-toggle from "T" to "t". 1998-02-27 Carsten Dominik <dominik@strw.LeidenUniv.nl> @@ -6090,21 +6090,21 @@ (custom-save-delete): Use it. (custom-save-all): Use it. - * shell.el (shell-dirtrack-mode): Renamed from shell-dirtrack-toggle. - (dirtrack-mode, shell-dirtrack-toggle): Defined as aliases. + * shell.el (shell-dirtrack-mode): Rename from shell-dirtrack-toggle. + (dirtrack-mode, shell-dirtrack-toggle): Define as aliases. 1998-02-25 Carsten Dominik <dominik@strw.LeidenUniv.nl> * textmodes/reftex.el (reftex-toc-mode, reftex-select-label-mode) (reftex-select-bib-mode): New major modes for RefTeX's special buffers. (reftex-offer-label-menu): Put selection buffer into - `reftex-select-label-mode'. Make selection buffer read-only. Use - `reftex-erase-buffer'. + `reftex-select-label-mode'. Make selection buffer read-only. + Use `reftex-erase-buffer'. (reftex-do-citation): Put selection buffer into - `reftex-select-bib-mode'. Make selection buffer read-only. Use - `reftex-erase-buffer'. Set `reftex-select-return-marker'. - (reftex-toc): Put *toc* buffer into reftex-toc-mode. Add - mouse-face property. + `reftex-select-bib-mode'. Make selection buffer read-only. + Use `reftex-erase-buffer'. Set `reftex-select-return-marker'. + (reftex-toc): Put *toc* buffer into reftex-toc-mode. + Add mouse-face property. (reftex-select-item): Use recursive edit instead of selfmade command loop. Removed unnecessary local bindings. Changed the tag for catch, to avoid problems with `exit' tag in @@ -6126,13 +6126,13 @@ (reftex-select-search-backward, reftex-select-search) (reftex-select-scroll-up, reftex-select-scroll-down) (reftex-scroll-other-window, reftex-scroll-other-window-down) - (reftex-empty-toc-buffer): Removed obsolete functions. - (reftex-highlight-overlays): Removed obsolete 3rd overlay. - (reftex-select-label-map, reftex-select-bib-map): Removed obsolete + (reftex-empty-toc-buffer): Remove obsolete functions. + (reftex-highlight-overlays): Remove obsolete 3rd overlay. + (reftex-select-label-map, reftex-select-bib-map): Remove obsolete bindings, added mouse bindings, `digit-argument', `negative-argument', `reftex-select-show-insertion-point'. (reftex-erase-buffer): BUFFER now defaults to current buffer. - (reftex-label-alist-builtin): Added sidecap packages support. + (reftex-label-alist-builtin): Add sidecap packages support. (reftex-last-follow-point, reftex-select-return-marker): New variables. (reftex-toc, reftex-select-item): Set `reftex-last-follow-point'. (reftex-toc-post-command-hook): Use `reftex-last-follow-point'. @@ -6208,7 +6208,7 @@ * font-lock.el (font-lock-constant-face): Variable and face renamed from font-lock-reference-face. - (font-lock-reference-face): Changed value to font-lock-constant-face. + (font-lock-reference-face): Change value to font-lock-constant-face. * add-log.el: * dired.el: @@ -6246,12 +6246,12 @@ 1998-02-19 Kenichi Handa <handa@etl.go.jp> * international/mule.el - (after-insert-file-set-buffer-file-coding-system): Call - set-buffer-multibyte instead of directly setting + (after-insert-file-set-buffer-file-coding-system): + Call set-buffer-multibyte instead of directly setting enable-multibyte-characters to nil. - * language/china-util.el (setup-chinese-cns-environment): Correct - the setting of default-input-method. + * language/china-util.el (setup-chinese-cns-environment): + Correct the setting of default-input-method. * international/mule-cmds.el (select-safe-coding-system): Kill the warning buffer before returning. @@ -6294,7 +6294,7 @@ * info-look.el (info-complete): Rewrite minibuffer completion code. * info-look.el (info-lookup-minor-mode, turn-on-info-lookup): - Added minor mode interface. + Add minor mode interface. (info-lookup-minor-mode-string): New variable. (info-lookup-minor-mode-map): New variable. @@ -6305,8 +6305,8 @@ (info-lookup-highlight-face): Variables customized. * info-look.el (info-lookup-alist): No longer customizable. - (info-lookup-add-help, info-lookup-maybe-add-help): Interface - functions for adding new modes. + (info-lookup-add-help, info-lookup-maybe-add-help): + Interface functions for adding new modes. (info-lookup-add-help*): New function. (info-lookup-symbol-alist, info-lookup-file-alist): Variables deleted. This info is specified now by calling info-lookup-maybe-add-help @@ -6336,10 +6336,10 @@ `parse-partial-sexp' contains the starting pos of the last literal. -1998-02-16 Barry A. Warsaw <cc-mode-help@python.org> +1998-02-16 Barry A. Warsaw <bwarsaw@cnri.reston.va.us> - * progmodes/cc-mode.el (c-mode, c++-mode, objc-mode, java-mode): Set - imenu-case-fold-search to nil. + * progmodes/cc-mode.el (c-mode, c++-mode, objc-mode, java-mode): + Set imenu-case-fold-search to nil. * progmodes/cc-langs.el (c-postprocess-file-styles): If a file style or file offsets are set, make the variables local to the @@ -6352,8 +6352,8 @@ * progmodes/cc-defs.el (c-point): In XEmacs, use scan-lists + buffer-syntactic-context-depth. - * progmodes/cc-vars.el (c-enable-xemacs-performance-kludge-p): New - variable. + * progmodes/cc-vars.el (c-enable-xemacs-performance-kludge-p): + New variable. * progmodes/cc-cmds.el, progmodes/cc-engine.el (c-beginning-of-defun) (c-indent-defun, c-parse-state): Use (c-point 'bod) instead of @@ -6362,7 +6362,7 @@ * progmodes/cc-align.el (c-semi&comma-no-newlines-before-nonblanks) (c-semi&comma-no-newlines-for-oneline-inliners): New functions. - * progmodes/cc-engine.el (c-guess-basic-syntax): Fixed a few byte + * progmodes/cc-engine.el (c-guess-basic-syntax): Fix a few byte compiler warnings. * progmodes/cc-cmds.el (c-beginning-of-defun, c-end-of-defun): @@ -6379,8 +6379,8 @@ * progmodes/cc-langs.el (c-java-method-key): Variable deleted. - * progmodes/cc-mode.el (java-mode): Set c-method-key to nil. I - don't think this is necessary for Java, and besides, the old value + * progmodes/cc-mode.el (java-mode): Set c-method-key to nil. + I don't think this is necessary for Java, and besides, the old value was inherited from Objective-C which was clearly not right. * progmodes/cc-cmds.el (c-electric-colon): Don't insert newlines @@ -6397,10 +6397,10 @@ * progmodes/cc-cmds.el (c-electric-brace): namespace-open and namespace-close braces can hang. - * progmodes/cc-defs.el (c-emacs-features): Added autoload cookie. + * progmodes/cc-defs.el (c-emacs-features): Add autoload cookie. - * progmodes/cc-engine.el (c-search-uplist-for-classkey): When - searching up for a class key, instead of hardcoding the extended + * progmodes/cc-engine.el (c-search-uplist-for-classkey): + When searching up for a class key, instead of hardcoding the extended search for "extern", use the new variable c-extra-toplevel-key, which is language dependent. For C++, this variable includes the keyword "namespace" which will match C++ namespace introducing @@ -6415,14 +6415,14 @@ CASE 3: we can now determine whether we're at the beginning of a cpp macro definition, or inside the middle of one. Set syntax to - 'cpp-macro in the former case, 'cpp-macro-cont in the latter. In - both cases, the relpos is the beginning of the macro. + 'cpp-macro in the former case, 'cpp-macro-cont in the latter. + In both cases, the relpos is the beginning of the macro. - (c-forward-syntactic-ws): Added code that skips forward over + (c-forward-syntactic-ws): Add code that skips forward over multi-line cpp macros. - (c-beginning-of-macro): Moved, and made into a defsubst. This - function can now actually find the beginning of a multi-line C + (c-beginning-of-macro): Move, and made into a defsubst. + This function can now actually find the beginning of a multi-line C preprocessor macro. (c-backward-syntactic-ws): Use c-beginning-of-macro to skip @@ -6443,8 +6443,8 @@ (c-initialize-on-load): New variable, *not* customized. * progmodes/cc-styles.el (c-offsets-alist): Three new syntactic - symbols: innamespace, namespace-open, namespace-close. These - support C++ namespace blocks. + symbols: innamespace, namespace-open, namespace-close. + These support C++ namespace blocks. Also, new syntactic symbol cpp-macro-cont, by default bound to c-lineup-dont-change. This symbol is assigned to subsequent lines of a multi-line C preprocess macro definition. @@ -6483,7 +6483,7 @@ Introduce the new default style "user" which contains all user customizations. - * progmodes/cc-vars.el (c-default-style): Renamed from + * progmodes/cc-vars.el (c-default-style): Rename from c-site-default-style. 1998-02-15 Aki Vehtari <Aki.Vehtari@hut.fi> @@ -6500,13 +6500,13 @@ `bibtex-autokey-before-presentation-function' as it is not hook. (bibtex-autokey-get-namefield): Remove newlines unconditionally. - * bibtex.el (bibtex-autokey): Fixed prefix. + * bibtex.el (bibtex-autokey): Fix prefix. (bibtex-user-optional-fields): Better `:type'. (bibtex-autokey-names): Better `:type' and doc-fix. (bibtex-mark-active): New function, taking care of Emacs variants. (bibtex-run-with-idle-timer): Ditto. (bibtex-mode-map): Change `[(control tab)]' to `[(meta tab)]'. - (bibtex-autokey-get-yearfield): Changed to accept year when year + (bibtex-autokey-get-yearfield): Change to accept year when year field has field-delimiters. This is quick fix, there might be better solution. (bibtex-mode): Don't call idle timer with 0 seconds. @@ -6514,7 +6514,7 @@ 1998-02-15 Dirk Herrmann <D.Herrmann@tu-bs.de> - * bibtex.el (bibtex-autokey-get-yearfield): Fixed problem with + * bibtex.el (bibtex-autokey-get-yearfield): Fix problem with parsing the year field. * bibtex.el (bibtex-comment-start): Font locking for comments added. @@ -6526,7 +6526,7 @@ * bibtex.el (bibtex-autokey-get-titles): Non capitalized title words are used for key generation as well. (bibtex-member-of-regexp): Case is honored for matches now. - (bibtex-autokey-titleword-ignore): Added entries provide compatibility + (bibtex-autokey-titleword-ignore): Add entries provide compatibility to former behavior. * bibtex.el (bibtex-autokey-titleword-ignore): Title words found in @@ -6561,7 +6561,7 @@ (info-look-completion): New variable. * info-look.el (info-lookup-symbol-alist): - Added support for latex-mode, perl-mode, awk-mode, emacs-lisp-mode. + Add support for latex-mode, perl-mode, awk-mode, emacs-lisp-mode. 1998-02-13 Richard Stallman <rms@psilocin.gnu.org> @@ -6575,12 +6575,12 @@ 1998-02-12 Dave Love <fx@gnu.org> - * progmodes/scheme.el (scheme-imenu-generic-expression): Simplify - regexps. + * progmodes/scheme.el (scheme-imenu-generic-expression): + Simplify regexps. (dsssl-imenu-generic-expression): Likewise. (scheme-mode-variables): Set imenu-syntax-alist. - (dsssl-mode): Remove `!' from font-lock-defaults. Set - imenu-syntax-alist. + (dsssl-mode): Remove `!' from font-lock-defaults. + Set imenu-syntax-alist. 1998-02-11 Richard Stallman <rms@psilocin.gnu.org> @@ -6667,12 +6667,12 @@ * international/kinsoku.el: Use aref instead of sref. - * international/mule-cmds.el (find-safe-coding-system): Return - undecided if FROM == TO. + * international/mule-cmds.el (find-safe-coding-system): + Return undecided if FROM == TO. (select-safe-coding-system): Doc-string modified. - * international/mule-util.el (compose-chars-component): Return - result as unibyte string. + * international/mule-util.el (compose-chars-component): + Return result as unibyte string. (decompose-composite-char): Doc-string modified. * international/titdic-cnv.el: Many codes re-written to adjust for @@ -6724,7 +6724,7 @@ 1998-02-02 Dan Nicolaescu <done@ece.arizona.edu> - * progmodes/hideshow.el (hs-special-modes-alist): Enhanced java + * progmodes/hideshow.el (hs-special-modes-alist): Enhance java regexp. 1998-02-02 Richard Stallman <rms@psilocin.gnu.org> @@ -6736,8 +6736,8 @@ 1998-02-01 Richard Stallman <rms@psilocin.gnu.org> - * emacs-lisp/easy-mmode.el (easy-mmode-define-minor-mode): Fix - the doc strings used for the mode flag variable and the keymap. + * emacs-lisp/easy-mmode.el (easy-mmode-define-minor-mode): + Fix the doc strings used for the mode flag variable and the keymap. Delete duplicate &optional's. * emacs-lisp/edebug.el: Doc fixes. @@ -6752,7 +6752,7 @@ 1998-02-01 Dan Nicolaescu <done@ece.arizona.edu> - * hideshow.el (hs-special-modes-alist): Improved the regexp for java. + * hideshow.el (hs-special-modes-alist): Improve the regexp for java. * isearch.el (isearch-range-invisible): Avoid infinite loop when search-invisible is nil. @@ -6784,8 +6784,8 @@ * fortran.el: Various docstring and commentary fixes, including note of current maintainer. (fortran-mode): Use imenu-syntax-alist. - (fortran-imenu-generic-expression): Use - fortran-continuation-string, not always `+'. + (fortran-imenu-generic-expression): + Use fortran-continuation-string, not always `+'. (fortran-font-lock-keywords-1): Include symbol syntax as well as word, following syntax table changes. (fortran-imenu-generic-expression): Likewise. @@ -6793,23 +6793,23 @@ (fortran-mode-version, fortran-startup-message): Delete misleading variables. (fortran-mode): Don't use them. - (fortran-column-ruler-fixed, fortran-column-ruler-tab): Fix - leading \ which made `0' into null. + (fortran-column-ruler-fixed, fortran-column-ruler-tab): + Fix leading \ which made `0' into null. (fortran-join-line): New function and key binding. (fortran-narrow-to-subprogram): New function and key binding. (fortran-mode-syntax-table): Make ?., ?_, ?$ symbol, not word. 1998-01-29 Carsten Dominik <dominik@strw.LeidenUniv.nl> - * textmodes/reftex.el (reftex-toc): Fixed bug with split-window. Using - split-window instead of split-window-vertically. - (reftex-reset-mode): Removed obsolete buffer from kill list. - (reftex-make-and-insert-label-list, reftex-do-citation): Delete - other windows before displaying selection. - (reftex-cite-format-builtin): Fixed bug in Chicago format. + * textmodes/reftex.el (reftex-toc): Fix bug with split-window. + Using split-window instead of split-window-vertically. + (reftex-reset-mode): Remove obsolete buffer from kill list. + (reftex-make-and-insert-label-list, reftex-do-citation): + Delete other windows before displaying selection. + (reftex-cite-format-builtin): Fix bug in Chicago format. (reftex-enlarge-to-fit): New function. - (reftex-nicify-text): Cut context-string at \item,\\. Changed - match sequence for efficiency reasons. + (reftex-nicify-text): Cut context-string at \item,\\. + Changed match sequence for efficiency reasons. (reftex-parse-from-file): Include files can be ignored with `reftex-no-include-regexps'. (reftex-no-include-regexps): New option. @@ -6819,16 +6819,16 @@ (reftex-where-am-I): Interpret appendix match. (reftex-init-section-numbers): New arg: appendix. (reftex-section-number): Treat appendix enumeration. - (reftex-toc-external): Improved message. + (reftex-toc-external): Improve message. (reftex-compute-ref-cite-tables): Regular expression extended for appendix. - (reftex-toc-rescan): Renamed from reftex-toc-redo. - (reftex-toc-Rescan): Renamed from reftex-toc-Redo. + (reftex-toc-rescan): Rename from reftex-toc-redo. + (reftex-toc-Rescan): Rename from reftex-toc-Redo. (reftex-toc-revert): New function. (reftex-select-external-document): Completion on label prefixes. - (reftex-find-file-on-path): Added an extra call to + (reftex-find-file-on-path): Add an extra call to expand-file-name for the directory. - (reftex-locate-bibliography-files): Added expand-file-name call. + (reftex-locate-bibliography-files): Add expand-file-name call. (reftex-guess-label-type): New function. (reftex-word-before-point): Function removed. (reftex-reference): Uses reftex-guess-label-type. Changed meaning @@ -6837,41 +6837,41 @@ (reftex-select-label-maps): Default bindings for TAB, up, down, RET. (reftex-select-read-string): Now uses completion. (reftex-make-and-insert-label-list): Prepare for completion. - (reftex-where-am-I): Fixed bug with input files. + (reftex-where-am-I): Fix bug with input files. (reftex-save-all-document-buffers): New command. (reftex-select-next-heading): New function. (reftex-select-previous-heading): New function. (reftex-select-read-string): New function. (reftex-offer-label-menu): Handle string value from reftex-select-item. - (reftex-reference): Fixed bug (missing save-excursion). - (reftex-toc-map): Added binding for ?n and ?p. - (reftex-do-citation): Changed to use reftex-default-bibliography. + (reftex-reference): Fix bug (missing save-excursion). + (reftex-toc-map): Add binding for ?n and ?p. + (reftex-do-citation): Change to use reftex-default-bibliography. (reftex-default-bibliography): New option. (reftex-find-tex-file): Check for file-name-absolute-p first. (reftex-format-label-function, reftex-format-ref-function) (reftex-format-cite-function): New hooks. (reftex-info): New function. - (reftex-compute-ref-cite-tables): Removed interactive form. - (reftex-where-am-I): Removed interactive form. - (reftex-format-names): Removed interactive form. + (reftex-compute-ref-cite-tables): Remove interactive form. + (reftex-where-am-I): Remove interactive form. + (reftex-format-names): Remove interactive form. (reftex-vref-is-default): New customization variable. (reftex-mode-menu): Capitalize citation options. (reftex-last-cnt): Variable removed. (reftex-last-data, reftex-last-line): New variables. (reftex-select-toggle-varioref): New function. - (reftex-offer-label-menu): Changed mode-line-format for varioref. + (reftex-offer-label-menu): Change mode-line-format for varioref. (reftex-select-label-help): Help string updated. - (reftex-do-parse): Fixed bug with empty xr list. + (reftex-do-parse): Fix bug with empty xr list. (reftex-view-crossref): Prefix argument interpretation changed. (reftex-get-offset): New function. (reftex-label): Remove selection buffer to force update. (reftex-access-scan-info): Remove selection buffers. - (reftex-select-external-document): Fixed bug with highest index. + (reftex-select-external-document): Fix bug with highest index. (reftex-label-index-list, reftex-found-list): Variables removed. (reftex-offer-label-menu, reftex-make-and-insert-label-list) (reftex-select-item, reftex-citation, reftex-select-label-callback) - (reftex-bibtex-selection-callback, reftex-select-callback): Changed - to put the scan data directly into the text property :data, + (reftex-bibtex-selection-callback, reftex-select-callback): + Change to put the scan data directly into the text property :data, instead of doing this indirectly with an index-list. (reftex-make-selection-buffer-name): New function. (reftex-tie-multifile-symbols): Store master-index-as-property. @@ -6884,7 +6884,7 @@ (reftex-access-parse-file): `Restore' action now throws an exception when the file is not found. (reftex-create-customize-menu): New function. - (reftex-label): Fixed bug which made naked labels in \footnotes. + (reftex-label): Fix bug which made naked labels in \footnotes. (reftex-select-label-map, reftex-select-bib-map): New keymaps for the RefTeX Select buffer. (reftex-select-next, reftex-select-previous, reftex-select-scroll-down) @@ -6912,7 +6912,7 @@ (reftex-extract-bib-entries-from-thebibliography): New function. (reftex-format-bibitem): New function. (reftex-parse-bibitem): New function. - (reftex-make-desparate-section-regexp): Changed name to + (reftex-make-desparate-section-regexp): Change name to reftex-make-desperate-section-regexp. (reftex-do-parse, reftex-locate-bibliography-files) (reftex-string-to-label, reftex-select-external-document) @@ -6921,7 +6921,7 @@ (reftex-select-search-minibuffer-map, reftex-access-search-path) (reftex-compute-ref-cite-tables, reftex-recursive-directory-list): All lambda expressions now quoted with `function'. - (reftex-view-crossref, reftex-mouse-view-crossref): Fixed bug with + (reftex-view-crossref, reftex-mouse-view-crossref): Fix bug with multiple calls. (reftex-get-buffer-visiting): Error message changed. (reftex-select-external-document, reftex-query-label-type) @@ -6949,7 +6949,7 @@ * progmodes/etags.el (find-tag-marker-ring-length): New variable. (find-tag-marker-ring): New variable. (tags-location-ring): New variable replacing tags-location-ring. - (tags-location-stack): Deleted. + (tags-location-stack): Delete. (tags-table-format-hooks): Doc fix. (initialize-new-tags-table): Init find-tag-marker-ring, tags-location-ring. @@ -6970,13 +6970,13 @@ * international/mule-cmds.el (toggle-enable-multibyte-characters): Use set-buffer-multibyte. - (find-safe-coding-system-list-subset-p): Renamed from list-subset-p. + (find-safe-coding-system-list-subset-p): Rename from list-subset-p. The call changed also. 1998-01-28 Kenichi Handa <handa@etl.go.jp> - * international/titdic-cnv.el (titdic-convert): Set - enable-multibyte-characters to t after inserting TIT file by + * international/titdic-cnv.el (titdic-convert): + Set enable-multibyte-characters to t after inserting TIT file by no-conversion. (tit-process-body): Do not bind enable-multibyte-characters to nil. @@ -6987,9 +6987,9 @@ instead of (` and (,. Implement :filter. Doc fix. (easy-menu-do-define): Call `easy-menu-create-menu' instead of `easy-menu-create-keymaps'. - (easy-menu-create-keymaps): Replaced by `easy-menu-create-menu'. - (easy-menu-create-menu): New public function. Replaces - `easy-menu-create-keymaps', but with large changes. + (easy-menu-create-keymaps): Replace by `easy-menu-create-menu'. + (easy-menu-create-menu): New public function. + Replaces `easy-menu-create-keymaps', but with large changes. (easy-menu-button-prefix): New constant. (easy-menu-do-add-item, easy-menu-make-symbol): New functions. (easy-menu-update-button): Doc fix. @@ -7064,22 +7064,22 @@ * mail/emacsbug.el (emacsbug): Customized. (report-emacs-bug-no-confirmation): - Renamed from report-emacs-bug-run-tersely. + Rename from report-emacs-bug-run-tersely. (report-emacs-bug-no-explanations): New option. (report-emacs-bug): Handle that option. 1998-01-22 Eric Ludlam <zappo@mescaline.gnu.org> - * mail/rmail.el (rmail-speedbar-buttons): Added speedbar support + * mail/rmail.el (rmail-speedbar-buttons): Add speedbar support for Rmail, including rmail-speedbar-button, rmail-speedbar-find-file, rmail-move-message-to-folder-on-line, rmail-speedbar-move-message, and support variables. - * info.el (Info-speedbar-buttons): Added speedbar support for Info + * info.el (Info-speedbar-buttons): Add speedbar support for Info mode, including Info-speedbar-button, Info-speedbar-menu, and support variables. - * gud.el (gud-speedbar-buttons): Added speedbar support for GUD in + * gud.el (gud-speedbar-buttons): Add speedbar support for GUD in general, and for GDB specifically, including gud-gdb-goto-stackframe, gud-gdb-get-stackframe, gud-gdb-run-command-fetch-lines, gud-gdb-speedbar-stack-filter, @@ -7117,10 +7117,10 @@ 1998-01-21 Kenichi Handa <handa@etl.go.jp> - * international/mule-cmds.el (prefer-coding-system): Call - update-iso-coding-systems. + * international/mule-cmds.el (prefer-coding-system): + Call update-iso-coding-systems. - * international/mule-util.el (string-to-sequence): Adjusted for + * international/mule-util.el (string-to-sequence): Adjust for the change of multibyte-form handling (byte-base to char-base). (store-substring): Likewise. (truncate-string-to-width): Likewise. @@ -7160,13 +7160,13 @@ (set-language-environment-coding-systems): New function. * international/mule-conf.el: Adjusted for the change of the - format of make-coding-system's 6th argument. Initialize - coding-category-iso-7-tight to iso-2022-jp. + format of make-coding-system's 6th argument. + Initialize coding-category-iso-7-tight to iso-2022-jp. * international/mule-diag.el (describe-coding-system): Change the format of showing safe charsets. - * international/mule-util.el (find-safe-coding-system): Moved to + * international/mule-util.el (find-safe-coding-system): Move to mule-cmds.el. (detect-coding-with-priority): New macro. (detect-coding-with-language-environment): New function. @@ -7222,8 +7222,8 @@ * language/japanese.el, language/korean.el, language/lao.el, * language/thai.el, language/tibetan.el, language/vietnamese.el: - Adjusted for the change of make-coding-system. Register - coding-priority key in + Adjusted for the change of make-coding-system. + Register coding-priority key in * language/china-util.el, language/japan-util.el, * language/korea-util.el, language/tibet-util.el, @@ -7259,11 +7259,11 @@ (ccl-dump-translate-multiple-map, ccl-dump-translate-single-map): New functions. - * international/mule.el (define-character-unification-table): New - function. + * international/mule.el (define-character-unification-table): + New function. - * international/mule-conf.el (oldjis-newjis-jisroman-ascii): New - character unification table. + * international/mule-conf.el (oldjis-newjis-jisroman-ascii): + New character unification table. (standard-character-unification-table-for-decode): Initialize to `unification-table' property of `oldjis-newjis-jisroman-ascii'. @@ -7316,8 +7316,8 @@ 1998-01-17 Karl Heuer <kwzh@gnu.org> - * register.el (number-to-register, increment-register): Args - renamed to match doc. + * register.el (number-to-register, increment-register): + Args renamed to match doc. 1998-01-17 Dave Love <d.love@dl.ac.uk> @@ -7430,7 +7430,7 @@ 1998-01-04 Richard Stallman <rms@psilocin.gnu.org> - * subr.el (sref): Defined. + * subr.el (sref): Define. 1998-01-03 Stephen Eglen <stephen@cns.ed.ac.uk> @@ -7493,8 +7493,8 @@ 1997-12-22 Kevin Rodgers <kevinr@ihs.com> (tiny change) - * simple.el (previous-matching-history-element): Bind - case-fold-search to nil if REGEXP contains an uppercase letter. + * simple.el (previous-matching-history-element): + Bind case-fold-search to nil if REGEXP contains an uppercase letter. (previous-matching-history-element, next-matching-history-element): Doc fixes. @@ -7521,8 +7521,8 @@ 1997-12-21 Richard Stallman <rms@psilocin.gnu.org> - * msb.el (msb--home-dir): Renamed from msb--home-path. - (msb--strip-dir): Renamed from msb--strip-path. + * msb.el (msb--home-dir): Rename from msb--home-path. + (msb--strip-dir): Rename from msb--strip-path. 1997-12-21 Lars Lindberg <Lars.G.Lindberg@capgemini.se> @@ -7559,8 +7559,8 @@ (ps-generate): Replace (if A B) by (and A B). (ps-do-despool): Dynamic evaluation for ps-lpr-switches. Replace (if A B) by (and A B). - (color-instance-rgb-components, ps-color-values): Replace - pixel-components by color-instance-rgb-components. + (color-instance-rgb-components, ps-color-values): + Replace pixel-components by color-instance-rgb-components. (ps-xemacs-face-kind-p): Replace face-font by face-font-instance, replace x-font-properties by font-instance-properties. @@ -7662,8 +7662,8 @@ * progmodes/scheme.el: Define indentation in normal dialect for let-syntax, letrec-syntax, syntax-rules, call-with-values, dynamic-wind. - (scheme-mode-map): Remove lisp-complete-symbol. Add - uncomment-region menu item. + (scheme-mode-map): Remove lisp-complete-symbol. + Add uncomment-region menu item. (scheme-mode-hook, dsssl-mode-hook): Declare customized. (dsssl-sgml-declaration): Fix customization. @@ -7726,7 +7726,7 @@ * cus-edit.el (customize-changed-options): New function. (customize-version-lessp): New function. - * facemenu.el (facemenu-remove-face-props): Renamed from + * facemenu.el (facemenu-remove-face-props): Rename from facemenu-remove-props. Remove only face and mouse-face. (facemenu-menu): Update menu item for facemenu-remove-face-props. @@ -7853,10 +7853,10 @@ (debugger-mode): Now runs hook `debugger-mode-hook'. * add-log.el (change-log-add-make-room): New function. - (change-log-get-method-definition-1): Renamed get-method-definition-1. - (change-log-get-method-definition): Renamed from get-method-definition. + (change-log-get-method-definition-1): Rename get-method-definition-1. + (change-log-get-method-definition): Rename from get-method-definition. (add-log-keep-changes-together): New user variable. - (add-change-log-entry): Added missing WHOAMI explanation. + (add-change-log-entry): Add missing WHOAMI explanation. Added new functionality according to variable `add-log-keep-changes-together'. @@ -7876,8 +7876,8 @@ * progmodes/cc-menus.el: Require imenu. - * calendar/cal-french.el (french-calendar-special-days-array): New - function. + * calendar/cal-french.el (french-calendar-special-days-array): + New function. (calendar-french-date-string, calendar-goto-french-date): Use that function instead of the variable. @@ -7890,8 +7890,8 @@ 1997-12-01 Eli Zaretskii <eliz@is.elta.co.il> - * frame.el (make-frame-names-alist, select-frame-by-name): New - functions, support frame selection with completion and history. + * frame.el (make-frame-names-alist, select-frame-by-name): + New functions, support frame selection with completion and history. (frame-name-history, frame-names-alist): New variables. 1997-11-30 Dave Love <d.love@dl.ac.uk> @@ -7936,8 +7936,8 @@ 1997-11-24 Michael Kifer <kifer@cs.sunysb.edu> - * ediff-vers.el (cvs-run-ediff-on-file-descriptor): Set - default-directory. + * ediff-vers.el (cvs-run-ediff-on-file-descriptor): + Set default-directory. (cvs-run-ediff-on-file-descriptor): Use ediff-buffers when type=MODIFIED. * ediff-init.el: Commented out ediff-set-face-pixmap. @@ -7948,7 +7948,7 @@ 1997-11-24 Simon Marshall <simon@gnu.org> - * menu-bar.el (menu-bar-describe-menu): Fixed duplicate KEYs. + * menu-bar.el (menu-bar-describe-menu): Fix duplicate KEYs. 1997-11-24 Richard Stallman <rms@psilocin.ai.mit.edu> @@ -8062,7 +8062,7 @@ 1997-11-20 Karl Heuer <kwzh@gnu.org> - * international/mule-cmds.el (set-input-method): Renamed from + * international/mule-cmds.el (set-input-method): Rename from select-input-method. 1997-11-20 Eli Zaretskii <eliz@is.elta.co.il> @@ -8200,15 +8200,15 @@ * gnus/gnus-mule.el (gnus-mule-initialize): Do not set nntp-coding-system-for-read and nntp-coding-system-for-write. - * gnus/gnus-start.el (gnus-read-descriptions-file): Decode - description if necessary. + * gnus/gnus-start.el (gnus-read-descriptions-file): + Decode description if necessary. * gnus/nntp.el (nntp-coding-system-for-read): Set default value to binary. (nntp-coding-system-for-write): Likewise. - * international/mule-cmds.el (set-language-environment): Run - exit-language-environment-hook before calling `exit-function' + * international/mule-cmds.el (set-language-environment): + Run exit-language-environment-hook before calling `exit-function' which is specified for the language environment. * language/european.el: Add "Upper Sorbian" and "Lower Sorbian" in @@ -8267,7 +8267,7 @@ (ediff-update-markers-in-dir-meta-buffer): New, for fast redisplay of meta buffer. (ediff-update-meta-buffer, ediff-redraw-directory-group-buffer) - (ediff-previous-meta-overlay-start, ediff-next-meta-item): Changed to + (ediff-previous-meta-overlay-start, ediff-next-meta-item): Change to support the above. (ediff-insert-session-info-in-meta-buffer) (diff-replace-session-status-in-meta-buffer) @@ -8315,8 +8315,8 @@ 1997-10-31 Dave Love <d.love@dl.ac.uk> - * progmodes/fortran.el (fortran-imenu-generic-expression): New - variable. + * progmodes/fortran.el (fortran-imenu-generic-expression): + New variable. (fortran-mode): Use it. 1997-10-31 Richard Stallman <rms@gnu.org> @@ -8327,8 +8327,8 @@ 1997-10-28 Simon Marshall <simon@gnu.org> * font-lock.el (font-lock-keywords): Doc fix. - (font-lock-match-c++-style-declaration-item-and-skip-to-next): Allow - any number of ::foo suffixes in declarative items. + (font-lock-match-c++-style-declaration-item-and-skip-to-next): + Allow any number of ::foo suffixes in declarative items. * lazy-lock.el (lazy-lock-fontify-after-defer): Check each buffer to make sure it still (a) exists and (b) has Lazy Lock mode turned on. @@ -8369,18 +8369,18 @@ (octave-comment-indent): Handle magic comments correctly. (calculate-octave-indent): Handle magic comments correctly. - * progmodes/octave-mod.el (octave-abbrev-table): Added abbrevs for + * progmodes/octave-mod.el (octave-abbrev-table): Add abbrevs for switch, case, otherwise, and endswitch. - (octave-begin-keywords): Added switch. - (octave-else-keywords): Added case and otherwise. - (octave-end-keywords): Added endswitch. - (octave-block-match-alist): Added an entry for switch syntax. - (calculate-octave-indent): Added support for switch syntax. + (octave-begin-keywords): Add switch. + (octave-else-keywords): Add case and otherwise. + (octave-end-keywords): Add endswitch. + (octave-block-match-alist): Add an entry for switch syntax. + (calculate-octave-indent): Add support for switch syntax. (octave-block-end-offset): New function. (octave-comment-indent): Fix a typo. - * progmodes/octave-mod.el (octave-block-match-alist): Move - `otherwise' to right after `case' to have octave-close-block() + * progmodes/octave-mod.el (octave-block-match-alist): + Move `otherwise' to right after `case' to have octave-close-block() correctly close a `switch' block by `endswitch'. 1997-10-24 Carsten Dominik <dominik@strw.LeidenUniv.nl> @@ -8388,16 +8388,16 @@ * reftex.el: The menu now used toggle and radio for some items. (reftex-default-context-regexps): `caption' now prefers the optional short caption. - (reftex-offer-label-menu): Fixed bug which could kill master + (reftex-offer-label-menu): Fix bug which could kill master buffer of external document. - (reftex-select-item, reftex-get-buffer-visiting): Compatibility - code works now the other way round. + (reftex-select-item, reftex-get-buffer-visiting): + Compatibility code works now the other way round. (reftex-select-external-document): Now gives a message when no external documents are available. (reftex-find-duplicate-labels): Single key strokes to exit or to do a query replace. Made more user friendly in general. - (reftex-section-levels, reftex-default-context-regexps): Move - definition of these variables to configuration section. + (reftex-section-levels, reftex-default-context-regexps): + Move definition of these variables to configuration section. 1997-10-24 Richard Stallman <rms@gnu.org> @@ -8485,16 +8485,16 @@ * international/mule-util.el (find-safe-coding-system): New function. - * international/mule.el (load-with-code-conversion): Update - preloaded-file-list, bind load-file-name and + * international/mule.el (load-with-code-conversion): + Update preloaded-file-list, bind load-file-name and inhibit-frame-unsplittable properly. (make-char): Make it a function. Set it byte-compile property to optimize byte-compiled codes. (make-coding-system): New optional arg charsets. Set property `safe-charsets' of the coding system to it. - * international/quail.el (quail-require-guidance-buf): Adjusted - for the change of input-method-verbose-flag. + * international/quail.el (quail-require-guidance-buf): + Adjust for the change of input-method-verbose-flag. * language/chinese.el: Give proper SAFE-CHARSET argument in each call of make-coding-system. @@ -8523,7 +8523,7 @@ * language/korean.el: Give proper SAFE-CHARSET argument in each call of make-coding-system. Set exit-function for language environment "Korean" to exit-korean-environment. - (setup-korean-environment): Moved to korean.el. + (setup-korean-environment): Move to korean.el. * language/lao.el: Give proper SAFE-CHARSET argument in each call of make-coding-system. @@ -8539,8 +8539,8 @@ * man.el (Man-getpage-in-background): Bind inhibit-eol-conversion to t before calling start-process or call-process. - (Man-softhyphen-to-minus): New function. If - enable-multibyte-characters is non-nil, convert the code 0255 only + (Man-softhyphen-to-minus): New function. + If enable-multibyte-characters is non-nil, convert the code 0255 only when it is not a part of a multibyte characters. (Man-fontify-manpage): Call Man-softhyphen-to-minus. (Man-cleanup-manpage): Likewise. @@ -8568,7 +8568,7 @@ (lm-insert-at-column): Use FORCE arg of move-to-column. * emulation/tpu-edt.el (tpu-arrange-rectangle): Likewise. -1997-10-23 Barry A. Warsaw <cc-mode-help@python.org> +1997-10-23 Barry A. Warsaw <bwarsaw@cnri.reston.va.us> Merge in Release 5.19 of cc-mode. @@ -8593,14 +8593,14 @@ comment-column and there is non-whitespace preceding this on the current line. - * progmodes/cc-mode.el (c-submit-bug-report): Remove - c-recognize-knr-p. Add c-comment-continuation-stars. + * progmodes/cc-mode.el (c-submit-bug-report): + Remove c-recognize-knr-p. Add c-comment-continuation-stars. * progmodes/cc-styles.el (c-initialize-builtin-style): Only use copy-tree if it is funcall-able. This is the right patch, and was given by Erik Naggum <erik@naggum.no> -1997-10-23 Barry A. Warsaw <cc-mode-help@python.org> +1997-10-23 Barry A. Warsaw <bwarsaw@cnri.reston.va.us> * progmodes/cc-menus.el (cc-imenu-c-prototype-macro-regexp): New var. @@ -8608,7 +8608,7 @@ Given by jan.dubois@ibm.net (Jan Dubois). * progmodes/cc-menus.el (cc-imenu-java-generic-expression): - Removed test for declaration + Remove test for declaration statements. Patch given by Ake Stenhoff <etxaksf@aom.ericsson.se>, as forwarded to me by RMS. @@ -8619,7 +8619,7 @@ to cc-imenu-objc-function to enable Imenu support for Objective-C. Contributed by Masatake (jet) YAMATO. -1997-10-23 Barry A. Warsaw <cc-mode-help@python.org> +1997-10-23 Barry A. Warsaw <bwarsaw@cnri.reston.va.us> * progmodes/cc-styles.el (c-initialize-builtin-style): Use existing copy-tree if it's defined. @@ -8628,7 +8628,7 @@ c-offsets-alist must be copied recursively. Use copy-tree solution given by Simon Marshall <simon@gnu.org>. -1997-10-23 Barry A. Warsaw <cc-mode-help@python.org> +1997-10-23 Barry A. Warsaw <bwarsaw@cnri.reston.va.us> * progmodes/cc-cmds.el (c-beginning-of-statement): Fixes in sentence movement to properly @@ -8660,8 +8660,8 @@ 1997-10-22 Kenichi Handa <handa@etl.go.jp> - * gnus/gnus-art.el (gnus-show-traditional-method): Call - gnus-mule-decode-article only when enable-multibyte-characters is + * gnus/gnus-art.el (gnus-show-traditional-method): + Call gnus-mule-decode-article only when enable-multibyte-characters is non-nil. * gnus/gnus-ems.el (gnus-ems-redefine): Require `gnus-mule' only @@ -8675,10 +8675,10 @@ 1997-10-21 Kenichi Handa <handa@etl.go.jp> - * international/mule-diag.el (describe-coding-system): Print - information about coding system properties, post-read-conversion + * international/mule-diag.el (describe-coding-system): + Print information about coding system properties, post-read-conversion and pre-write-conversion. - (print-coding-system-briefly): Adjusted for the change in mule.el. + (print-coding-system-briefly): Adjust for the change in mule.el. (describe-current-coding-system): Likewise. (print-coding-system): Likewise. @@ -8688,9 +8688,9 @@ (2) Properties of a coding system (except for `coding-system' and `eol-type') is embedded in PLIST slot of coding-spec vector. (coding-spec-plist-idx): Initialize to 3. - (coding-system-spec-ref): Deleted. - (coding-system-spec): Moved from src/coding.c. - (coding-system-type): Adjusted for the above change. + (coding-system-spec-ref): Delete. + (coding-system-spec): Move from src/coding.c. + (coding-system-type): Adjust for the above change. (coding-system-mnemonic): Likewise. (coding-system-doc-string): Likewise. (coding-system-flags): Likewise. @@ -8698,37 +8698,37 @@ (coding-system-category): Likewise. (coding-system-get, coding-system-put, coding-system-category): New functions. - (coding-system-base): Moved from mule-util.el and adjusted for the + (coding-system-base): Move from mule-util.el and adjusted for the above change. (coding-system-parent): Make it obsolete alias of coding-system-base. - (make-subsidiary-coding-system): Adjusted for the above change. + (make-subsidiary-coding-system): Adjust for the above change. Update coding-system-list and coding-system-alist. (make-coding-system): Likewise. (define-coding-system-alias): Likewise. (set-buffer-file-coding-system): Typo in doc-string fixed. - (after-insert-file-set-buffer-file-coding-system): Change - enable-multibyte-characters only when + (after-insert-file-set-buffer-file-coding-system): + Change enable-multibyte-characters only when find-new-buffer-file-coding-system returns non-nil value. - (find-new-buffer-file-coding-system): Adjusted for the above change. + (find-new-buffer-file-coding-system): Adjust for the above change. - * international/mule-cmds.el (read-multilingual-string): Use - current-input-method prior to default-input-method. Don't bind + * international/mule-cmds.el (read-multilingual-string): + Use current-input-method prior to default-input-method. Don't bind current-input-method by `let', instead, activate the specified input method in the current buffer temporarily. * international/mule-conf.el: Change the way of making coding systems no-conversion and undecided. - * international/mule-util.el (coding-system-base): Moved to + * international/mule-util.el (coding-system-base): Move to mule.el. (coding-system-post-read-conversion): Use the new function coding-system-get. (coding-system-pre-write-conversion): Likewise. (coding-system-unification-table-for-decode): Likewise. (coding-system-unification-table-for-encode): Likewise. - (coding-system-list): Adjusted for the change in mule.el. - (coding-system-plist): Deleted. + (coding-system-list): Adjust for the change in mule.el. + (coding-system-plist): Delete. (coding-system-equal): Do not use coding-system-plist. * language/chinese.el: Use coding-system-put to set coding system @@ -8748,8 +8748,8 @@ * language/thai.el: Use coding-system-put to set coding system properties, post-read-conversion and pre-write-conversion. - * language/tibet-util.el (tibetan-post-read-conversion): Return - the length of converted region. + * language/tibet-util.el (tibetan-post-read-conversion): + Return the length of converted region. * language/tibetan.el: Use coding-system-put to set coding system properties, post-read-conversion and pre-write-conversion. @@ -8770,8 +8770,8 @@ 1997-10-21 Tomohiko Morioka <morioka@jaist.ac.jp> - * gnus/nnfolder.el (nnfolder-request-list): Bind - file-name-coding-system to binary. + * gnus/nnfolder.el (nnfolder-request-list): + Bind file-name-coding-system to binary. (nnfolder-possibly-change-group): Likewise. * gnus/nnml.el (nnml-retrieve-headers): Likewise. @@ -8807,13 +8807,13 @@ gnus-mule-initialize and setting coding system for nntp. (gnus-mule-select-coding-system): Get a coding system of the current newsgroup from gnus-summary-buffer. - (gnus-mule-decode-summary): Deleted. + (gnus-mule-decode-summary): Delete. (gnus-mule-initialize): Add-hook gnus-mule-select-coding-system to gnus-parse-headers-hook. Don't add-hook gnus-mule-decode-summary and gnus-mule-decode-article. Don't set process coding system for nntp stream to 'no-conversion, instead set - nntp-coding-system-for-read to 'binary. Set - nnheader-file-coding-system and nnmail-file-coding-system to + nntp-coding-system-for-read to 'binary. + Set nnheader-file-coding-system and nnmail-file-coding-system to 'binary. 1997-10-21 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no> @@ -8866,8 +8866,8 @@ * nnml.el (nnml-directory): Doc fix. - * gnus-topic.el (gnus-topic-make-menu-bar): Added - gnus-topic-edit-parameters. + * gnus-topic.el (gnus-topic-make-menu-bar): + Add gnus-topic-edit-parameters. 1997-10-21 Jay Sachs <sachs@interactive.net> @@ -8891,8 +8891,8 @@ 1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> - * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Escape - newlines. + * gnus-start.el (gnus-gnus-to-quick-newsrc-format): + Escape newlines. 1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> @@ -8901,7 +8901,7 @@ 1997-10-21 Danny Siu <dsiu@adobe.com> * smiley.el (smiley-buffer): Make smiley case sensitive. - (smiley-deformed-regexp-alist): Added more regexp for happy smiley. + (smiley-deformed-regexp-alist): Add more regexp for happy smiley. (smiley-nosey-regexp-alist): Same as above. 1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> @@ -8919,9 +8919,9 @@ 1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> - * nntp.el (nntp-nov-gap): Changed default. + * nntp.el (nntp-nov-gap): Change default. - * gnus-nocem.el (gnus-nocem-issuers): Fixed names. + * gnus-nocem.el (gnus-nocem-issuers): Fix names. 1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> @@ -8969,8 +8969,8 @@ * gnus.el (gnus-simplify-mode-line): Use varying formats. - * gnus-xmas.el (gnus-xmas-group-remove-excess-properties): Removed. - (gnus-xmas-topic-remove-excess-properties): Removed. + * gnus-xmas.el (gnus-xmas-group-remove-excess-properties): Remove. + (gnus-xmas-topic-remove-excess-properties): Remove. 1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> @@ -8993,8 +8993,8 @@ 1997-10-21 Michael R. Cook <mcook@cognex.com> - * gnus-topic.el (gnus-topic-toggle-display-empty-topics): List - groups. + * gnus-topic.el (gnus-topic-toggle-display-empty-topics): + List groups. 1997-10-21 Per Abrahamsen <abraham@dina.kvl.dk> @@ -9013,8 +9013,8 @@ * gnus-start.el (gnus-check-first-time-used): Force reading the active file the first time Gnus is used. - * gnus-group.el (gnus-group-set-mode-line): Conditionalize - modified. + * gnus-group.el (gnus-group-set-mode-line): + Conditionalize modified. * gnus-ems.el (gnus-mode-line-modified): New variable. @@ -9053,9 +9053,9 @@ * message.el (message-clone-locals): Made into own function. - * gnus.el (gnus-select-method): Changed default. + * gnus.el (gnus-select-method): Change default. - * gnus-start.el (gnus-read-active-file): Changed default to + * gnus-start.el (gnus-read-active-file): Change default to `some'. 1997-10-21 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no> @@ -9235,12 +9235,12 @@ 1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> - * gnus-sum.el (t): Moved pop article keystroke. + * gnus-sum.el (t): Move pop article keystroke. 1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> - * nnmail.el (nnmail-search-unix-mail-delim-backward): Allow - several "From "'s. + * nnmail.el (nnmail-search-unix-mail-delim-backward): + Allow several "From "'s. (nnmail-search-unix-mail-delim): Ditto. 1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> @@ -9283,8 +9283,8 @@ 1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> - * gnus-sum.el (gnus-summary-limit-children): Typo. Wouldn't - marked NoCeM'ed out messages as read. + * gnus-sum.el (gnus-summary-limit-children): Typo. + Wouldn't marked NoCeM'ed out messages as read. 1997-10-21 Darren Stalder <torin@daft.com> @@ -9300,8 +9300,8 @@ 1997-10-21 Danny Siu <dsiu@adobe.com> - * gnus-picon.el (gnus-group-display-picons): Use - gnus-group-real-name so that picons for foreign groups display + * gnus-picon.el (gnus-group-display-picons): + Use gnus-group-real-name so that picons for foreign groups display correctly. 1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> @@ -9364,8 +9364,8 @@ 1997-10-21 Per Abrahamsen <abraham@dina.kvl.dk> - * gnus-cite.el (gnus-cite-attribution-prefix): Recognize - Microsoft/Agent style attribution lines. + * gnus-cite.el (gnus-cite-attribution-prefix): + Recognize Microsoft/Agent style attribution lines. (gnus-cite-attribution-suffix): Ditto. 1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> @@ -9375,8 +9375,8 @@ (gnus-cache-possibly-alter-active): Test statement removed. (gnus-cache-articles-in-group): Would destroy hashtb. - * gnus-sum.el (gnus-summary-limit-mark-excluded-as-read): Don't - mark everything as read. + * gnus-sum.el (gnus-summary-limit-mark-excluded-as-read): + Don't mark everything as read. * gnus-cite.el (gnus-article-fill-cited-article): Nix out gnus-cite-article. @@ -9398,9 +9398,9 @@ * nnml.el (nnml-update-file-alist): Allow forcing. - * nnheaderxm.el (nnheader-xmas-find-file-noselect): Removed. - (nnheader-xmas-cancel-timer): Removed. - (nnheader-xmas-cancel-function-timers): Removed. + * nnheaderxm.el (nnheader-xmas-find-file-noselect): Remove. + (nnheader-xmas-cancel-timer): Remove. + (nnheader-xmas-cancel-function-timers): Remove. 1997-10-21 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no> @@ -9411,7 +9411,7 @@ * message.el (message-set-auto-save-file-name): Create unique auto save file names. - * gnus-topic.el (gnus-topic-tallied-groups): Removed. + * gnus-topic.el (gnus-topic-tallied-groups): Remove. (gnus-topic-prepare-topic): Output right number of articles in each sub-topic. @@ -9451,23 +9451,23 @@ need be displayed. (gnus-picons-lock): Function deleted. (gnus-picons-remove): Don't use it. New way of locking. - (gnus-picons-next-job-internal): New way of locking. Handle - new tag 'bar. + (gnus-picons-next-job-internal): New way of locking. + Handle new tag 'bar. (gnus-picons-next-job): New way of locking. (gnus-picons-buffer): Variable deleted. - (gnus-picons-remove-all): Modified accordingly. + (gnus-picons-remove-all): Modify accordingly. (gnus-group-annotations-lock): Variable deleted. (gnus-article-annotations-lock): Variable deleted. (gnus-x-face-annotations-lock): Variable deleted. - (gnus-picons-news-directories): Renamed, was + (gnus-picons-news-directories): Rename, was gnus-picons-news-directory. (gnus-picons-url-retrieve): Do not change url-show-status. (gnus-picons-clear-cache): Also clear gnus-picons-url-alist. 1997-10-21 Michael R. Cook <mcook@cognex.com> - * gnus-topic.el (gnus-topic-toggle-display-empty-topics): New - function. + * gnus-topic.el (gnus-topic-toggle-display-empty-topics): + New function. 1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> @@ -9504,7 +9504,7 @@ 1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> - * gnus-topic.el (gnus-topic-create-topic): Added doc. + * gnus-topic.el (gnus-topic-create-topic): Add doc. * gnus-sum.el (gnus-summary-refer-article): Insert sparse non-displayed articles properly. @@ -9536,7 +9536,7 @@ (gnus-article-display-picons): Use the job queue if using the network. (gnus-group-display-picons): Ditto. (gnus-picons-make-path): Function deleted. - (gnus-picons-lookup-internal): Modified accordingly. + (gnus-picons-lookup-internal): Modify accordingly. (gnus-picons-lookup-user-internal): Take the LETs out of the loops. (gnus-picons-lookup-pairs): Take constant calculation outside of loop. (gnus-picons-display-picon-or-name): Use COND instead of nested IFs. @@ -9577,23 +9577,23 @@ (gnus-picons-users-image-alist): New variable. (gnus-picons-retrieve-user-callback): Use it. Added support for network retrieval of picons. - (gnus-picons-map): Removed. - (gnus-picons-remove): Removed case to handle processes. + (gnus-picons-map): Remove. + (gnus-picons-remove): Remove case to handle processes. (gnus-picons-processes-alist): New variable. - (gnus-picons-x-face-sentinel): Simplified. Use processes alist. + (gnus-picons-x-face-sentinel): Simplify. Use processes alist. (gnus-picons-display-x-face): Explicitly request an xface image. Always call gnus-picons-prepare-for-annotations. Use processes alist. (gnus-picons-lookup-internal): New function. (gnus-picons-lookup): Use it. (gnus-picons-lookup-user-internal): Ditto. (gnus-picons-display-picon-or-name): No more xface-p argument. - (gnus-picons-try-suffixes): Removed. + (gnus-picons-try-suffixes): Remove. (gnus-picons-try-face): New function. Does the caching in gnus-picons-glyph-alist. (gnus-picons-try-to-find-face): Take a glyph argument instead of a path. No more xface-p argument. Only use one annotation even if gnus-picons-display-as-address. - (gnus-picons-toggle-extent): Changed into an annotation action. + (gnus-picons-toggle-extent): Change into an annotation action. 1997-10-21 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no> @@ -9601,8 +9601,8 @@ 1997-10-21 Kim-Minh Kaplan <kimminh.kaplan@utopia.eunet.fr> - * gnus-picon.el (gnus-picons-prepare-for-annotations): New - function, and many changes. + * gnus-picon.el (gnus-picons-prepare-for-annotations): + New function, and many changes. 1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> @@ -9671,8 +9671,8 @@ * gnus-cache.el (gnus-cache-move-cache): Allow entering directory name. - * nntp.el (nntp-telnet-command, nntp-telnet-switches): New - variables. + * nntp.el (nntp-telnet-command, nntp-telnet-switches): + New variables. * gnus-score.el (gnus-summary-increase-score): Refuse illegal match types. @@ -9684,7 +9684,7 @@ 1997-10-21 Per Abrahamsen <abraham@dina.kvl.dk> - * gnus-ems.el (gnus-article-x-face-command): Removed bogus + * gnus-ems.el (gnus-article-x-face-command): Remove bogus declaration. 1997-10-21 Paul Franklin <paul@cs.washington.edu> @@ -9758,8 +9758,8 @@ * message.el (message-cancel-news): Only say we cancel if we cancel. - * gnus-msg.el (gnus-summary-mail-crosspost-complaint): Deactivate - mark. + * gnus-msg.el (gnus-summary-mail-crosspost-complaint): + Deactivate mark. 1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> @@ -9842,7 +9842,7 @@ (reftex-make-master-buffer-hook): Hook removed. (reftex-insert-buffer-or-file): Function removed. (reftex-parse-document): Function adapted to new parser. - (reftex-access-scan-info): Changed to fit new parser. Now detects + (reftex-access-scan-info): Change to fit new parser. Now detects changes in label-alist related variables automatically. (reftex-parse-one, reftex-parse-all): New functions. (reftex-all-document-files): New function. @@ -9872,8 +9872,8 @@ (reftex-find-nearby-label): Function removed. (reftex-scan-buffer-for-labels): Function removed. (reftex-section-info): New function. - (reftex-nth-parens-substring): Renamed to reftex-nth-arg. Return - nil when not enough args are present. + (reftex-nth-parens-substring): Rename to reftex-nth-arg. + Return nil when not enough args are present. (reftex-move-over-touching-args): New function. (reftex-where-am-I): New function. (reftex-nth-arg-wrapper): New function. @@ -9888,7 +9888,7 @@ several backup methods. (reftex-citation): Recursive edit moved to `e' key. (reftex-scan-buffer): Function removed. - (reftex-get-bibfile-list): Changed to work with chapterbib + (reftex-get-bibfile-list): Change to work with chapterbib package. (reftex-find-tex-file): New function. (reftex-find-files-on-path): Now first looks for file with @@ -9897,7 +9897,7 @@ reftex-do-citation. (reftex-do-citation): Recursive edit now on `e' key. (reftex-what-macro): Allow white space between macro arguments. - (reftex-allow-for-ctrl-m): Renamed to + (reftex-allow-for-ctrl-m): Rename to `reftex-make-regexp-allow-for-ctrl-m'. (reftex-nearest-match): New function. (reftex-auto-mode-alist): New function. @@ -9909,8 +9909,8 @@ (reftex-parse-args): New function. (easy-menu-define): Menu extended. Some parts are now computed. from the user options. - (reftex-move-to-next-arg, reftex-move-to-previous-arg): New - functions. Now we can parse macros with distributed arguments. + (reftex-move-to-next-arg, reftex-move-to-previous-arg): + New functions. Now we can parse macros with distributed arguments. (reftex-goto-label): Function removed. (reftex-position-cursor): Function removed. (reftex-item): Function removed. @@ -9944,8 +9944,8 @@ * iso-insert.el: Add autoloads for `8859-1-map'. - * cus-edit.el (custom-group-value-create): Use - `custom-group-visibility' instead of `group-visibility'. + * cus-edit.el (custom-group-value-create): + Use `custom-group-visibility' instead of `group-visibility'. 1997-10-19 Richard Stallman <rms@gnu.org> @@ -10018,7 +10018,7 @@ (double-map): Add customize support. (double-prefix-only): Ditto. - * textmodes/nroff-mode.el (nroff): Moved from `editing' to `wp'. + * textmodes/nroff-mode.el (nroff): Move from `editing' to `wp'. * wid-edit.el (variable-link): New widget. (widget-variable-link-action): New function. @@ -10033,7 +10033,7 @@ (view-highlight-face, view-scroll-auto-exit) (view-try-extend-at-buffer-end) (view-remove-frame-by-deleting, view-mode-hook): - Defined by defcustom instead of by defvar. + Define by defcustom instead of by defvar. (view-mode-enter): Install exit-action also when view-mode is already on. Small rewrite using unless. (view-mode, view-mode-exit, view-scroll-lines, view-really-at-end) @@ -10109,8 +10109,8 @@ * comint.el (comint-regexp-arg): Likewise. * term.el (term-regexp-arg): Likewise. - * simple.el (repeat-complex-command): Bind - minibuffer-history-sexp-flag to the minibuffer depth. + * simple.el (repeat-complex-command): + Bind minibuffer-history-sexp-flag to the minibuffer depth. (next-history-element): Compare minibuffer-history-sexp-flag against the current minibuffer depth to verify its validity. (previous-matching-history-element): Likewise. @@ -10138,7 +10138,7 @@ * finder.el (finder-mode-map): Bind [mouse-2]. (finder-compile-keywords): Match compressed file names, but don't put compression extension in the output. - (finder-find-library): Deleted. + (finder-find-library): Delete. (finder-commentary): Use locate-library, not finder-find-library. (finder-mouse-select): New function. (finder-summary): Mention mouse binding. @@ -10147,7 +10147,7 @@ 1997-09-30 Andre Spiegel <spiegel@inf.fu-berlin.de> - * vc-hooks.el (vc-find-cvs-master): Added missing `throw' for + * vc-hooks.el (vc-find-cvs-master): Add missing `throw' for the case when TIMESTAMP is arbitrary text. 1997-09-30 Hrvoje Niksic <hniksic@srce.hr> @@ -10180,8 +10180,8 @@ * ediff-init.el: Added documentation to face-variables. - * ediff-util.el (ediff-next-difference, ediff-previous-difference): Use - ediff-merge-region-is-non-clash and don't compute fine diffs when + * ediff-util.el (ediff-next-difference, ediff-previous-difference): + Use ediff-merge-region-is-non-clash and don't compute fine diffs when skipping non-clash regions. * ediff-merg.el (ediff-merge-region-is-non-clash): New function. @@ -10316,12 +10316,12 @@ 1997-09-15 Ken'ichi Handa <handa@psilocin.gnu.ai.mit.edu> - * mule.el (find-new-buffer-file-coding-system): Reflect - text coding part of default-buffer-file-coding-system to + * mule.el (find-new-buffer-file-coding-system): + Reflect text coding part of default-buffer-file-coding-system to buffer-file-coding-system when buffer-file-coding-system is not locally set and ASCII only text is read. -1997-09-15 Barry A. Warsaw <cc-mode-help@python.org> +1997-09-15 Barry A. Warsaw <bwarsaw@cnri.reston.va.us> * progmodes/cc-styles.el (c-initialize-builtin-style): Copy the whole tree instead of just copy-sequence. @@ -10335,11 +10335,11 @@ 1997-09-15 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de> - * international/quail.el (quail-completion-list-translations): Fix - and simplify generation of translation list. + * international/quail.el (quail-completion-list-translations): + Fix and simplify generation of translation list. - * international/titdic-cnv.el (tit-process-header): Convert - argument of KEYPROMPT if it contains an escape. + * international/titdic-cnv.el (tit-process-header): + Convert argument of KEYPROMPT if it contains an escape. (tit-process-body): Handle trailing whitespace and multiple spaces between phrases. @@ -10483,10 +10483,10 @@ 1997-09-12 Michael Kifer <kifer@cs.sunysb.edu> - * viper-keym.el (viper-want-ctl-h-help): Updated doc string. + * viper-keym.el (viper-want-ctl-h-help): Update doc string. (viper-vi-basic-map, viper-insert-basic-map, viper-replace-map): - Added binding for backspace. - * viper-cmd.el (viper-adjust-keys-for): Separated backspace and C-h. + Add binding for backspace. + * viper-cmd.el (viper-adjust-keys-for): Separate backspace and C-h. 1997-09-12 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> @@ -10505,7 +10505,7 @@ 1997-09-12 Inge Frick <inge@nada.kth.se> - * compile.el (compilation-parse-errors): Fixed two bugs that + * compile.el (compilation-parse-errors): Fix two bugs that could make compilation-parse-errors loop infinitely. Each round of the parsing loop now either moves point ahead at least a line or sets `found-desired' to true to stop the loop. @@ -10535,8 +10535,8 @@ 1997-09-11 Eli Zaretskii <eliz@is.elta.co.il> - * international/mule-diag.el (describe-coding-system): Describe - coding systems of type 5, raw-text. + * international/mule-diag.el (describe-coding-system): + Describe coding systems of type 5, raw-text. * hexl.el (hexlify-buffer): Bind coding-system-for-write to raw-text with eol-type derived from the buffer-file-coding-system. @@ -10587,11 +10587,11 @@ 1997-09-10 Michael Ernst <mernst@cs.washington.edu> - * uniquify.el (uniquify-ignore-buffers-re): Added. + * uniquify.el (uniquify-ignore-buffers-re): Add. 1997-09-10 Michael Kifer <kifer@cs.sunysb.edu> - * viper-keym.el (viper-help-modifier-map): Deleted; help mode map is + * viper-keym.el (viper-help-modifier-map): Delete; help mode map is no longer modified. * viper.el (viper-set-hooks): Make help buffers come up in emacs state. @@ -10612,7 +10612,7 @@ (ethio-fidel-to-sera-mail-or-marker): New function. (ethio-find-file): Do nothing if not in ethio-mode. (ethio-write-file): Likewise. - (ethio-prefer-ascii-space): Moved from leim/quail/ethiopic.el. + (ethio-prefer-ascii-space): Move from leim/quail/ethiopic.el. (ethio-toggle-space): Likewise. (ethio-insert-space): Likewise. (ethio-insert-ethio-space): Likewise. @@ -10627,8 +10627,8 @@ 1997-09-10 Kenichi Handa <handa@etl.go.jp> - * language/japan-util.el (setup-japanese-environment): Give - iso-2022-jp to set-default-coding-system if not running on DOS. + * language/japan-util.el (setup-japanese-environment): + Give iso-2022-jp to set-default-coding-system if not running on DOS. (read-hiragana-string): Use input method "japanese-hiragana". * gnus/gnus-mule.el: Add coding system specification for several @@ -10686,15 +10686,15 @@ 1997-09-08 Per Abrahamsen <abraham@dina.kvl.dk> - * cus-edit.el (custom-variable-save): Fixed doc string. + * cus-edit.el (custom-variable-save): Fix doc string. * cus-edit.el (custom-variable-menu): Make it clear that `Lisp mode' edit the initial lisp expression. 1997-09-08 Eli Zaretskii <eliz@is.elta.co.il> - * info.el (info-insert-file-contents): Bind - coding-system-for-write to no-conversion. + * info.el (info-insert-file-contents): + Bind coding-system-for-write to no-conversion. 1997-09-08 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de> @@ -10742,9 +10742,9 @@ * telnet.el (telnet-initial-filter): Temporarily go to proper buffer. -1997-09-07 Barry A. Warsaw <cc-mode-help@python.org> +1997-09-07 Barry A. Warsaw <bwarsaw@cnri.reston.va.us> - * progmodes/cc-mode.el (c-version): Updated. + * progmodes/cc-mode.el (c-version): Update. * progmodes/cc-cmds.el (c-beginning-of-statement): Fixes in sentence movement to properly @@ -10916,8 +10916,8 @@ 1997-09-05 Ken'ichi Handa <handa@psilocin.gnu.ai.mit.edu> - * language/japan-util.el (setup-japanese-environment): Set - coding-category-iso-8-else to japanese-iso-8bit. + * language/japan-util.el (setup-japanese-environment): + Set coding-category-iso-8-else to japanese-iso-8bit. 1997-09-05 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> @@ -10950,10 +10950,10 @@ 1997-09-05 Michael Kifer <kifer@cs.sunysb.edu> * viper-init.el (viper-replace-region-start-delimiter): - Improved the default. + Improve the default. * viper-mous.el (viper-mouse-click-search-word) (viper-mouse-click-insert-word): - Fixed to not react when click is not over a text area. + Fix to not react when click is not over a text area. * viper.el (read-file-name): Unadvised. * viper-cmd.el (viper-insert-state-post-command-sentinel) (viper-save-last-insertion): @@ -11036,9 +11036,9 @@ 1997-09-02 Geoff Voelker <voelker@cs.washington.edu> * w32-fns.el: Update doc strings. - (w32-startup): Deleted function. + (w32-startup): Delete function. (w32-check-shell-configuration, w32-init-info): New functions. - (w32-system-shell-p): Renamed from w32-using-system-shell-p. + (w32-system-shell-p): Rename from w32-using-system-shell-p. Added shell name argument. 1997-09-02 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> @@ -11170,11 +11170,11 @@ 1997-08-31 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de> - * emacs-lisp/bytecomp.el (byte-compile-output-file-form): Handle - custom-declare-variable. + * emacs-lisp/bytecomp.el (byte-compile-output-file-form): + Handle custom-declare-variable. - * international/mule-diag.el (describe-current-coding-system): Add - missing newline in output. + * international/mule-diag.el (describe-current-coding-system): + Add missing newline in output. 1997-08-31 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> @@ -11228,17 +11228,17 @@ 1997-08-29 Carsten Dominik <dominik@strw.LeidenUniv.nl> - * reftex.el (reftex-customize): Added call to customize browse. + * reftex.el (reftex-customize): Add call to customize browse. (reftex-show-commentary): New function. (reftex-label-alist): Prefix may contain % escapes. Nth macro argument may be context. May give two different context methods. (reftex-default-label-alist-entries): Customization type changed. (reftex-label-menu-flags): Extra flag for searches. - (reftex-cite-format): Changed completely, % escapes are now used. + (reftex-cite-format): Change completely, % escapes are now used. (reftex-comment-citations): New variable. (reftex-cite-comment-format): New variable. (reftex-cite-punctuation): New variable. - (reftex-make-master-buffer): Changed name of master buffer, + (reftex-make-master-buffer): Change name of master buffer, removed interactive. Runs a hook on the buffer. Interpret TEXINPUTS environment variable. Allow naked argument for \input. Master buffer is now in fundamental mode. @@ -11326,25 +11326,25 @@ * international/mule.el (make-coding-system): Make TYPE 5 means raw-text. - (after-insert-file-set-buffer-file-coding-system): Set - enable-multibyte-characters to nil if we read a file with + (after-insert-file-set-buffer-file-coding-system): + Set enable-multibyte-characters to nil if we read a file with no-conversion or raw-text-XXXX. - * international/mule-conf.el (raw-text): New coding system. Set - coding-category-raw-text to raw-text. + * international/mule-conf.el (raw-text): New coding system. + Set coding-category-raw-text to raw-text. - * language/english.el (setup-english-environment): Set - coding-category-raw-text to raw-text. + * language/english.el (setup-english-environment): + Set coding-category-raw-text to raw-text. - * language/viet-util.el (setup-vietnamese-environment): Set - coding-category-raw-text to vietnamese-viscii. + * language/viet-util.el (setup-vietnamese-environment): + Set coding-category-raw-text to vietnamese-viscii. * language/cyril-util.el (setup-cyrillic-alternativnyj-environment): Set coding-category-raw-text to cyrillic-alternativnyj. * international/mule-cmds.el (update-leim-list-file): Make it handle multiple directories. - (update-all-leim-list-files): Deleted. + (update-all-leim-list-files): Delete. * international/quail.el (quail-update-leim-list-file): Make it handle multiple directories. @@ -11357,8 +11357,8 @@ * nnfolder.el (nnfolder-request-list): Override 'nnmail-file-coding-system' by 'nnmail-active-file-coding-system'. - (nnfolder-request-list, nnfolder-possibly-change-group): Protect - from conversion by `pathname-coding-system' for XEmacs/mule. + (nnfolder-request-list, nnfolder-possibly-change-group): + Protect from conversion by `pathname-coding-system' for XEmacs/mule. (nnfolder-group-pathname): Encode pathname for Emacs 20. * nnmh.el (nnmh-request-list, nnmh-active-number): Protect from @@ -11400,8 +11400,8 @@ * gnus-sum.el (gnus-structured-field-decoder): New variable. (gnus-unstructured-field-decoder): New variable. - (gnus-get-newsgroup-headers, gnus-nov-parse-line): Use - `gnus-structured-field-decoder' and + (gnus-get-newsgroup-headers, gnus-nov-parse-line): + Use `gnus-structured-field-decoder' and `gnus-unstructured-field-decoder' for Subject field. 1997-08-28 Miyashita Hisashi <himi@etl.go.jp> @@ -11508,8 +11508,8 @@ * files.el (revert-buffer): Read a file without any code conversion if we are reverting from an auto-saved file. - * language/japanese.el (set-language-info-alist): Change - iso-2022-7bit to iso-2022-jp. + * language/japanese.el (set-language-info-alist): + Change iso-2022-7bit to iso-2022-jp. * replace.el (query-replace-read-args): Locally bind minibuffer-inherit-input-method to t to make a minibuffer inherit @@ -11635,14 +11635,14 @@ and changed into defsubsts. (last): New function. - * emacs-lisp/cl.el (caar, cadr, cdar, cddr): Moved to subr.el. + * emacs-lisp/cl.el (caar, cadr, cdar, cddr): Move to subr.el. (last): Function renamed to last*. * emacs-lisp/cl-macs.el (cl-loop-let): Use last*. * time.el (display-time-hook): Minor doc fix. - * ps-print.el (ps-zebra-stripes): Renamed from ps-zebra-stripe. - (ps-zebra-stripe-height): Renamed from ps-number-of-zebra. + * ps-print.el (ps-zebra-stripes): Rename from ps-zebra-stripe. + (ps-zebra-stripe-height): Rename from ps-number-of-zebra. * vc.el (vc-version-diff): Mention that default file is visited file. @@ -11734,7 +11734,7 @@ (bookmark-bmenu-check-position): Return a meaningful value -- callers have apparently been assuming this anyway. (bookmark-build-xemacs-menu): Unused function deleted. - (bookmark-version): Removed this variable; the Emacs version suffices. + (bookmark-version): Remove this variable; the Emacs version suffices. 1997-08-22 Simon Marshall <simon@gnu.ai.mit.edu> @@ -11756,7 +11756,7 @@ * viper-cmd.el (viper-replace-char-subr, viper-word-*) (viper-separator-skipback-special): Made to work with mule and syntax tables. - (viper-change-state): Moved iso-accents-mode handling here from + (viper-change-state): Move iso-accents-mode handling here from viper-change-state-to-vi/insert/etc. Also now toggles MULE. 1997-08-21 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> @@ -11769,7 +11769,7 @@ 1997-08-21 Kenichi HANDA <handa@etl.go.jp> - * language/cyril-util.el (setup-cyrillic-environment): Deleted. + * language/cyril-util.el (setup-cyrillic-environment): Delete. (setup-cyrillic-iso-environment): New function. (setup-cyrillic-koi8-environment): New function. (setup-cyrillic-alternativnyj-environment): New function. @@ -11784,20 +11784,20 @@ (auto-file-coding-system-function): Set this variable to `auto-file-coding-system'. - * international/quail.el (quail-terminate-translation): Run - input-method-after-insert-chunk-hook only when the current input + * international/quail.el (quail-terminate-translation): + Run input-method-after-insert-chunk-hook only when the current input method doesn't require conversion. (quail-no-conversion): Run input-method-after-insert-chunk-hook. * international/mule-util.el (coding-system-unification-table): - Deleted. + Delete. (coding-system-unification-table-for-decode): New function. (coding-system-unification-table-for-encode): New function. * international/mule.el (make-coding-system): Doc-string fixed. - * international/fontset.el (register-alternate-fontnames): New - function. + * international/fontset.el (register-alternate-fontnames): + New function. (x-complement-fontset-spec): Register alternate fontnames by calling register-alternate-fontnames. (instanciate-fontset): Likewise. @@ -11874,7 +11874,7 @@ (ps-background-image, ps-background, ps-header-height) (ps-get-face): New internal functions. (ps-control-character): Handle control characters. - (ps-gnus-print-article-from-summary): Updated for Gnus 5. + (ps-gnus-print-article-from-summary): Update for Gnus 5. (ps-jack-setup): Replace 'nil by nil, 't by t. 1997-08-19 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> @@ -11890,8 +11890,8 @@ * files.el (append-to-file): Doc-string fixed. - * international/quail.el (quail-exit-from-minibuffer): Call - inactivate-input-method instead of (quail-mode -1). + * international/quail.el (quail-exit-from-minibuffer): + Call inactivate-input-method instead of (quail-mode -1). (quail-kill-guidance-buf): New function. (quail-mode): Doc-string and comments modified. Make this function non-interactive. Add quail-kill-guidance-buf to @@ -11970,35 +11970,35 @@ (quail-define-package): Indentation fixed. (quail-setup-overlays): New arg conversion-mode. Pay attention to input-method-highlight-flag. - (quail-mode-line-format): Deleted. - (quail-generate-mode-line-format): Deleted. + (quail-mode-line-format): Delete. + (quail-generate-mode-line-format): Delete. (quail-mode): Don't handle input-method-inactivate-hook and input-method-activate-hook here. Delete code setting quail-mode-line-format. (quail-saved-current-map): Name changed from quail-saved-overriding-local-map. (quail-toggle-mode-temporarily): Completely re-written. - (quail-execute-non-quail-command): Use - quail-toggle-mode-temporarily. - (quail-conv-overlay-modification-hook): Deleted. - (quail-suppress-conversion): Deleted. + (quail-execute-non-quail-command): + Use quail-toggle-mode-temporarily. + (quail-conv-overlay-modification-hook): Delete. + (quail-suppress-conversion): Delete. (quail-start-translation): Completely re-written. (quail-start-translation-in-conversion-mode): Likewise. (quail-delete-region): Check if quail-overlay is active. - (quail-get-current-str): Don't call throw. Set - overriding-terminal-local-map correctly. + (quail-get-current-str): Don't call throw. + Set overriding-terminal-local-map correctly. (quail-update-translation): Run hooks in input-method-after-insert-chunk-hook. (quail-self-insert-command): Catch 'quail-tag here. - (quail-conversion-delete-char): Don't call throw. Set - overriding-terminal-local-map to nil. + (quail-conversion-delete-char): Don't call throw. + Set overriding-terminal-local-map to nil. (quail-conversion-backward-delete-char): Likewise. (quail-no-conversion): Likewise. - (quail-help-insert-keymap-description): Bind - overriding-terminal-local-map instead of overriding-local-map. + (quail-help-insert-keymap-description): + Bind overriding-terminal-local-map instead of overriding-local-map. - * international/mule-cmds.el (previous-input-method): This - variable deleted. + * international/mule-cmds.el (previous-input-method): + This variable deleted. (input-method-history): New variable. (read-input-method-name): Bind minibuffer-history to input-method-history. @@ -12006,27 +12006,27 @@ previous-input-method. Run hooks in input-method-activate-hook. (inactivate-input-method): Update input-method-history. Run hooks in input-method-inactivate-hook. - (select-input-method): Doc-string modified. Use - input-method-history instead of previous-input-method. Set - default-input-method to input-method. - (toggle-input-method): Doc-string modified. Use - input-method-history instead of previous-input-method. + (select-input-method): Doc-string modified. + Use input-method-history instead of previous-input-method. + Set default-input-method to input-method. + (toggle-input-method): Doc-string modified. + Use input-method-history instead of previous-input-method. (read-multilingual-string): Bind minibuffer-setup-hook correctly. (input-method-exit-on-invalid-key): New variable. - * isearch.el (isearch-multibyte-characters-flag): Deleted. + * isearch.el (isearch-multibyte-characters-flag): Delete. (isearch-mode): Do not bind isearch-multibyte-characters-flag and isearch-input-method. (isearch-printing-char): Use current-input-method instead of isearch-input-method. (isearch-message-prefix): Likewise. - * international/isearch-x.el (isearch-input-method): Deleted. - (isearch-input-method-title): Deleted. + * international/isearch-x.el (isearch-input-method): Delete. + (isearch-input-method-title): Delete. (isearch-toggle-specified-input-method): Call toggle-input-method. (isearch-toggle-input-method): Likewise. - (isearch-process-search-multibyte-characters): Use - current-input-method instead of isearch-input-method. + (isearch-process-search-multibyte-characters): + Use current-input-method instead of isearch-input-method. 1997-08-17 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> @@ -12045,7 +12045,7 @@ For writing, use buffer-file-coding-system if set, otherwise buffer-file-type. (find-file-not-found-set-buffer-file-coding-system): - Renamed from find-file-not-found-set-buffer-file-type. + Rename from find-file-not-found-set-buffer-file-type. Set buffer-file-coding-system as well as buffer-file-type. 1997-08-16 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> @@ -12066,8 +12066,8 @@ * international/isearch-x.el (isearch-process-search-multibyte-characters): Bind input-method-verbose-flag, not input-method-tersely-flag. - * international/mule-cmds.el (input-method-verbose-flag): Renamed - from input-method-tersely-flag and sense inverted. + * international/mule-cmds.el (input-method-verbose-flag): + Rename from input-method-tersely-flag and sense inverted. (input-method-highlight-flag): New variable. (toggle-input-method): Pass missing arg to read-input-method-name. @@ -12079,8 +12079,8 @@ 1997-08-16 Kenichi Handa <handa@etl.go.jp> - * language/china-util.el (setup-chinese-gb-environment): Delete - a code setting default value of default-input-method. + * language/china-util.el (setup-chinese-gb-environment): + Delete a code setting default value of default-input-method. (setup-chinese-big5-environment): Likewise. (setup-chinese-cns-environment): Likewise. @@ -12107,7 +12107,7 @@ * loadup.el (loaddefs.el): Load that file much later, almost last. Delete most calls to garbage-collect. -1997-08-15 Barry A. Warsaw <cc-mode-help@python.org> +1997-08-15 Barry A. Warsaw <bwarsaw@cnri.reston.va.us> * progmodes/cc-styles.el (c-style-alist): "python" style requires c-comment-continuation-stars be "". @@ -12271,7 +12271,7 @@ * dos-fns.el (dos-print-region-function): Force EOL conversion to DOS CR-LF pairs. -1997-08-10 Barry A. Warsaw <cc-mode-help@python.org> +1997-08-10 Barry A. Warsaw <bwarsaw@cnri.reston.va.us> * Release 5.15 @@ -12324,7 +12324,7 @@ (c-enable-//-in-c-mode): Obsolete. * progmodes/cc-langs.el (c++-mode-syntax-table, java-mode-syntax-table) - (objc-mode-syntax-table, idl-mode-syntax-table): Added autoload + (objc-mode-syntax-table, idl-mode-syntax-table): Add autoload cookies. c-mode-syntax-table already has one. Use the new syntax table initialization idioms. @@ -12333,7 +12333,7 @@ lines are now analyzed as template-args-cont. * progmodes/cc-styles.el (c-offsets-alist): - Added template-args-cont syntactic symbol. + Add template-args-cont syntactic symbol. * progmodes/cc-styles.el (c-styles-alist): In "java" style, set c-hanging-comment-starter-p to @@ -12353,16 +12353,16 @@ * international/mule.el (make-coding-system): Add a new FLAGS elements SAFE. Use it for terminal coding system if some other coding system is specified explicitly. - (ignore-relative-composition): Initialize - ignore-relative-composition. + (ignore-relative-composition): + Initialize ignore-relative-composition. - * international/mule-util.el(prefer-coding-system): Moved to + * international/mule-util.el(prefer-coding-system): Move to mule-util.el. * international/mule-cmds.el (set-default-coding-systems): Doc-string modified. - (prefer-coding-system): Moved from mule-util.el. Call - set-default-coding-systems. + (prefer-coding-system): Move from mule-util.el. + Call set-default-coding-systems. * international/mule-conf.el (iso-safe): New coding system. @@ -12416,7 +12416,7 @@ * help.el (describe-key): Don't put a colon after the command name. -1997-08-09 Barry A. Warsaw <cc-mode-help@python.org> +1997-08-09 Barry A. Warsaw <bwarsaw@cnri.reston.va.us> * progmodes/cc-engine.el (c-beginning-of-statement-1): When checking for bare semi, don't match @@ -12438,7 +12438,7 @@ c-hanging-comment-starter-p to nil to preserve Javadoc starter lines. * progmodes/cc-styles.el (c-set-style-2): - Fixed broken implementation of inherited styles. + Fix broken implementation of inherited styles. * progmodes/cc-styles.el (c-set-style): Call c-initialize-builtin-style. @@ -12639,12 +12639,12 @@ 1997-08-04 Espen Skoglund <espensk@odslab5.cs.uit.no> * pascal.el (pascal-mode-syntax-table): _ is now a symbol constituent. - (pascal-indent-case): Removed unnecessary calls to marker-position. + (pascal-indent-case): Remove unnecessary calls to marker-position. (pascal-indent-declaration): Editing a parameterlist at the end of a buffer does not hang. Removed unnecessary call to marker-position. - (pascal-get-lineup-indent): Removed unused variable. + (pascal-get-lineup-indent): Remove unused variable. Indent parameterlist correctly. - (pascal-completion-response): Removed unused variable. + (pascal-completion-response): Remove unused variable. 1997-08-04 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de> @@ -12653,16 +12653,16 @@ * isearch.el (isearch-quote-char): Fix handling of control characters, copied from quoted-insert. - * emacs-lisp/pp.el (pp-to-string): Use - emacs-lisp-mode-syntax-table. + * emacs-lisp/pp.el (pp-to-string): + Use emacs-lisp-mode-syntax-table. * international/quail.el (quail-update-leim-list-file): Go to the beginning of the package file, in case it was already visited. 1997-08-04 Kenichi Handa <handa@etl.go.jp> - * language/english.el (setup-english-environment): Call - set-default-coding-systems. + * language/english.el (setup-english-environment): + Call set-default-coding-systems. * language/china-util.el (setup-chinese-gb-environment): Do not call set-terminal-coding-system and set-keyboard-coding-system, @@ -12676,8 +12676,8 @@ * language/korean.el (setup-korean-environment): Likewise. - * international/mule-cmds.el (set-default-coding-systems): New - function. + * international/mule-cmds.el (set-default-coding-systems): + New function. * international/mule.el (default-terminal-coding-system): New var. (set-terminal-coding-system): @@ -12772,20 +12772,20 @@ * term/x-win.el: Fix previous change. - * international/quail.el (quail-next-translation): Call - quail-execute-non-quail-command when no current translations. + * international/quail.el (quail-next-translation): + Call quail-execute-non-quail-command when no current translations. (quail-prev-translation): Likewise. (quail-next-translation-block): Likewise. (quail-prev-translation-block): Likewise. - * language/china-util.el (setup-chinese-gb-environment): Set - default value of default-input-method. + * language/china-util.el (setup-chinese-gb-environment): + Set default value of default-input-method. (setup-chinese-big5-environment): Likewise. (setup-chinese-cns-environment): Likewise. Correct input method name. - * language/ethio-util.el (setup-ethiopic-environment): Bind - correct commands in global-map, rmail-mode-map, and mail-mode-map. + * language/ethio-util.el (setup-ethiopic-environment): + Bind correct commands in global-map, rmail-mode-map, and mail-mode-map. * language/ethiopic.el (ccl-encode-ethio-font): Fix typo in doc-string. Set default value of default-input-method. @@ -12872,23 +12872,23 @@ * international/fontset.el (fontset-name-p): New function. (uninstanciated-fontset-alist): New variable. - (create-fontset-from-fontset-spec): Delete arg STYLE. Register - style-variants of FONTSET in uninstanciated-fontset-alist. - (create-fontset-from-x-resource): Call - create-fontset-from-fontset-spec correctly. + (create-fontset-from-fontset-spec): Delete arg STYLE. + Register style-variants of FONTSET in uninstanciated-fontset-alist. + (create-fontset-from-x-resource): + Call create-fontset-from-fontset-spec correctly. * international/mule-util.el (reference-point-alist): Doc-string modified. - * term/x-win.el: Do not create style-variants of fontset. They - are just registered in uninstanciated-fontset-alist. + * term/x-win.el: Do not create style-variants of fontset. + They are just registered in uninstanciated-fontset-alist. 1997-07-31 Michael Kifer <kifer@cs.sunysb.edu> - * ediff*.el (ediff-eval-in-buffer): Changed macro and renamed + * ediff*.el (ediff-eval-in-buffer): Change macro and renamed ediff-with-current-buffer. Eliminated inefficient calls to `intern'. - * ediff-diff.el (ediff-exec-process): Changed to work with buffers + * ediff-diff.el (ediff-exec-process): Change to work with buffers whose names have spaces. (ediff-wordify): Use buffer-substring-no-properties. @@ -13070,8 +13070,8 @@ 1997-07-25 Ken'ichi Handa <handa@psilocin.gnu.ai.mit.edu> - * international/quail.el (quail-update-leim-list-file): Call - find-file-noselect with t for arguments NOWARN and RAWFILE. + * international/quail.el (quail-update-leim-list-file): + Call find-file-noselect with t for arguments NOWARN and RAWFILE. * international/mule-cmds.el (leim-list-entry-regexp): Make this match only at beginning of line. @@ -13120,8 +13120,8 @@ * language/tibet-util.el (setup-tibetan-environment): Correct coding system names. Set default-input-method to "tibetan-wylie". - * language/viet-util.el (setup-vietnamese-environment): Add - autoload cookie. + * language/viet-util.el (setup-vietnamese-environment): + Add autoload cookie. 1997-07-25 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> @@ -13143,7 +13143,7 @@ 1997-07-24 Michael Kifer <kifer@cs.sunysb.edu> * viper.el (viper-non-vi-major-modes): New variable. - (vip-set-hooks): Changed so it'll update viper-non-vi-major-modes. + (vip-set-hooks): Change so it'll update viper-non-vi-major-modes. (viper-mode): Now checks viper-non-vi-major-modes. 1997-07-24 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> @@ -13168,11 +13168,11 @@ * cus-face.el (custom-declare-face): Use [set-]face-documentation. - * faces.el (face-documentation): Renamed from face-doc-string. - (set-face-documentation): Renamed from set-face-doc-string. + * faces.el (face-documentation): Rename from face-doc-string. + (set-face-documentation): Rename from set-face-doc-string. (face-doc-string): Make this an alias. - * term/bg-mouse.el (bg-yank-or-pop): Changed eql to eq. + * term/bg-mouse.el (bg-yank-or-pop): Change eql to eq. * international/mule-cmds.el (read-input-method-name): Fix error msg. @@ -13342,8 +13342,8 @@ Use undecided-dos for dos-text file names. Use undecided for non-existing untranslated file names. - * international/mule.el (modify-coding-system-alist): Added. - international/mule-util.el (modify-coding-system-alist): Removed. + * international/mule.el (modify-coding-system-alist): Add. + international/mule-util.el (modify-coding-system-alist): Remove. * loadup.el [windows-nt, ms-dos]: Undo loading of international/mule-utils. @@ -13407,7 +13407,7 @@ (occur-mode-find-occurrence): Use `occur' text property to find marker for locus of the occurrence. (occur-next, occur-prev): New commands. - (occur): Fixed bug preventing line number being displayed if line + (occur): Fix bug preventing line number being displayed if line number is less than the number of lines of context. 1997-07-18 Andre Spiegel <spiegel@inf.fu-berlin.de> @@ -13467,7 +13467,7 @@ * paren.el (show-paren-match-face): Use gray on all non-color screens. -1997-07-17 Barry A. Warsaw <cc-mode-help@python.org> +1997-07-17 Barry A. Warsaw <bwarsaw@cnri.reston.va.us> * progmodes/cc-mode.el (c-initialize-cc-mode): New function. (c-mode, c++-mode, objc-mode, java-mode): Call it. @@ -13480,7 +13480,7 @@ * progmodes/cc-langs.el: Require 'cc-defs for the definition of c-emacs-features. - * progmodes/cc-langs.el (c-mode-menu): Added uncomment region and + * progmodes/cc-langs.el (c-mode-menu): Add uncomment region and slight rearrangement of items. * progmodes/cc-cmds.el: Require cc-defs for the c-add-syntax macro. @@ -13493,8 +13493,8 @@ * progmodes/cc-engine.el (c-maybe-labelp): Add defvar. - * progmodes/cc-styles.el (c-initialize-builtin-style): Use - copy-sequence instead of c-copy-tree. + * progmodes/cc-styles.el (c-initialize-builtin-style): + Use copy-sequence instead of c-copy-tree. * progmodes/cc-defs.el (c-load-all): Function deleted. @@ -13564,17 +13564,17 @@ * international/quail.el (quail-translate-key): Fix previous change. - * international/mule.el (make-coding-system): Distinguish - coding-category-iso-7-else and coding-category-iso-8-else. + * international/mule.el (make-coding-system): + Distinguish coding-category-iso-7-else and coding-category-iso-8-else. - * international/mule-conf.el (coding-category-emacs-mule): Replace - coding-category-iso-else with coding-category-iso-7-else and + * international/mule-conf.el (coding-category-emacs-mule): + Replace coding-category-iso-else with coding-category-iso-7-else and coding-category-iso-8-else. - * international/mule-diag.el (describe-current-coding-system): Use - coding-category-iso-7-else instead of coding-category-iso-else. + * international/mule-diag.el (describe-current-coding-system): + Use coding-category-iso-7-else instead of coding-category-iso-else. - * language/china-util.el (setup-chinese-gb-environment): Adjusted + * language/china-util.el (setup-chinese-gb-environment): Adjust for the change of coding category names. Set default-input-method to chinese-py-punct. (setup-chinese-big5-environment): Set default-input-method to @@ -13582,18 +13582,18 @@ (setup-chinese-cns-environment): Set default-input-method correctly. - * language/english.el (setup-english-environment): Adjusted for + * language/english.el (setup-english-environment): Adjust for the change of coding category names. - * language/japan-util.el (setup-japanese-environment): Adjusted + * language/japan-util.el (setup-japanese-environment): Adjust for the change of coding category names. Set default-input-method correctly. - * language/ethio-util.el (setup-ethiopic-environment): Set - default-input-method correctly. + * language/ethio-util.el (setup-ethiopic-environment): + Set default-input-method correctly. - * language/korean.el (setup-korean-environment): Set - default-input-method correctly. + * language/korean.el (setup-korean-environment): + Set default-input-method correctly. * language/tibet-util.el (setup-tibetan-environment: Set default-input-method correctly. @@ -13656,8 +13656,8 @@ for iswitchb-kill-buffer and iswitchb-find-file. (iswitchb): When no text typed in, show all buffers. (iswitchb-complete): Use equal rather than eq. - (iswitchb-next-match, iswitchb-prev-match): Use - iswitchb-chop to handle reordering the buffer list. + (iswitchb-next-match, iswitchb-prev-match): + Use iswitchb-chop to handle reordering the buffer list. (iswitchb-chop): New function. (iswitchb-make-buflist): Rewritten for efficiency. (iswitchb-to-end): Operate on a list of buffers, not just one. @@ -13727,8 +13727,8 @@ 1997-07-10 Kenichi Handa <handa@etl.go.jp> - * international/fontset.el (create-fontset-from-fontset-spec): Add - optional arg NOERROR. + * international/fontset.el (create-fontset-from-fontset-spec): + Add optional arg NOERROR. (create-fontset-from-x-resource): Give t as arg NOERROR to create-fontset-from-fontset-spec. @@ -13742,11 +13742,11 @@ (isearch-input-method-title): New variable. (isearch-toggle-specified-input-method): Set the above variables. (isearch-toggle-input-method): Likewise. - (isearch-process-search-multibyte-characters): Give - isearch-input-method as arg to read-multilingual-string. + (isearch-process-search-multibyte-characters): + Give isearch-input-method as arg to read-multilingual-string. - * international/mule-cmds.el (read-multilingual-string): Adjusted - for the previous change of variables related to input methods. + * international/mule-cmds.el (read-multilingual-string): + Adjust for the previous change of variables related to input methods. * isearch.el (isearch-message-prefix): Likewise. @@ -13806,7 +13806,7 @@ * progmodes/cc-*.el: New files, totally reorganized. * dunnet.el: Undo an earlier change: - (dun-piss): Renamed from dunnet-urinate. + (dun-piss): Rename from dunnet-urinate. (dun-verblist): Indecent word added back. (dunnet): Delete "censored" message. @@ -13913,7 +13913,7 @@ * browse-url.el: Require thingatpt when compiling. (browse-url-url-at-point): Use `thing-at-point' (with URL code moved from here). - (browse-url-looking-at): Moved to thingatpt.el, renamed and changed. + (browse-url-looking-at): Move to thingatpt.el, renamed and changed. * thingatpt.el (thing-at-point): Use `thing-at-point' property, if any. (bounds-of-thing-at-point): Use `bounds-of-thing-at-point' property. @@ -13952,11 +13952,11 @@ (widget-default-delete): Ditto. * wid-edit.el (color): Make it an editable field. - (widget-color-value-create): Deleted. - (widget-color-value-get): Deleted. - (widget-color-value-set): Deleted. - (color-item): Deleted. - (widget-color-item-button-face-get): Renamed to + (widget-color-value-create): Delete. + (widget-color-value-get): Delete. + (widget-color-value-set): Delete. + (color-item): Delete. + (widget-color-item-button-face-get): Rename to `widget-color-sample-face-get'. (color-sample): Delete. (editable-color): Delete. @@ -14066,15 +14066,15 @@ (custom-browse-visibility-action, custom-browse-group-tag) (custom-browse-group-tag-action, custom-browse-variable-tag-action) (custom-browse-face-tag, custom-browse-face-tag-action) - (custom-browse-face-tag-action, custom-browse-alist): Changed - prefix from `custom-tree' to `custom-browse'. + (custom-browse-face-tag-action, custom-browse-alist): + Change prefix from `custom-tree' to `custom-browse'. (custom-variable-value-create, custom-face-value-create) - (custom-group-value-create): Updated caller. + (custom-group-value-create): Update caller. * cus-edit.el (custom-browse-only-groups): New option. (custom-group-value-create): Use it. Omit non-groups if non-nil. - * cus-edit.el (custom-help-menu): Renamed "Variable" to "Option". + * cus-edit.el (custom-help-menu): Rename "Variable" to "Option". Remove "..." from non-prompting entries. * wid-edit.el (widget-single-line-field-face): New face. @@ -14096,7 +14096,7 @@ * language/european.el (setup-8-bit-environment): New argument LANGUAGE. - (setup-latin1-environment): Adjusted for the above change. + (setup-latin1-environment): Adjust for the above change. (setup-latin2-environment): Likewise. (setup-latin3-environment): Likewise. (setup-latin4-environment): Likewise. @@ -14106,8 +14106,8 @@ * language/hebrew.el (setup-hebrew-environment): Likewise. - * language/cyril-util.el (setup-cyrillic-environment): Adjusted - for the change of an input method name. + * language/cyril-util.el (setup-cyrillic-environment): + Adjust for the change of an input method name. * language/devan-util.el (setup-devanagari-environment): Likewise. @@ -14155,25 +14155,25 @@ (quail-defrule): Doc-string modified. (quail-defrule-internal): Document it. (quail-get-translation): Change the format of DEF part. - (quail-lookup-key): Make the second argument LEN optional. Reset - quail-current-translations to nil. + (quail-lookup-key): Make the second argument LEN optional. + Reset quail-current-translations to nil. (quail-map-definition): New function. (quail-get-current-str): New function. (quail-guidance-translations-starting-column): New variable. (quail-update-current-translations): New function. - (quail-translate-key): Adjusted for the change of DEF format. + (quail-translate-key): Adjust for the change of DEF format. Call quail-update-current-translations. (quail-next-translation): Call quail-update-current-translations. (quail-prev-translation): Likewise. (quail-next-translation-block): Likewise. (quail-prev-translation-block): Likewise. - (quail-select-translation): Deleted. + (quail-select-translation): Delete. (quail-make-guidance-frame): New function. (quail-show-guidance-buf): Handle the case that minibuffer is in a separate frame. (quail-hide-guidance-buf): Likewise. - (quail-show-translations): Call - quail-update-current-translations. Check width of a frame to be + (quail-show-translations): + Call quail-update-current-translations. Check width of a frame to be used. (quail-completion): Do not supply LEN argument to quail-lookup-key. @@ -14186,8 +14186,8 @@ (charset-chars, charset-width, charset-direction) (charset-iso-final-char, charset-iso-graphic-plane) (charset-reverse-charset, charset-short-name, charset-long-name) - (charset-description, charset-plit, set-charset-plist): Document - them. + (charset-description, charset-plit, set-charset-plist): + Document them. (make-char, charset-list): Doc-string modified. (find-new-buffer-file-coding-system): Fix bug of handling the coding system undecided. @@ -14296,16 +14296,16 @@ (updates): Reject subdirs whose names start with =. (custom-deps, finder-data, autoloads, update-subdirs): Likewise. - * scroll-bar.el (toggle-scroll-bar): Moved from frame.el. + * scroll-bar.el (toggle-scroll-bar): Move from frame.el. Use scroll-bar-mode to determine which side; if it's nil, use left. (set-scroll-bar-mode): New subroutine, taken from scroll-bar-mode. (scroll-bar-mode): Use the variable set-scroll-bar-mode. (scroll-bar-mode): New variable. Extra defvar to avoid warning. - (toggle-horizontal-scroll-bar): Moved from frame.el. + (toggle-horizontal-scroll-bar): Move from frame.el. * frame.el (scroll-bar-side): Variable deleted. (toggle-scroll-bar, toggle-horizontal-scroll-bar): - Moved to scroll-bar.el. + Move to scroll-bar.el. * files.el (file-chase-links): When handling .., make newname absolute. Simplify several places. @@ -14399,7 +14399,7 @@ * wid-edit.el (widget-button-click): Steal up event if key is not bound in `widget-global-map'. - * cus-edit.el (custom-tree-insert-prefix): Renamed from + * cus-edit.el (custom-tree-insert-prefix): Rename from `custom-tree-insert'. (custom-group-value-create): Use it. @@ -14482,7 +14482,7 @@ (custom-button-face): New defface. (custom widget-type): Use custom-button-face for buttons. (custom-group-tag-faces): Initial value is nil. - (custom-variable-tag-face): Renamed from custom-variable-sample-face. + (custom-variable-tag-face): Rename from custom-variable-sample-face. Initialize it like custom-group-tag-face. (custom-group-tag-faces): Initialize to nil. (custom-state-face): New defface. @@ -14497,21 +14497,21 @@ only if the item is modified. Take widget as arg. (custom-mode): Use widget-edit-functions. - * wid-edit.el (widget-edit-functions): Renamed from widget-edit-hook. + * wid-edit.el (widget-edit-functions): Rename from widget-edit-hook. (widget-field-action): Pass the widget as an arg when running hook. - * cus-edit.el (Custom-set): Renamed from custom-set. - (Custom-save): Renamed from custom-save. + * cus-edit.el (Custom-set): Rename from custom-set. + (Custom-save): Rename from custom-save. (custom-browse-sort-predicate): Defalias deleted. (custom-group-value-create): Don't sort, in tree mode. - (Custom-mode-menu): Renamed from custom-mode-menu. - (Custom-reset-current): Renamed from custom-reset-current. - (Custom-reset-saved): Renamed from custom-reset-saved. - (Custom-reset-standard): Renamed from custom-reset-standard. - (Custom-menu-update): Renamed from custom-menu-update. - (customize-set-value): Renamed from custom-set-value. - (customize-set-variable): Renamed from custom-set-variable. - (customize-save-customized): Renamed from custom-save-customized. + (Custom-mode-menu): Rename from custom-mode-menu. + (Custom-reset-current): Rename from custom-reset-current. + (Custom-reset-saved): Rename from custom-reset-saved. + (Custom-reset-standard): Rename from custom-reset-standard. + (Custom-menu-update): Rename from custom-menu-update. + (customize-set-value): Rename from custom-set-value. + (customize-set-variable): Rename from custom-set-variable. + (customize-save-customized): Rename from custom-save-customized. * cus-start.el (double-click-time): Use restricted-sexp. (load-path): Make [Current dir?] itself the active button. @@ -14548,7 +14548,7 @@ instead of displaying an echo area message. (widget-toggle-action): Likewise. (group-visibility, widget-group-visibility-create): - Moved to cus-edit.el and renamed. + Move to cus-edit.el and renamed. 1997-06-23 Dan Nicolaescu <done@ece.arizona.edu> @@ -14623,7 +14623,7 @@ 1997-06-22 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> * decipher.el (decipher-copy-cons): - Renamed from decipher-get-undo-copy. Calls changed. + Rename from decipher-get-undo-copy. Calls changed. * emacs-lisp/lmenu.el (popup-menu): Redefine as macro. (popup-menu-popup, popup-menu-internal): New function. @@ -14747,11 +14747,11 @@ (custom-variable-value-create): Use it. (custom-face-value-create): Use it. (custom-group-value-create): Use it. - (custom-buffer-groups-last): Changed default. + (custom-buffer-groups-last): Change default. - * wid-edit.el (group-visibility): Deleted. + * wid-edit.el (group-visibility): Delete. (widget-group-visibility-create): Ditto. - (group-link): Deleted. + (group-link): Delete. (widget-group-link-create): Ditto. (widget-group-link-action): Ditto. @@ -14761,12 +14761,12 @@ (custom-group-link-action): New function. (custom-group-value-create): Use `custom-group-link'. - * wid-edit.el (widget-before-change): Fixed comment and debug string. + * wid-edit.el (widget-before-change): Fix comment and debug string. - * cus-edit.el (custom-mode-customize-menu): Deleted. + * cus-edit.el (custom-mode-customize-menu): Delete. (custom-mode-menu): Define here. (custom-mode): Don't add here. - (custom-format-handler): Deleted. + (custom-format-handler): Delete. (custom): Don't add here. * cus-edit.el (custom-browse-sort-predicate): New alias. @@ -14776,7 +14776,7 @@ (custom-group): Ditto. (custom-group-value-create): Ditto. - * cus-edit.el (face): Fixed format. + * cus-edit.el (face): Fix format. (custom-face-value-create): Browse face, not option. * cus-edit.el (custom-group-value-create): Rewrote to replace @@ -14787,8 +14787,8 @@ (custom-variable): Ditto. (custom-face): Delete :format and :format-handler. (custom): Add :format. - (custom-format-handler): Removed unnecessary code. - (custom-face-format-handler): Deleted. + (custom-format-handler): Remove unnecessary code. + (custom-face-format-handler): Delete. (custom-add-see-also): New function. (custom-buffer-style): New option. (widget-face-value-create): Use it here instead of :format. @@ -14817,13 +14817,13 @@ (custom-menu-sort-predicate): Use them. (custom-menu-create): Use it. (custom-buffer-sort-predicate, custom-buffer-order-predicate) - (custom-menu-sort-predicate, custom-menu-order-predicate): Deleted. + (custom-menu-sort-predicate, custom-menu-order-predicate): Delete. * wid-edit.el (widget-leave-text): Don't delete nil overlays. * wid-edit.el (widget-get-indirect): New function. (widget-default-create): Use it. - (widget-button-insert-indirect): Deleted. + (widget-button-insert-indirect): Delete. * wid-edit.el (widget-inactive-face): Use dim gray instead of dark gray. @@ -15004,9 +15004,9 @@ 1997-06-18 Ken'ichi Handa <handa@psilocin.gnu.ai.mit.edu> - * mule-util.el (coding-system-parent): Moved to mule.el. + * mule-util.el (coding-system-parent): Move to mule.el. - * mule.el (coding-system-parent): Moved from mule-util.el. + * mule.el (coding-system-parent): Move from mule-util.el. 1997-06-18 Kenichi Handa <handa@etl.go.jp> @@ -15015,7 +15015,7 @@ * subdirs.el: Add "language" in the argument of normal-top-level-add-to-load-path. - * rmail.el (rmail-enable-decoding-message): Deleted. + * rmail.el (rmail-enable-decoding-message): Delete. (rmail-revert): Bind enable-multibyte-characters to nil before calling rmail-convert-file. (rmail-convert-to-babyl-format): If enable-multibyte-characters is @@ -15049,7 +15049,7 @@ (coding-system-list): Sort coding systems by coding-system-lessp. An element of returned list is always coding system, never be a cons. - (modify-coding-system-alist): Renamed from + (modify-coding-system-alist): Rename from set-coding-system-alist. (prefer-coding-system): New function. (compose-chars-component): But fix for handling a composite @@ -15076,8 +15076,8 @@ not a valid KEY argument now. (leim-list-file-name, leim-list-header, leim-list-entry-regexp): New variables. - (update-leim-list-file, update-all-leim-list-files): New - functions. + (update-leim-list-file, update-all-leim-list-files): + New functions. (current-input-method): Doc-string modified because the value is now input method name. (default-input-method, previous-input-method): Likewise. @@ -15086,12 +15086,12 @@ (input-method-alist): New variable. (register-input-method): Register input method in input-method-alist. - (read-language-and-input-method-name): Deleted. + (read-language-and-input-method-name): Delete. (read-input-method-name): New function. (activate-input-method, select-input-method, toggle-input-method): - Modified for the above change. + Modify for the above change. (read-multilingual-string): Likewise. - (describe-current-input-method): Renamed from + (describe-current-input-method): Rename from describe-input-method. (describe-input-method): New function. (describe-language-environment): Don't put a vacant line at the @@ -15121,7 +15121,7 @@ * language/cyril-util.el (setup-cyrillic-iso-environment) (setup-cyrillic-koi8-environment) - (setup-cyrillic-alternativnyj-environment): Deleted. + (setup-cyrillic-alternativnyj-environment): Delete. (setup-cyrillic-environment): New function. * language/cyrillic.el: Don't make the keymap @@ -15171,12 +15171,12 @@ * tar-mode.el (tar-extract): Use second argument of view-buffer instead of setting view-exit-action. - * files.el (view-read-only): New option variable. If - non-nil then buffers visiting files read-only, do it in view mode. + * files.el (view-read-only): New option variable. + If non-nil then buffers visiting files read-only, do it in view mode. (find-file-read-only, find-file-read-only-other-window) (find-file-read-only-other-frame): Call toggle-read-only instead of setting buffer-read-only explicitly. - (toggle-read-only, after-find-file): Changed to be aware + (toggle-read-only, after-find-file): Change to be aware of view-read-only. (save-some-buffers): Use second argument of view-buffer instead of setting view-exit-action. @@ -15191,7 +15191,7 @@ * icon.el (icon-indent-line): A comment ends at the end of the line, delete call to nonexistent function. - * icon.el (icon-font-lock-keywords-1): Improved regexp. + * icon.el (icon-font-lock-keywords-1): Improve regexp. (icon-font-lock-keywords-2): Likewise. 1997-06-16 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> @@ -15210,15 +15210,15 @@ 1997-06-16 Simon Marshall <simon@gnu.ai.mit.edu> - * icon.el (icon-imenu-generic-expression): Improved regexp. - (icon-font-lock-keywords-1): Improved regexps. + * icon.el (icon-imenu-generic-expression): Improve regexp. + (icon-font-lock-keywords-1): Improve regexps. (icon-font-lock-keywords-2): Likewise. (icon-mode): Don't set font-lock-comment-start-regexp via font-lock-defaults; it is not needed anymore. 1996-06-16 Dan Nicolaescu <done@ece.arizona.edu> - * icon.el (icon-imenu-generic-expression): Improved regexp. + * icon.el (icon-imenu-generic-expression): Improve regexp. (icon-mode): Don't use pushnew. 1997-06-16 Michelangelo Grigni <mic@mathcs.emory.edu> @@ -15226,9 +15226,9 @@ * ffap.el (ffap-soft-value): Make this a function again; the macro version does intern-soft too early. Deleted XEmacs-specific code. - (ffap-string-at-point-mode-alist): Added "=" and + (ffap-string-at-point-mode-alist): Add "=" and "&" to the url syntax, as suggested by SJE. - (ffap-read-file-or-url): Fixed the HIST argument to + (ffap-read-file-or-url): Fix the HIST argument to completing-read (only visible in XEmacs?), as reported by Christoph Wedler <wedler@fmi.uni-passau.de>. (ffap-kpathsea-expand-path): New func, replaces ffap-add-subdirs, @@ -15237,7 +15237,7 @@ Added mouse-track support (but no binding), as suggested by MDB. Moved Emacs mouse bindings from "down-mouse" events to ordinary mouse events. - (ffap-alist): Added ffap-fortran-mode, as requested by MDB. + (ffap-alist): Add ffap-fortran-mode, as requested by MDB. Rewrote and merged XEmacs support, eliminating file ffap-xe.el. Modified ffap-other-frame to work in dedicated frames, fixing a bug reported by JENS. @@ -15247,20 +15247,20 @@ (ffap-read-file-or-url): For XEmacs, give extra HACK-HOMEDIR arg to `abbreviate-file-name'. (ffap-file-at-point): Suppress errors from `ffap-alist'. - (ffap-url-at-point): Modified regexp to accept + (ffap-url-at-point): Modify regexp to accept mail hostnames ending with a digit. Fixes bug report of SJE. (ffap-url-at-point): Use higher level function (w3-view-this-url t) suggested by wmperry, instead of w3-zone-at/w3-zone-data or widget-at/widget-get. - (ffap-url-at-point): Modified to work with + (ffap-url-at-point): Modify to work with w3-version "WWW 2.3.64 1996/06/02 06:20:23" alpha, which uses the 'widget package rather than the old w3-zone-at. Bug was reported by JENS. Adapted comments and doc strings to Emacs coding conventions. Reorganized. Retired v18 support. (ffap-bindings): Offers a default installation. - (ffap-string-at-point): Modified arguments. - (ffap-gnus-hook): Updated for Gnus 5. + (ffap-string-at-point): Modify arguments. + (ffap-gnus-hook): Update for Gnus 5. (ffap-tex-init): Delayed initialization of `ffap-tex-path'. (ffap-dired): New entry in `ffap-alist'. (ffap-menu-rescan): May fontify the choices in buffer. @@ -15309,7 +15309,7 @@ * cus-edit.el (widget-glyph-insert-glyph): Make the invisible extent open ended. - * cus-edit.el (custom-format-handler): Added :echo-help to + * cus-edit.el (custom-format-handler): Add :echo-help to visibility widget. (custom-variable-value-create): Ditto, also for tag. * wid-edit.el (widget-documentation-string-value-create): Ditto. @@ -15325,7 +15325,7 @@ * wid-edit.el (widget-tabable-at): New function. (widget-move): Use it. - * wid-edit.el (widget-after-change): Reimplemented :secret. + * wid-edit.el (widget-after-change): Reimplement :secret. * wid-edit.el (widget-field-add-space): New option. (widget-specify-field): Use it. @@ -15378,7 +15378,7 @@ view-mode-enter or view-mode-exit. (view-buffer, view-buffer-other-window): New argument exit-action. (view-file, view-file-other-window, view-buffer-other-window) - (view-buffer, view-mode-enter): Changed method used to restore + (view-buffer, view-mode-enter): Change method used to restore windows when leaving view mode. (view-mode-exit): New function. (view-return-to-alist): New variable. @@ -15468,7 +15468,7 @@ (widget-documentation-string-value-create): Also use documentation properties on single line documentation strings. - * wid-browse.el (widget-minor-mode): Fixed mistake in + * wid-browse.el (widget-minor-mode): Fix mistake in widget-minor-mode - it had semantics of non-interactive calling reversed. @@ -15482,7 +15482,7 @@ * add-log.el (add-log-time-format): New variable. (add-log-iso8601-time-string): New function. (add-change-log-entry): Use add-log-time-format. - (add-log-iso8601-time-zone): Renamed from iso8601-time-zone. + (add-log-iso8601-time-zone): Rename from iso8601-time-zone. 1997-06-13 Dan Nicolaescu <done@ece.arizona.edu> @@ -15490,7 +15490,7 @@ (isearch-close-unecessary-overlays): New function. (isearch-range-invisible): Use them. - * isearch.el (search-invisible): Changed the semantics, + * isearch.el (search-invisible): Change the semantics, the default value and updated the doc string. (isearch-opened-overlays): New variable. (isearch-mode): Initialize it. @@ -15504,7 +15504,7 @@ opened, open them, add them to isearch-opened-overlays and say that the range is visible. - * hideshow.el (hideshow): Added a :prefix. + * hideshow.el (hideshow): Add a :prefix. (hs-isearch-open): New variable. (hs-flag-region): Use that variable. Changed the semantics of the FLAG parameter and updated the docs. @@ -15551,7 +15551,7 @@ Fix error messages. * text-mode.el (paragraph-indent-text-mode): - Renamed from spaced-text-mode. + Rename from spaced-text-mode. (text-mode-map): Bind TAB to indent-relative. (indented-text-mode-map): Variable deleted. (indented-text-mode): Now an alias for text-mode. @@ -15569,7 +15569,7 @@ * bibtex.el (bibtex-delete-whitespace, bibtex-current-line) (bibtex-assoc-of-regexp, bibtex-skip-to-valid-entry) (bibtex-map-entries): - Renamed from delete-whitespace, current-line, assoc-of-regexp, + Rename from delete-whitespace, current-line, assoc-of-regexp, skip-to-valid-bibtex-entry, and map-bibtex-entries, respectively. 1997-06-11 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> @@ -15585,14 +15585,14 @@ (reftex-label-alist-builtin): New default environment subfigure. (reftex-find-duplicate-labels): Temporary buffer is now "*Duplicate Labels*" instead of "*Help*". - (reftex-bibtex-selection-callback): Renamed variable found-list. - (reftex-found-list): Added defvar for this variable. - (TeX-master): Added defvar for this variable. + (reftex-bibtex-selection-callback): Rename variable found-list. + (reftex-found-list): Add defvar for this variable. + (TeX-master): Add defvar for this variable. (reftex-reset-mode): Kill temporary buffers associated with RefTeX. 1997-06-10 Ken'ichi Handa <handa@psilocin.gnu.ai.mit.edu> - * mule-cmds.el (view-hello-file): Adjusted for the changes of + * mule-cmds.el (view-hello-file): Adjust for the changes of coding system names. 1997-06-10 Terrence Brannon <brannon@sand.usc.edu> @@ -15637,14 +15637,14 @@ 1997-06-10 Stefan Schoef <schoef@OFFIS.Uni-Oldenburg.DE> - * bibtex.el (bibtex-mode-map): Changed the binding of the C-TAB + * bibtex.el (bibtex-mode-map): Change the binding of the C-TAB key, such that XEmacs will understand it, too. * bibtex.el (bibtex-format-entry, bibtex-end-of-entry): Give specific error message if not on valid BibTeX entry. - * bibtex.el (bibtex-field-string-quoted): Small bug fix. Allow - backslash followed by newline. + * bibtex.el (bibtex-field-string-quoted): Small bug fix. + Allow backslash followed by newline. * bibtex.el (bibtex-reposition-window, bibtex-mark-entry): Two new functions, bound to M-C-l and M-C-h, respectively. @@ -15662,7 +15662,7 @@ of ---. (bibtex-font-lock-keywords): Don't treat ALT prefixed entries as comments. - (bibtex-entry): Fixed parameter list. This function is not + (bibtex-entry): Fix parameter list. This function is not intended to be called with required and optional fields as optional arguments anymore. @@ -15679,7 +15679,7 @@ * bibtex.el (bibtex-submit-bug-report): Report all variables. * bibtex.el (bibtex-contline-indentation): New user option. - (bibtex-entry-offset): Renamed from bibtex-entry-indentation. + (bibtex-entry-offset): Rename from bibtex-entry-indentation. * bibtex.el (bibtex-entry-field-alist): Used different order for some fields (as documented in btxdoc.tex). Changed one of the @@ -15694,7 +15694,7 @@ * bibtex.el (bibtex-reference-key): Reincluded parentheses. Parentheses should be disallowed only in field constants. - * bibtex.el (bibtex-autokey-transcriptions): Fixed bug (two + * bibtex.el (bibtex-autokey-transcriptions): Fix bug (two entries for `\o' while `\oe' entry was missing). * bibtex.el (bibtex-entry-indentation): New variable to determine @@ -15702,7 +15702,7 @@ (bibtex-move-outside-of-entry): Use `skip-chars-forward' instead of `re-search-forward'. (bibtex-beginning-of-first-entry, bibtex-beginning-of-last-entry): - Renamed from beginning-of-first-bibtex-entry and + Rename from beginning-of-first-bibtex-entry and beginning-of-last-bibtex-entry. Go to beginning of line, return point. (bibtex-do-auto-fill, bibtex-make-field, bibtex-entry) (bibtex-String, bibtex-Preamble): Respect `bibtex-entry-indentation'. @@ -15714,8 +15714,8 @@ (bibtex-clean-entry): Use `bibtex-reference-maybe-empty-head' instead of a fixed string. - * bibtex.el (bibtex-beginning-of-entry, bibtex-end-of-entry): Now - return point if called from a program. + * bibtex.el (bibtex-beginning-of-entry, bibtex-end-of-entry): + Now return point if called from a program. (bibtex-enclosing-field, bibtex-format-entry) (bibtex-generate-autokey, bibtex-parse-keys, bibtex-mode) (bibtex-ispell-entry, bibtex-narrow-to-entry, bibtex-sort-buffer) @@ -15740,12 +15740,12 @@ * bibtex.el (bibtex-entry-delimiters): New variable to determine if entries shall be delimited by braces or parentheses. - (bibtex-entry-left-delimiter, bibtex-entry-right-delimiter): New - helper functions. - (bibtex-entry, bibtex-String, bibtex-Preamble): Respect - `bibtex-entry-delimiters'. + (bibtex-entry-left-delimiter, bibtex-entry-right-delimiter): + New helper functions. + (bibtex-entry, bibtex-String, bibtex-Preamble): + Respect `bibtex-entry-delimiters'. (bibtex-entry-format): Doc fix. - (bibtex-reference-key, bibtex-field-const): Removed parentheses + (bibtex-reference-key, bibtex-field-const): Remove parentheses from allowed characters. (bibtex-end-of-entry): Better handling of incorrect preambles. @@ -15763,7 +15763,7 @@ (current-line): New helper function to calculate current linenumber. Something like this should really be defined somewhere else in Emacs. - (bibtex-validate): Changed to show all errors in buffer in a + (bibtex-validate): Change to show all errors in buffer in a `compilation mode' buffer. If there are syntax errors, it aborts after the syntax check, since higher-level check functions rely on the syntactical correctness of buffer. If called from another lisp @@ -15774,7 +15774,7 @@ (twice as high) than `lazy-lock-stealth-time'. (bibtex-member-of-regexp, assoc-of-regexp): Small cosmetic changes. - * bibtex.el (bibtex-buffer-last-parsed-tick): Renamed from + * bibtex.el (bibtex-buffer-last-parsed-tick): Rename from bibtex-buffer-last-parsed-for-keys-tick and made it really buffer-local (bug fix). (bibtex-parse-keys): Make it use bibtex-buffer-last-parsed-tick. @@ -15786,7 +15786,7 @@ if it has been aborted. (bibtex-mode): Run the new function bibtex-parse-buffers-stealthily. - * bibtex.el (bibtex-generate-autokey): Changed the name part + * bibtex.el (bibtex-generate-autokey): Change the name part generation (bugfix). This function handles now correctly all three forms of BibTeX names, "First von Last", "von Last, First", "von Last, Jr, First". In every case the "Last" part is correctly @@ -15794,15 +15794,15 @@ the first is used. Name fields spread over more than one line are no problem anymore. - * bibtex.el (bibtex-entry-format): Changed default value to + * bibtex.el (bibtex-entry-format): Change default value to exclude 'page-dashes. Modified documentation. (bibtex-autokey-name-change-strings) (bibtex-autokey-titleword-abbrevs) (bibtex-autokey-titleword-change-strings, bibtex-entry) (bibtex-validate): Doc fixes. (bibtex-mode-map): Bound `C-c $' to bibtex-ispell-abstract. - (bibtex-generate-autokey): Changed documentation. Small - modification in calculating title field. + (bibtex-generate-autokey): Change documentation. + Small modification in calculating title field. (bibtex-mode): Included bibtex-ispell-entry into the list of `interesting' functions. (bibtex-kill-field): Bug fix (killing of first field in entry @@ -15818,7 +15818,7 @@ * bibtex.el (bibtex-mode-map): bibtex-complete-key wasn't bound correctly. - (bibtex-complete): Fixed bug (used string entries defined in + (bibtex-complete): Fix bug (used string entries defined in buffer as object to completion). * bibtex.el (Menu): Use easymenu. More menu items for @@ -15839,16 +15839,16 @@ (bibtex-kill-field): Use new variable bibtex-field-kill-ring. (bibtex-kill-entry): Use new variable bibtex-entry-kill-ring. - * bibtex.el (bibtex-kill-ring, bibtex-kill-ring-yank-pointer): New - internal variables like kill-ring and kill-ring-yank-pointer, but + * bibtex.el (bibtex-kill-ring, bibtex-kill-ring-yank-pointer): + New internal variables like kill-ring and kill-ring-yank-pointer, but bibtex-kill-ring holds fields or complete reference entries instead of raw strings. (bibtex-kill-ring-max): New user option similar to kill-ring-max. - (bibtex-kill-field): Renamed from bibtex-delete-field again. It - now supports the new variable bibtex-kill-ring. + (bibtex-kill-field): Rename from bibtex-delete-field again. + It now supports the new variable bibtex-kill-ring. (bibtex-copy-field-as-kill, bibtex-kill-entry) - (bibtex-copy-entry-as-kill, bibtex-yank, bibtex-yank-pop): New - interactive functions, which work on the bibtex-kill-ring + (bibtex-copy-entry-as-kill, bibtex-yank, bibtex-yank-pop): + New interactive functions, which work on the bibtex-kill-ring variable. (bibtex-insert-current-kill): New helper function to insert contents of bibtex-kill-ring in an appropriate way. @@ -15871,9 +15871,9 @@ generation, if year field of current entry is absent. (bibtex-generate-autokey): Use this new variable. - * bibtex.el (bibtex-include-OPTannote): Deleted (is set in + * bibtex.el (bibtex-include-OPTannote): Delete (is set in bibtex-user-optional-fields). - (bibtex-entry, bibtex-print-help-message): Removed support for + (bibtex-entry, bibtex-print-help-message): Remove support for bibtex-include-OPTannote. * bibtex.el (bibtex-entry-format): New constant @@ -15882,25 +15882,25 @@ * bibtex.el (bibtex-mode): Set value for font-lock-mark-block-function. - * bibtex.el (bibtex-font-lock-keywords): Changed to distinguish + * bibtex.el (bibtex-font-lock-keywords): Change to distinguish optional from ordinary fields. (bibtex-format-entry, bibtex-print-help-message) (bibtex-remove-OPT-or-ALT, bibtex-pop): Used simpler regexps. - * bibtex.el (bibtex-delete-field): Changed from + * bibtex.el (bibtex-delete-field): Change from bibtex-delete-optional-or-alternative-field. Deletes now mandatory fields as well. - (bibtex-mode): Changed documentation. + (bibtex-mode): Change documentation. - * bibtex.el (bibtex-entry-type-history, bibtex-key-history): New - variables to use own histories in BibTeX buffers. + * bibtex.el (bibtex-entry-type-history, bibtex-key-history): + New variables to use own histories in BibTeX buffers. (bibtex-entry, bibtex-clean-entry, bibtex-String): Use these new variables. * bibtex.el (bibtex-entry, bibtex-make-field): A function can now be used to generate a fields init string. (bibtex-include-OPTkey, bibtex-include-OPTannote) - (bibtex-entry-field-alist): Changed documentation accordingly. + (bibtex-entry-field-alist): Change documentation accordingly. * bibtex.el (bibtex-mode): bibtex-parse-keys on start of mode is now abortable, too. @@ -15913,7 +15913,7 @@ * bibtex.el (bibtex-find-entry-location): Bug fix: Insertion into completely empty buffer didn't work. - * bibtex.el (bibtex-user-optional-fields): Renamed from + * bibtex.el (bibtex-user-optional-fields): Rename from bibtex-mode-user-optional-fields. (bibtex-submit-bug-report, bibtex-entry, bibtex-print-help-message): Use bibtex-user-optional-fields. @@ -15922,9 +15922,9 @@ delimiting braces and not those inside fields. * bibtex.el (skip-to-valid-bibtex-entry, bibtex-parse-keys) - (bibtex-end-of-entry, bibtex-validate, bibtex-reformat): Calculate - complex regexps outside of loops. - (bibtex-mode): Changed documentation on how to convert third party + (bibtex-end-of-entry, bibtex-validate, bibtex-reformat): + Calculate complex regexps outside of loops. + (bibtex-mode): Change documentation on how to convert third party buffers. * bibtex.el (bibtex-convert-alien): New function to convert a @@ -15938,7 +15938,7 @@ call of bibtex-parse-keys. This avoids unnecessary double call if Font Lock mode is chosen for buffer at startup. - * bibtex.el (bibtex-String, bibtex-Preamble): Renamed from + * bibtex.el (bibtex-String, bibtex-Preamble): Rename from bibtex-string and bibtex-preamble. (bibtex-String): If bibtex-maintain-sorted-entries and bibtex-sort-ignore-string-entries are both non-nil, read string @@ -15946,9 +15946,9 @@ location (as for normal entries). * bibtex.el (bibtex-autokey-titleword-first-ignore) - (bibtex-autokey-titleword-abbrevs): Changed documentation: case of + (bibtex-autokey-titleword-abbrevs): Change documentation: case of regexps doesn't matter anymore. - (bibtex-field-const, bibtex-reference-key): Simplified to not + (bibtex-field-const, bibtex-reference-key): Simplify to not contain uppercase letters. (member-of-regexp, assoc-of-regexp): Ignore case of regexp. (map-bibtex-entries): Call function not for every syntactical correct @@ -15969,24 +15969,24 @@ (bibtex-end-of-entry): Only report an "unknown entry" message if called interactively. - * bibtex.el (bibtex-sort-ignore-string-entries): Renamed back from + * bibtex.el (bibtex-sort-ignore-string-entries): Rename back from bibtex-sort-ignore-string-and-preamble. Of course, preambles are always ignored, since they have no key at all. (bibtex-string): Slightly less complex regexp. (skip-to-valid-bibtex-entry): New helper function to skip forward (or backward) to beginning of next syntactical correct known - BibTeX entry, if not already there. Respects - bibtex-sort-ignore-string-entries. + BibTeX entry, if not already there. + Respects bibtex-sort-ignore-string-entries. (map-bibtex-entries): Bug fix: It wasn't called for string entries even if bibtex-sort-ignore-string-entries was nil. (beginning-of-last-bibtex-entry): New helper function to go to last entry in buffer. (bibtex-end-of-entry): Bug fix: Now works with string and preamble entries as well. - (bibtex-sort-buffer): Renamed from bibtex-sort-entries. Simplified + (bibtex-sort-buffer): Rename from bibtex-sort-entries. Simplified by using new function skip-to-valid-bibtex-entry. Now only known entries are checked. - (bibtex-find-entry-location): Simplified by using new functions + (bibtex-find-entry-location): Simplify by using new functions skip-to-valid-bibtex-entry and beginning-of-last-bibtex-entry. Only known entries are used to determine location. (bibtex-validate): Now checks string entries, too. @@ -15994,8 +15994,8 @@ bibtex-end-of-entry. * bibtex.el (bibtex-end-of-entry): Don't use forward-sexp anymore, - since this fails on entries with non-escaped double-quotes. Use - search-bibtex-reference instead (though it is slower, it is more + since this fails on entries with non-escaped double-quotes. + Use search-bibtex-reference instead (though it is slower, it is more reliable). (bibtex-ispell-abstract): Use normal regexps created by bibtex-cfield instead of special ones. @@ -16007,7 +16007,7 @@ work, since due to a bug all entries were simply skipped. * bibtex.el (bibtex-mode): Doc fix. - (bibtex-delete-optional-or-alternative-field): Renamed from + (bibtex-delete-optional-or-alternative-field): Rename from bibtex-kill-optional-or-alternative-field. (bibtex-delete-optional-or-alternative-field, bibtex-empty-field): Use delete-region, not kill-region. @@ -16020,7 +16020,7 @@ buffer, died on entries with `@' in other than first column). (beginning-of-first-bibtex-entry, bibtex-format-entry) (bibtex-beginning-of-entry, bibtex-validate, bibtex-clean-entry): - Changed to allow BibTeX entries to start in a column different + Change to allow BibTeX entries to start in a column different from 1 (but still for speed reasons only whitespace is allowed prior to the `@' on the same line. @@ -16044,21 +16044,21 @@ (bibtex-find-entry-location): A bug had been introduced by using search-bibtex-reference instead of re-search-forward (fixed). - * bibtex.el (bibtex-field-delimiters): Renamed from + * bibtex.el (bibtex-field-delimiters): Rename from bibtex-field-delimiter. (bibtex-entry-format): Constant empty-opts renamed to empty-opts-or-alts. - (bibtex-remove-delimiters): Renamed from + (bibtex-remove-delimiters): Rename from bibtex-remove-double-quotes-or-braces. (bibtex-reformat): New function. * bibtex.el (bibtex-fill-entry): New function to refill entry. - (bibtex-mode-map): Defined key for bibtex-fill-entry. + (bibtex-mode-map): Define key for bibtex-fill-entry. * bibtex.el (bibtex-field-delimiter): Substitutes variables bibtex-field-left-delimiter and bibtex-field-right-delimiter. - (bibtex-field-left-delimiter, bibtex-field-right-delimiter): New - helper functions. + (bibtex-field-left-delimiter, bibtex-field-right-delimiter): + New helper functions. (bibtex-make-field, bibtex-pop): Use new variable bibtex-field-delimiter. (bibtex-empty-field, bibtex-string): Use new functions @@ -16084,23 +16084,23 @@ (bibtex-mode): Don't set fill-prefix anymore, but use new function bibtex-do-auto-fill. - * bibtex.el (bibtex-find-entry-location): Fixed bug (when + * bibtex.el (bibtex-find-entry-location): Fix bug (when bibtex-maintain-sorted-entries was non-nil, an entry with a key greater than all other keys wasn't inserted in the correct place). * bibtex.el (bibtex-mode): Don't use bibtex-auto-fill-function anymore, but use directly variable fill-prefix. - * bibtex.el (bibtex-find-entry-location): Fixed bug (on duplicate + * bibtex.el (bibtex-find-entry-location): Fix bug (on duplicate keys, point must move to beginning of entry, so that bibtex-entry works correctly). - * bibtex.el (bibtex-complete): Fixed bug (parameter string-list + * bibtex.el (bibtex-complete): Fix bug (parameter string-list was mistakenly altered by the function itself). * bibtex.el (bibtex-mode-map): Bind bibtex-complete-key to C-TAB. - * bibtex.el (bibtex-validate): Renamed from bibtex-validate-buffer + * bibtex.el (bibtex-validate): Rename from bibtex-validate-buffer since it can acts on region if active. Use search-bibtex-reference. (search-bibtex-reference): New function to be used in places where prior a re-search-{forward|backward} for bibtex-reference or @@ -16113,22 +16113,22 @@ bibtex-enclosing-reference-maybe-empty-head. (bibtex-reference-infix, bibtex-reference-postfix): New constants necessary due to splitting bibtex-reference. - (bibtex-reference): Deleted. - (bibtex-type-in-reference, skip-whitespace-and-comments): Deleted. + (bibtex-reference): Delete. + (bibtex-type-in-reference, skip-whitespace-and-comments): Delete. * bibtex.el (bibtex-mode): Don't turn auto-fill-mode on. Use new variable normal-auto-fill-function. - * bibtex.el (bibtex-field-string): Simplified. + * bibtex.el (bibtex-field-string): Simplify. - * bibtex.el (bibtex-mode-syntax-table): Changed syntax of + * bibtex.el (bibtex-mode-syntax-table): Change syntax of double-quote back to quote syntax. * bibtex.el (bibtex-complete): New generic function for interface functions bibtex-complete-string and bibtex-complete-key. (bibtex-complete-key): New function. - * bibtex.el (bibtex-sort-ignore-string-and-preamble): Renamed from + * bibtex.el (bibtex-sort-ignore-string-and-preamble): Rename from bibtex-sort-ignore-string-entries. (map-bibtex-entries): Use bibtex-sort-ignore-string-and-preamble and ignore preamble entries as well. @@ -16152,10 +16152,10 @@ mark is active. With optional argument checks if required fields are missing, too. - * bibtex.el (bibtex-mode): Added support for imenu. + * bibtex.el (bibtex-mode): Add support for imenu. * bibtex.el (bibtex-entry-field-alist) - (bibtex-mode-user-optional-fields): Modified syntax to allow + (bibtex-mode-user-optional-fields): Modify syntax to allow preinitialization of fields. (bibtex-make-field, bibtex-make-optional-field): Support preinitialization of fields. @@ -16166,21 +16166,21 @@ (bibtex-generate-autokey): Use new variables. * bibtex.el (bibtex-field-const, bibtex-reference-type) - (bibtex-reference-key): Changed to match the (according to Oren + (bibtex-reference-key): Change to match the (according to Oren Patashnik) allowed characters. - * bibtex.el (bibtex-clean-entry-zap-empty-opts-or-alts): Renamed - from bibtex-clean-entry-zap-empty-opts. + * bibtex.el (bibtex-clean-entry-zap-empty-opts-or-alts): + Rename from bibtex-clean-entry-zap-empty-opts. (bibtex-entry-field-alist): Slightly modified syntax to support alternative fields needed for Book and InBook references. (bibtex-font-lock-keywords, bibtex-print-help-message) (bibtex-make-field, bibtex-pop, bibtex-clean-entry): Support ALT prefixed entries. - (bibtex-mode): Documented new ALT prefixed fields. - (bibtex-make-optional-field): Modified to give only field name as + (bibtex-mode): Document new ALT prefixed fields. + (bibtex-make-optional-field): Modify to give only field name as arg to bibtex-make-field. (bibtex-remove-OPT-or-ALT, bibtex-kill-optional-or-alternative-field): - Renamed from bibtex-remove-OPT and bibtex-kill-optional-field, + Rename from bibtex-remove-OPT and bibtex-kill-optional-field, respectively. Modified to support ALT prefixes. * bibtex.el (bibtex-enclosing-field, bibtex-print-help-message): @@ -16220,29 +16220,29 @@ 1997-06-09 Kenichi Handa <handa@etl.go.jp> - * mule.el: Delete declaration for buffer-file-coding-system. It - is done in buffer.c now. In the comment, change coding-system to + * mule.el: Delete declaration for buffer-file-coding-system. + It is done in buffer.c now. In the comment, change coding-system to coding system. The name coding-vector is changed to coding-spec. (coding-vector-type, coding-vector-mnemonic) - (coding-vector-docstring, coding-vector-flags): Deleted. + (coding-vector-docstring, coding-vector-flags): Delete. (coding-system-spec-ref): New function. (coding-system-type, coding-system-mnemonic, coding-system-flags): Use coding-system-spec-ref. - (coding-system-doc-string): Renamed from coding-system-docstring. - (coding-system-eol-type): Renamed from coding-system-eoltype. - (coding-system-eol-type-mnemonic): Moved to mule-util.el. + (coding-system-doc-string): Rename from coding-system-docstring. + (coding-system-eol-type): Rename from coding-system-eoltype. + (coding-system-eol-type-mnemonic): Move to mule-util.el. (coding-system-post-read-conversion): Likewise. (coding-system-pre-write-conversion): Likewise. - (default-process-coding-system): Deleted. Now declared in + (default-process-coding-system): Delete. Now declared in buffer.c. (make-subsidiary-coding-system): New function. (make-coding-system): Check arguments more strictly. Do not make -unix, -dos, -mac variants for TYPE 4. (define-coding-system-alias): Call make-subsidiary-coding-system. - (set-buffer-file-coding-system): Adjusted for the function name + (set-buffer-file-coding-system): Adjust for the function name changes. (find-new-buffer-file-coding-system): Likewise. - (default-process-coding-system): Deleted. Now defined in coding.c. + (default-process-coding-system): Delete. Now defined in coding.c. * mule-conf.el: Coding system names changed. @@ -16274,7 +16274,7 @@ (print-coding-system): Likewise. (list-coding-systems): Likewise. Make it interactive. - * mule-util.el (set-coding-system-alist): Deleted. + * mule-util.el (set-coding-system-alist): Delete. (string-to-sequence): Doc string modified. (coding-system-list): Add optional arg BASE-ONLY. (coding-system-base): New function. @@ -16367,14 +16367,14 @@ 1997-06-07 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> - * files.el (file-name-non-special): Handle - file-name-completion and file-name-all-completions. + * files.el (file-name-non-special): + Handle file-name-completion and file-name-all-completions. * mailalias.el: Customize. Doc fixes. Mark some risky local variables. * dired.el (dired-unmark-all-marks): - Renamed from dired-unmark-all-files-no-query. + Rename from dired-unmark-all-files-no-query. * language/european.el (setup-8-bit-environment): Load the file with load, not require, so that we reload it if nec. @@ -16382,28 +16382,28 @@ * language/english.el ("English"): Improve doc string. * language/indian.el (describe-indian-environment-map): - Renamed from describe-indian-support-map. + Rename from describe-indian-support-map. * language/devanagari.el: Corresponding changes. * language/european.el (describe-european-environment-map): - Renamed from describe-european-support-map. + Rename from describe-european-support-map. * language/cyrillic.el (describe-cyrillic-environment-map): - Renamed from describe-cyrillic-support-map. + Rename from describe-cyrillic-support-map. * language/chinese.el (describe-chinese-environment-map): - Renamed from describe-chinese-support-map. + Rename from describe-chinese-support-map. * mule-cmds.el (describe-language-environment): - Renamed from describe-language-support. + Rename from describe-language-support. Do the real work here; don't call describe-specified-language-support. Print the mnemonics when mentioning coding systems. Improve style of output. (describe-specified-language-environment): - Renamed from describe-specified-language-support. + Rename from describe-specified-language-support. Don't do the work here; call describe-language-environment. (describe-language-environment-map): - Renamed from describe-language-support-map. + Rename from describe-language-support-map. * language/european.el (setup-8-bit-environment): Do not set set-case-syntax-offset. @@ -16451,7 +16451,7 @@ 1997-06-04 Per Abrahamsen <abraham@dina.kvl.dk> - * wid-edit.el (widget-kill-line): Fixed for overlays. + * wid-edit.el (widget-kill-line): Fix for overlays. * cus-edit.el (custom-buffer-create-internal): Show full documentation string in buffers with only a single item. @@ -16467,9 +16467,9 @@ (widget-field-end): Workaround for local-map at end of overlay. (widget-specify-field): Ditto. - (widget-move): Fixed but with single button buffers. + (widget-move): Fix but with single button buffers. - * cus-edit.el (custom-buffer-create-internal): Improved help + * cus-edit.el (custom-buffer-create-internal): Improve help strings for reset buttons. * wid-edit.el (widget-move): Restored support for @@ -16477,7 +16477,7 @@ (widget-documentation-string-value-create): Restore support for `widget-documentation--face'. - * cus-edit.el (customize-variable-other-window): Added defalias. + * cus-edit.el (customize-variable-other-window): Add defalias. * widget.el (:complete): New keyword. (:complete-function): New keyword. @@ -16524,7 +16524,7 @@ 1997-06-02 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> - * text-mode.el (spaced-text-mode): Renamed from text-mode. + * text-mode.el (spaced-text-mode): Rename from text-mode. But change the mode name and hooks. (text-mode): Put the guts of indented-text-mode here. But don't define text-mode-abbrev-table, just use it. @@ -16544,14 +16544,14 @@ 1997-06-02 Michael Kifer <kifer@cs.sunysb.edu> - * ediff-util.el (ediff-toggle-multiframe): Improved. - (ediff-setup, ediff-inferior-compare-regions): Modified. + * ediff-util.el (ediff-toggle-multiframe): Improve. + (ediff-setup, ediff-inferior-compare-regions): Modify. (ediff-setup): Bug fixed. * ediff-init.el (ediff-file-attributes): Use ediff-file-remote-p. * ediff-wind.el (ediff-setup-windows-multiframe-merge) - (ediff-setup-windows-multiframe-compare): Improved window placement. + (ediff-setup-windows-multiframe-compare): Improve window placement. * ediff-diff.el (ediff-make-fine-diffs): - Fixed messages about whitespace regions. + Fix messages about whitespace regions. * ediff-wind.el, ediff-ptch.el, ediff-mult.el, ediff-merg.el: custom.el'ed. @@ -16560,11 +16560,11 @@ * viper-init.el (vip-parse-sexp-ignore-comments): New variable. * viper-cmd.el (vip-paren-match): Parsing comments is now controlled with vip-parse-sexp-ignore-comments. - * viper-cmd.el (vip-goto-col): Fixed. + * viper-cmd.el (vip-goto-col): Fix. * viper-cmd.el (vip-autoindent): Now expands abbrevs. (vip-adjust-keys-for): Unbinds vip-autoindent, if vip-auto-indent is nil. - * viper-cmd.el (vip-prefix-arg-value): Fixed computation of integer + * viper-cmd.el (vip-prefix-arg-value): Fix computation of integer prefix args. * viper-cmd.el, viper-init.el: New files. @@ -16617,14 +16617,14 @@ 1997-06-01 Dan Nicolaescu <done@ece.arizona.edu> - * hideshow.el (hs-show-hidden-short-form): Updated doc string. + * hideshow.el (hs-show-hidden-short-form): Update doc string. (hs-adjust-block-beginning): Likewise. (hs-special-modes-alist): C and C++ should also use hs-c-like-adjust-block-beginning. (hs-find-block-beginning): If hs-adjust-block-beginning is t and we apply hs-adjust-block-beginning and we reach the point means that we found the block beginning. - (hs-c-like-adjust-block-beginning): Renamed from + (hs-c-like-adjust-block-beginning): Rename from java-hs-adjust-block-beginning. 1997-06-01 Simon Leinen <simon@switch.ch> @@ -16666,7 +16666,7 @@ getting read-only bob and eob in XEmacs. * wid-browse.el (widget-browse-at): Use `get-char-property' instead of `get-text-property'. - * widget.el (:value-from :value-to): Deleted. + * widget.el (:value-from :value-to): Delete. * widget.el (:button-overlay, :field-overlay): New keywords. * wid-edit.el (widget-default-delete): Delete overlays. (widget-field-value-delete): Delete overlay. @@ -16700,7 +16700,7 @@ 1997-06-01 Per Abrahamsen <abraham@dina.kvl.dk> - * cus-edit.el (custom-format-handler): Changed look of group + * cus-edit.el (custom-format-handler): Change look of group indicators. * wid-edit.el (widget-kill-line): Use forward-line instead of @@ -16716,10 +16716,10 @@ * cus-edit.el (custom-variable-prompt): Handle variable-at-point returning 0. - (customize-option): Renamed from custom-variable. + (customize-option): Rename from custom-variable. (customize-variable): Add it as an alias. (customize-option-other-window): - Renamed from customize-variable-other-window. + Rename from customize-variable-other-window. (custom-load-symbol): Search for both short and absolute names of the library, when avoiding duplicate loading. @@ -16761,9 +16761,9 @@ * cus-edit.el (custom-format-handler): New %e and %- escapes. (custom-group): Use them. - * widget.el (:widget-doc): Removed keyword. - * wid-edit.el (widget-help): Removed widget. - (widget-help-action): Removed function. + * widget.el (:widget-doc): Remove keyword. + * wid-edit.el (widget-help): Remove widget. + (widget-help-action): Remove function. * widget.el (:documentation-shown): New keyword. * wid-edit.el (documentation-string): New widget. @@ -16807,7 +16807,7 @@ * mule-cmds.el (set-language-environment): Add autoload cookie. Renamed from setup-language-environment. - * startup.el (iso-8859-n-locale-regexp): Renamed from + * startup.el (iso-8859-n-locale-regexp): Rename from iso-8859-1-locale-regexp. * loadup.el: Always load faces.el. @@ -16856,8 +16856,8 @@ * icomplete.el: Integrated Emacs 19.34 and XEmacs 19.15 corrections (typos, style, command revisions, etc). - * icomplete.el: Integrated immediate keybindings display. See - `icomplete-show-key-bindings', `icomplete-get-keys', and + * icomplete.el: Integrated immediate keybindings display. + See `icomplete-show-key-bindings', `icomplete-get-keys', and `icomplete-completions'. * icomplete.el (icomplete-get-keys): Return keys bound in prior @@ -16903,7 +16903,7 @@ * cus-edit.el (custom-magic-alist): Shortened message. - * cus-edit.el (custom-help-menu): Updated names. + * cus-edit.el (custom-help-menu): Update names. * cus-edit.el: Say `invoke' instead of `activate'. * wid-edit.el: Ditto. @@ -16930,13 +16930,13 @@ (widget-glyph-insert-glyph): No tag here. (widget-push-button-value-create): But here. - * wid-edit.el (widget-field-face): Changed to dim gray. + * wid-edit.el (widget-field-face): Change to dim gray. * wid-edit.el (widget-push-button-prefix): New option. (widget-push-button-suffix): New option. (widget-button): New group. - * widget.el (:text-format): Removed. + * widget.el (:text-format): Remove. (:button-suffix): New keyword. (:button-prefix): New keyword. @@ -16957,7 +16957,7 @@ * cus-edit.el (custom-magic-alist): Use `invoke' instead of `push'. - * cus-edit.el (custom-magic-alist): Changed rogue state message. + * cus-edit.el (custom-magic-alist): Change rogue state message. * custom.el (defface): Doc fix. @@ -16967,13 +16967,13 @@ * cus-edit.el, custom.el: Renamed `factory' to `standard' everywhere. - * cus-edit.el (custom-magic-show-button): Changed default to + * cus-edit.el (custom-magic-show-button): Change default to `nil'. - (custom): Removed `:format'. - (custom-variable): Removed level button. + (custom): Remove `:format'. + (custom-variable): Remove level button. (custom-face): Ditto. - (custom-level): Deleted. - (custom-level-action): Deleted. + (custom-level): Delete. + (custom-level-action): Delete. (custom-format-handler): Update caller. (custom-group-magic-alist): Merged into `custom-magic-alist'. (custom-magic-value-create): Use merged `custom-magic-alist'. @@ -16996,8 +16996,8 @@ * icomplete.el: Integrated Emacs 19.34 and XEmacs 19.15 corrections (typos, style, command revisions, etc). - Integrated hacked up XEmacs immediate keybindings display. See - `icomplete-show-key-bindings', `icomplete-get-keys', and + Integrated hacked up XEmacs immediate keybindings display. + See `icomplete-show-key-bindings', `icomplete-get-keys', and `icomplete-completions'. Doesn't work with mainline GNU Emacs 19.34 (because the cmdloop doesn't set owindow, and the current-local-map doesn't take optional buffer arg), so feature @@ -17046,7 +17046,7 @@ SYNTACTIC-PROPERTIES. Eval font-lock-syntactic-keywords with font-lock-eval-keywords. Compile and compare all keywords. (fast-lock-get-syntactic-properties): New function. - (fast-lock-add-properties): Renamed from fast-lock-set-face-properties. + (fast-lock-add-properties): Rename from fast-lock-set-face-properties. Take new arg SYNTACTIC-PROPERTIES and add syntax-table text properties. Now fast-lock.el saves a buffer's value of font-lock-syntactic-keywords and syntax-table text properties as added by font-lock.el. @@ -17133,7 +17133,7 @@ set-current-process-coding-system. * encoded-kb.el (encoded-kbd-mode): Fix typo in doc-string. - (encoded-kbd-set-coding-system): Deleted. + (encoded-kbd-set-coding-system): Delete. * case-table.el (describe-buffer-case-table): Use aref instead of set-char-table-range. @@ -17151,10 +17151,10 @@ (describe-specified-language-support): New function. (describe-language-support): Call the above function. (universal-coding-system-argument): New function. - (read-language-and-input-method-name): Doc-string fixed. If - default-input-method is nil, use previous-input-method as the + (read-language-and-input-method-name): Doc-string fixed. + If default-input-method is nil, use previous-input-method as the default value. - (set-default-input-method): Deleted. + (set-default-input-method): Delete. * language/*.el: Most of setup-LANGUAGE-environment functions are moved form LANGUAGE.el to LANG-util.el. These functions now at @@ -17270,7 +17270,7 @@ also accept a subdir with a file called `index'. * texinfmt.el (texinfo-extra-inter-column-width): - Renamed from extra-inter-column-width. Doc fix. + Rename from extra-inter-column-width. Doc fix. (texinfo-multitable-buffer-name): Variable renamed from multitable-temp-buffer-name. (texinfo-multitable-rectangle-name): @@ -17391,8 +17391,8 @@ read-only data someday. (eldoc-docstring-message): If truncating symbol name, show ending of name rather than beginning. The former is generally more unique. - (eldoc-function-argstring-from-docstring-method-table): Handle - pathological `save-restriction' case. + (eldoc-function-argstring-from-docstring-method-table): + Handle pathological `save-restriction' case. [top level]: Add `indent-for-tab-command' to eldoc-message-commands. 1997-05-21 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> @@ -17438,18 +17438,18 @@ (ada-font-lock-keywords-1): Move "task" before "task (body|type)" to correct highlighting (regexp depends on order). - * ada-mode.el (ada-in-char-const-p): Renamed from `ada-after-char-p'. + * ada-mode.el (ada-in-char-const-p): Rename from `ada-after-char-p'. Also test following character. (ada-adjust-case): Use better function `ada-in-char-const-p'. (ada-in-string-or-comment-p): Test for being in a char constant. - (ada-clean-buffer-before-saving): Changed default to t. + (ada-clean-buffer-before-saving): Change default to t. (ada-mode): Set `font-lock-defaults' for Emacs only, use properties for XEmacs. - * ada-mode.el (ada-indent-newline-indent): Simplified by just calling + * ada-mode.el (ada-indent-newline-indent): Simplify by just calling `ada-indent-current'. - * ada-mode.el (ada-end-stmt-re): Added word delimiters in regexp. + * ada-mode.el (ada-end-stmt-re): Add word delimiters in regexp. Removed `interactive' statements which were needed only for debugging. * ada-mode.el: @@ -17477,7 +17477,7 @@ (ada-goto-next-word): Generalized old `ada-goto-previous-word' for both directions. - * ada-mode.el (ada-indent-function): Removed unnecessary `package' case. + * ada-mode.el (ada-indent-function): Remove unnecessary `package' case. (ada-get-indent-case): Before testing for `=>', be sure there is an `is'. (ada-search-prev-end-stmt): Test for `separate' keyword on the @@ -17490,8 +17490,8 @@ * ada-mode.el: Doc fixes. (ada-mode): Support new font-lock-mode. - (ada-format-paramlist): Changed all `accept' to `access'. - (ada-insert-paramlist): Changed all `accept' to `access'. + (ada-format-paramlist): Change all `accept' to `access'. + (ada-insert-paramlist): Change all `accept' to `access'. (ada-in-comment-p): Use standard Emacs way `parse-partial-sexp'. (ada-font-lock-keywords-1): Regexps in not byte-compiled code behave different than byte-compiled regexps. @@ -17518,7 +17518,7 @@ 1997-05-20 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> - * word-help.el (set-word-help-file): Renamed from set-help-file. + * word-help.el (set-word-help-file): Rename from set-help-file. * crisp.el (crisp-mode): Add autoload cookie. @@ -17528,7 +17528,7 @@ * dos-w32.el (add-untranslated-filesystem) (remove-untranslated-filesystem): Add interactive spec. - * crisp.el (crisp-last-last-command): Renamed from last-last-command + * crisp.el (crisp-last-last-command): Rename from last-last-command and defvar added. * levents.el (event-closest-point): Fix paren error. @@ -17606,12 +17606,12 @@ (compilation-revert-buffer): New function. (compilation-mode): Set revert-buffer-function. - * files.el (revert-without-query): Renamed from + * files.el (revert-without-query): Rename from find-file-revert-without-query. (find-file-noselect): Use new option. (revert-buffer): Check the option here too. - * cus-face.el (custom-facep): Defined (once again). + * cus-face.el (custom-facep): Define (once again). * simple.el (do-auto-fill): Check enable-kinsoku and enable-multibyte-characters. @@ -17628,7 +17628,7 @@ 1997-05-16 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> - * autoload.el (update-autoloads-from-directories): Renamed from + * autoload.el (update-autoloads-from-directories): Rename from update-autoloads-from-directory. Take multiple directories as args. Use locate-library to find loaddefs.el and the top level Lisp dir. (batch-update-autoloads): Call update-autoloads-from-directories. @@ -17670,11 +17670,11 @@ * mule-cmds.el (set-language-info): Change the special treatment of key 'describe-function to 'documentation. - (describe-specified-language-support): Renamed from + (describe-specified-language-support): Rename from describe-language-support-internal. Get language name from last-command-event. - (describe-language-support): Call - describe-specified-language-support. + (describe-language-support): + Call describe-specified-language-support. * language/chinese.el: Delete functions describe-LANGUAGE-support. Delete 'describe-function entries and change 'documentation @@ -17791,13 +17791,13 @@ (default): Use `:mouse-down-action'. (menu-choice): Ditto. (widget-choice-mouse-down-action): New function. - (widget-info-link-action): Removed kludge to steal up event. + (widget-info-link-action): Remove kludge to steal up event. * cus-edit.el (widget-magic-mouse-down-action): New function. (custom-magic-value-create): Use it. - (custom-buffer-create-internal): Removed kludge to steal up event. + (custom-buffer-create-internal): Remove kludge to steal up event. - * widget.el (:glyph-up, :glyph-down, :glyph-inactive): New - keywords. + * widget.el (:glyph-up, :glyph-down, :glyph-inactive): + New keywords. * wid-edit.el (widget-glyph-insert-glyph): Support optional `down' and `inactive' glyphs. (widget-push-button-value-create): Ditto. @@ -17811,8 +17811,8 @@ (customize-variable-other-window, customize-face) (customize-face-other-window, customize-customized) (customize-saved, customize-apropos, custom-face-menu-create) - (custom-variable-menu-create, boolean, custom-menu-create): Updated - caller. + (custom-variable-menu-create, boolean, custom-menu-create): + Update caller. * cus-edit.el (custom-variable-action): Reset magic state. (custom-variable-menu): Allow `Reset to Current' on `changed' @@ -17853,24 +17853,24 @@ (choice, radio): Use it. (widget-prompt-value): Prepend widget type to prompt. - * wid-edit.el (widget-parent-action): Renamed from + * wid-edit.el (widget-parent-action): Rename from `widget-choice-item-action'. - (choice-item): Updated widget. + (choice-item): Update widget. * cus-edit.el (custom-magic): Ditto. - * wid-edit.el (widget-children-validate): Renamed from + * wid-edit.el (widget-children-validate): Rename from `widget-editable-list-validate'. - (editable-list, group): Updated widgets. + (editable-list, group): Update widgets. * cus-edit.el (custom, face): Ditto. - * wid-edit.el (widget-value-value-get): Renamed from + * wid-edit.el (widget-value-value-get): Rename from `widget-item-value-get'. - (item): Updated widget. + (item): Update widget. * cus-edit.el (face, custom): Ditto. - * wid-edit.el (widget-value-convert-widget): Renamed from + * wid-edit.el (widget-value-convert-widget): Rename from `widget-item-convert-widget'. - (item, editable-field): Updated widgets. + (item, editable-field): Update widgets. * cus-edit.el (face): Ditto. 1997-05-14 Simon Marshall <simon@wombat.gnu.ai.mit.edu> @@ -17986,13 +17986,13 @@ * gnus-mule.el: Moved to `gnus' subdirectory. - * gnus/gnus-mule.el (gnus-mule-message-send-news-function): New - function to encode text before sending by news. + * gnus/gnus-mule.el (gnus-mule-message-send-news-function): + New function to encode text before sending by news. (gnus-mule-message-send-mail-function): New function to encode text before sending by mail. (gnus-mule-initialize): Add gnus-mule-message-send-news-function - to the hook message-send-news-hook. Add - gnus-mule-message-send-mail-function to the hook + to the hook message-send-news-hook. + Add gnus-mule-message-send-mail-function to the hook message-send-mail-hook. * help.el (help-with-tutorial): Fix a bug of handling non-English @@ -18036,16 +18036,16 @@ Setting of syntax and category for Devanagari characters are moved to characters.el. - * language/english.el (setup-english-environment): Set - sendmail-coding-system and rmail-file-coding-system to nil. + * language/english.el (setup-english-environment): + Set sendmail-coding-system and rmail-file-coding-system to nil. * language/ethio-util.el (fidel-to-tex-map): Name changed to ethio-fidel-to-tex-map. * language/european.el: Typo in comment fixed. - * language/japanese.el (setup-japanese-environment): Set - sendmail-coding-system and rmail-file-coding-system to + * language/japanese.el (setup-japanese-environment): + Set sendmail-coding-system and rmail-file-coding-system to 'iso-2022-jp. * language/korean.el: Bug fixed in making coding system @@ -18095,8 +18095,8 @@ (rmail-convert-file): Comment fixed. (rmail-revert): Don't decode RMAIL file again because the backup file is saved in Emacs' internal format. - (rmail-convert-to-babyl-format): Check - rmail-enable-decoding-message. + (rmail-convert-to-babyl-format): + Check rmail-enable-decoding-message. * term/x-win.el: Create bold, italic, and bold-italic variants of default fontset. Name a fontset created from user-specified ASCII @@ -18138,7 +18138,7 @@ * simple.el (assoc-ignore-case): Downcase KEY as well as element cars. * bibtex.el (assoc-ignore-case): Function deleted. - (bibtex-member-of-regexp): Renamed from member-of-regexp. + (bibtex-member-of-regexp): Rename from member-of-regexp. Call changed. * timer.el (timer-event-handler): Take timer as arg directly. @@ -18340,7 +18340,7 @@ (compilation-shell-minor-mode-map, compilation-shell-minor-mode): New variables. (compile-auto-highlight): Doc fix. - (compilation-error-regexp-alist): Removed unnecessary line break + (compilation-error-regexp-alist): Remove unnecessary line break in first regexp. Replaced \\(\\|.* on \\) by \\(.* on \\)? in regexp for Absoft FORTRAN 77 Compiler 3.1.3. Added regexp for SPARCcompiler Pascal. Divided long line in regexp for Cray C @@ -18354,7 +18354,7 @@ (compilation-leave-directory-regexp-alist): New variables. (compilation-file-regexp-alist) (compilation-nomessage-regexp-alist): New variables. - (grep-regexp-alist): Removed unnecessary ^ at beginning of regexp. + (grep-regexp-alist): Remove unnecessary ^ at beginning of regexp. (compilation-enter-directory-regexp) (compilation-leave-directory-regexp): Variables deleted. Replaced by compilation-enter-directory-regexp-alist and @@ -18394,7 +18394,7 @@ * cus-edit.el (custom-group-magic-alist): New variable. (custom-group-state-update): Use custom-group-magic-alist. - (customize-group): Renamed from `customize', + (customize-group): Rename from `customize', and rename argument to GROUP. (customize): New function. @@ -18418,7 +18418,7 @@ * time-stamp.el (time-stamp-old-format-warn): Fix a tag string. (time-stamp-format): Use %Y not %y in default value. - * crisp.el (crisp-load-scroll-all): Renamed from ...-lock. + * crisp.el (crisp-load-scroll-all): Rename from ...-lock. (crisp-mode): Use scroll-all... not scroll-lock... * scroll-all.el: Renamed from scroll-lock.el. @@ -18476,7 +18476,7 @@ * ange-ftp.el (ange-ftp-file-entry-p): If ange-ftp-get-files returns nil, don't try ange-ftp-hash-entry-exists-p, just give up. - * comint.el (comint-input-face): Deleted. + * comint.el (comint-input-face): Delete. * compile.el (compilation-error-regexp-alist): Add regexp for Perl -w. @@ -18515,34 +18515,34 @@ "In" or "Out" command tells you if you are already on or off the bus. * dunnet.el (dun-sauna-heat): - Changed "begin to sweat" to "are perspiring" + Change "begin to sweat" to "are perspiring" so that it makes sense whether you are heating up or cooling down. * dunnet.el (dun-help): - Changed author e-mail address, added web page. + Change author e-mail address, added web page. Added hint for batch mode. * dunnet.el (*global*): - Fixed spelling of Presely in global object list. + Fix spelling of Presely in global object list. * dunnet.el (*global*): - Added coconuts, tank, and lake as objects that are recognized. + Add coconuts, tank, and lake as objects that are recognized. * dunnet.el (*global*): - Added `slip' as another way of describing the paper, + Add `slip' as another way of describing the paper, and `chip' as another way of describing the CPU. * dunnet.el (*global*): Upcase abbreviations of directions in room descriptions. * dunnet.el (dun-login): - Fixed erroneous login message to better-describe ftp limitations. + Fix erroneous login message to better-describe ftp limitations. * dunnet.el (dun-rlogin): - Added error message if user tries to rlogin back to pokey. + Add error message if user tries to rlogin back to pokey. * dunnet.el (dun-load-d): - Fixed so that if restore file isn't found which in non-batch mode, + Fix so that if restore file isn't found which in non-batch mode, window will switch back to game. 1997-04-27 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> @@ -18568,11 +18568,11 @@ 1997-04-26 Edward M Reingold <emr@silver.wisdom.weizmann.ac.il> - * cal-french.el (calendar-print-french-date): Label - French date in echo area. + * cal-french.el (calendar-print-french-date): + Label French date in echo area. - * cal-coptic.el (calendar-print-coptic-date): Label - Coptic/Ethiopic date in echo area. + * cal-coptic.el (calendar-print-coptic-date): + Label Coptic/Ethiopic date in echo area. 1997-04-25 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> @@ -18614,7 +18614,7 @@ * cus-edit.el (custom-set-value): New command. (custom-set-variable): New command. - (customize-saved): Renamed from `customize-customized'. + (customize-saved): Rename from `customize-customized'. (customize-customized): New command. (custom-save-customized): New command. @@ -18677,7 +18677,7 @@ * cus-edit.el (custom-display-unselected-match): Matched too many displays. - * wid-edit.el (widget-field-face): Changed default background + * wid-edit.el (widget-field-face): Change default background color. * custom.el (custom-declare-variable): Set `custom-get' the right @@ -18801,7 +18801,7 @@ * sh-script.el (sh-case): Make this a simple define-skeleton as it was originally. Don't add a menu-enable property. - (sh-assignment-regexp): Renamed from sh-assignment-prefix + (sh-assignment-regexp): Rename from sh-assignment-prefix undoing a renaming made by mistake. * sgml-mode.el (sgml-transformation): Fix previous change. @@ -18946,7 +18946,7 @@ * cus-start.el: Add support for face documentation. - * cus-dep.el (custom-make-dependencies): Fixed generation of + * cus-dep.el (custom-make-dependencies): Fix generation of parens. Fixed message. @@ -18975,8 +18975,8 @@ 1997-04-14 Steven L Baur <steve@altair.xemacs.org> - * edebug.el (edebug-read-and-maybe-wrap-form): Protect - against pathological recursive calls. + * edebug.el (edebug-read-and-maybe-wrap-form): + Protect against pathological recursive calls. 1997-04-14 Karl Heuer <kwzh@gnu.ai.mit.edu> @@ -19079,8 +19079,8 @@ variable instead. buffer-substring with 3 arguments is non-portable. * elp.el (elp-instrument-function, elp-instrument-list): - Handle function symbols that have already been instrumented. Do - not instrument them twice. + Handle function symbols that have already been instrumented. + Do not instrument them twice. * elp.el (elp-recycle-buffers-p): New variable. @@ -19128,18 +19128,18 @@ * cus-edit.el (customize-menu-create): New function. (custom-mode-customize-menu): Use it. - * cus-edit.el (custom-make-dependencies): Deleted function. + * cus-edit.el (custom-make-dependencies): Delete function. * cus-edit.el (customize-face): Sort faces. * cus-edit.el (custom-faces): New group. - (custom-magic-alist): Added. - (custom-variable-sample-face): Added. - (custom-variable-button-face): Added. - (custom-face-tag-face): Added. - (custom-group-tag-faces): Added. - (custom-group-tag-face): Added. - (customize): Removed from faces group. + (custom-magic-alist): Add. + (custom-variable-sample-face): Add. + (custom-variable-button-face): Add. + (custom-face-tag-face): Add. + (custom-group-tag-faces): Add. + (custom-group-tag-face): Add. + (customize): Remove from faces group. * cus-edit.el (custom-load-recursion): New variable. (custom-load-symbol): Use it. @@ -19151,14 +19151,14 @@ `custom-buffer-create'. (custom-buffer-create-other-window): New function. - * cus-edit.el (custom-guess-name-alist): Renamed from + * cus-edit.el (custom-guess-name-alist): Rename from `custom-guess-type-alist'. (custom-guess-doc-alist): New option. (custom-guess-type): Use them. - * cus-face.el (set-face-stipple): Removed Kyle Jones code. + * cus-face.el (set-face-stipple): Remove Kyle Jones code. - * cus-face.el (face-doc-string): Changed property name to + * cus-face.el (face-doc-string): Change property name to `face-documentation'. (set-face-doc-string): Ditto. @@ -19182,17 +19182,17 @@ unbound. (custom-menu-nesting): Don't define for XEmacs. - * cus-face.el (after-make-frame-hook): Removed - `custom-initialize-frame', as this is now in `frame.el'. + * cus-face.el (after-make-frame-hook): + Remove `custom-initialize-frame', as this is now in `frame.el'. * cus-edit.el (custom-guess-type-alist): New option. (custom-guess-type): New function. (custom-variable-type): New function. (custom-variable-value-create): Use it. - * cus-face.el (custom-face-attributes): Moved :family to the + * cus-face.el (custom-face-attributes): Move :family to the beginning of the list. - (custom-face-attributes): Added :strikethru attribute. + (custom-face-attributes): Add :strikethru attribute. * custom.el (custom-set-variables): If variable is already set, overwrite it here. @@ -19309,7 +19309,7 @@ (scheme-comment-indent, scheme-indent-offset) (scheme-indent-function, scheme-indent-line) (calculate-scheme-indent, scheme-indent-specform) - (scheme-indent-defform, scheme-indent-sexp): Removed; use lisp-mode + (scheme-indent-defform, scheme-indent-sexp): Remove; use lisp-mode equivalents. (scheme-imenu-generic-expression): New variable. (dsssl-imenu-generic-expression): New variable. @@ -19471,9 +19471,9 @@ 1997-03-30 Dan Nicolaescu <done@ece.arizona.edu> - * icon.el (icon-mode-map): Added menus. + * icon.el (icon-mode-map): Add menus. (icon-imenu-generic-expression): New variable to be used for imenu. - (icon-mode): Added font-lock, imenu and hideshow support. + (icon-mode): Add font-lock, imenu and hideshow support. (icon-font-lock-keywords-1, icon-font-lock-keywords-2): New constants for different level of font-lock fontification. (icon-font-lock-keywords): New variable. Default expression to be @@ -19502,7 +19502,7 @@ * sh-script.el (sh-mode): If file has no #! line, set the syntax table based on the default shell. -1997-03-29 Barry A. Warsaw <cc-mode-help@python.org> +1997-03-29 Barry A. Warsaw <bwarsaw@cnri.reston.va.us> * Public Release 4.389. @@ -19555,23 +19555,23 @@ * term.el: Added a lot of new faces, they all start with term- and follow a simple lexicographical convention. Note that each change is commented: just search for -mm in the source. - (term-char-mode): Added all the "gray-keys" to term-raw-map. + (term-char-mode): Add all the "gray-keys" to term-raw-map. (term-send-up): Similar, decided to go for the more xterm-like \eOA bindings in place of the previous \e[A. (term-buffer-maximum-size): New variable. - (term-mode): Added some make-local: now term-buffer-maximum-size, + (term-mode): Add some make-local: now term-buffer-maximum-size, ange-ftp-default-user/password/an-pwd. (term-emulate-terminal): Quite some modifications to allow multiple outstanding ANSI style commands: notably all the -previous-parameter stuff. Call term-handle-ansi-terminal-messages. - (term-emulate-terminal): Added simple trimming function: at the + (term-emulate-terminal): Add simple trimming function: at the end we simply check if the buffer is > term-buffer-maximum-size and cut it accordingly. (term-handle-colors-array): New function. (term-handle-ansi-terminal-messages): New function. - (term-handle-ansi-escape): Modified to allow ANSI coloring. - (ansi-term): New function that creates multiple terminals. Put - in the standard C-x map too: I'm quite used to C-x C-f and C-c C-f + (term-handle-ansi-escape): Modify to allow ANSI coloring. + (ansi-term): New function that creates multiple terminals. + Put in the standard C-x map too: I'm quite used to C-x C-f and C-c C-f was too awkward. 1997-03-29 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> @@ -19583,7 +19583,7 @@ * hideshow.el: Use overlays for hiding instead of selective display. Commented out the support for XEmacs because it doesn't support overlays. - (hs-special-modes-alist): Added support for java-mode. + (hs-special-modes-alist): Add support for java-mode. (hs-minor-mode-hook): New variable. (hs-c-start-regexp, hs-c-end-regexp, hs-forward-sexp-func) (hs-block-start-regexp, hs-block-end-regexp) @@ -19596,8 +19596,8 @@ (hs-hide-block-at-point, hs-hide-initial-comment-block) (java-hs-forward-sexp, hs-mouse-toggle-hiding): New functions. (hs-inside-comment-p, hs-hide-block) - (hs-show-block): Added support for single line comments. - (hs-hide-all): Added support for hiding comments. + (hs-show-block): Add support for single line comments. + (hs-hide-all): Add support for hiding comments. 1997-03-28 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> @@ -19711,7 +19711,7 @@ 1997-03-20 Dan Nicolaescu <done@ece.arizona.edu> * imenu.el (imenu-scanning-message): Support for bigger numbers. - (imenu--generic-function): Fixed probably a typo: named appeared + (imenu--generic-function): Fix probably a typo: named appeared twice in an item. Put function after name and beg in a special item because a normal item has name and beg (for orthogonality). (imenu-add-to-menubar): First test to see if the mode supports @@ -19742,8 +19742,8 @@ 1997-03-18 Kenichi Handa <handa@etl.go.jp> - * fontset.el (x-complement-fontset-spec): Setup - alternative-fontname-alist while complementing fontnames. + * fontset.el (x-complement-fontset-spec): + Setup alternative-fontname-alist while complementing fontnames. 1997-03-18 Naoto TAKAHASHI <ntakahas@etl.go.jp> @@ -19758,11 +19758,11 @@ (quail-keyboard-layout): Docstring changed to reflect the above change. (quail-keyboard-layout-len): Increased for the above change. - (quail-keyboard-layout-alist): Modified for the above change. + (quail-keyboard-layout-alist): Modify for the above change. 1997-03-18 Kenichi Handa <handa@etl.go.jp> - * mule.el (make-char): Documented. + * mule.el (make-char): Document. (charset-plist): Return quoted list even if CHARSET is supplied by symbol. @@ -19780,8 +19780,8 @@ * language/viet-util.el (viet-decode-viqr-region): Supply correct argumnents to rassoc. - (viqr-post-read-conversion, viqr-pre-write-conversion): New - functions. + (viqr-post-read-conversion, viqr-pre-write-conversion): + New functions. * language/vietnamese.el: Set the above functions to the coding system viqr. @@ -19856,7 +19856,7 @@ * mailalias.el (mail-passwd-files): New variable. (mail-get-names): Use mail-passwd-files instead of always /etc/passwd. -1997-03-12 Barry A. Warsaw <cc-mode-help@python.org> +1997-03-12 Barry A. Warsaw <bwarsaw@cnri.reston.va.us> * cc-mode.el (c-lineup-C-comments): Handle more cases, especially when comment lines aren't prefixed with stars. @@ -19883,7 +19883,7 @@ map them into inher-intro, inher-cont, and func-decl-cont syntactic symbols. Do the indentation as of Java inheritance lines better. - (c-offsets-alist): Changed the syntactic symbol ansi-funcdecl-cont + (c-offsets-alist): Change the syntactic symbol ansi-funcdecl-cont to func-decl-cont. This symbol is useful in Java throws declarations. (c-lineup-java-inher): New function for lining up "implements" @@ -19957,8 +19957,8 @@ * make-mode.el (makefile-dependency-regex): Disallow "=" in name, so that "flags=-o:1" is treated as an assignment, not a dependency. - (makefile-dependency-regex, makefile-macroassign-regex): Disallow - spaces in symbol name. + (makefile-dependency-regex, makefile-macroassign-regex): + Disallow spaces in symbol name. 1997-03-11 Dan Nicolaescu <done@ece.arizona.edu> @@ -19967,8 +19967,8 @@ 1997-03-12 Richard Stallman <rms@whiz-bang.gnu.ai.mit.edu> - * dired-aux.el (dired-fun-in-all-buffers): New arg FILE. Don't - operate on buffers whose wildcard pattern does not accept FILE. + * dired-aux.el (dired-fun-in-all-buffers): New arg FILE. + Don't operate on buffers whose wildcard pattern does not accept FILE. All callers changed. * dired.el (dired-glob-regexp): New function. @@ -20058,14 +20058,14 @@ (rmail-show-mime-function, rmail-mime-feature): New variables to control MIME feature. (rmail-file-coding-system): Default value is nil. - (rmail, rmail-convert-file, rmail-insert-inbox-text): Check - rmail-enable-mime. Read a file without any code conversion. + (rmail, rmail-convert-file, rmail-insert-inbox-text): + Check rmail-enable-mime. Read a file without any code conversion. (rmail-variables): Setup local variables rmail-buffer and rmail-view-buffer. - (rmail-decode-babyl-format, rmail-convert-babyl-format): Perform - code conversion of RMAIL file if rmail-enable-mime is nil. - (rmail-show-message): Make sure to be in rmail-buffer. If - rmail-enable-mime is t, call appropriate function to decode MIME + (rmail-decode-babyl-format, rmail-convert-babyl-format): + Perform code conversion of RMAIL file if rmail-enable-mime is nil. + (rmail-show-message): Make sure to be in rmail-buffer. + If rmail-enable-mime is t, call appropriate function to decode MIME format. (rmail-mail, rmail-reply): Call rmail-start-mail with argument rmail-view-buffer. @@ -20076,8 +20076,8 @@ rmail-summary-line-decoder. (rmail-summary-next-msg): Display rmail-view-buffer. (rmail-summary-mode): Make rmail-view-buffer buffer local. - (rmail-summary-rmail-update, rmail-summary-scroll-msg-up): Use - rmail-view-buffer instead of rmail-buffer. + (rmail-summary-rmail-update, rmail-summary-scroll-msg-up): + Use rmail-view-buffer instead of rmail-buffer. * mule-cmds.el (mule-keymap): Re-arranged. (set-language-info): Typo fixed in docstring. @@ -20188,8 +20188,8 @@ (turn-on-font-lock): Test font-lock-mode. Added commented out menu code. - * compile.el (compilation-mode-font-lock-keywords): Variable - definition deleted. New function. + * compile.el (compilation-mode-font-lock-keywords): + Variable definition deleted. New function. (compilation-mode-map): Add `...' to Compile menu entry. 1997-02-20 Yutaka NIIBE <gniibe@mri.co.jp> @@ -20239,8 +20239,8 @@ * help.el (help-with-tutorial): Prefix argument to specify a language interactively. - * isearch.el (isearch-mode-map): Define - isearch-toggle-input-method and + * isearch.el (isearch-mode-map): + Define isearch-toggle-input-method and isearch-toggle-specified-input-method in the map. (isearch-multibyte-characters-flag): New variable. (isearch-mode): Initialize it to nil. @@ -20272,8 +20272,8 @@ (sendmail-send-it): Perform code conversion on sending mail according to sendmail-coding-system. - * simple.el (kill-forward-chars, kill-backward-chars): Pay - attention to multibyte characters. + * simple.el (kill-forward-chars, kill-backward-chars): + Pay attention to multibyte characters. (what-cursor-position): With a prefix argument, print detailed info of a character on cursor position. (transpose-subr-1): Pay attention to multibyte characters. @@ -20369,8 +20369,8 @@ * diff.el (diff-process-setup): New function, sets up the compilation-exit-message-function so that it works with both asynchronous and synchronous sub-processes. - (diff): Bind compilation-exit-message-function. Run - compilation-finish-function when compile-internal returns if async + (diff): Bind compilation-exit-message-function. + Run compilation-finish-function when compile-internal returns if async processes aren't supported. 1997-02-08 Richard Stallman <rms@psilocin.gnu.ai.mit.edu> @@ -20432,7 +20432,7 @@ * iso-acc.el (iso-accents-compose): Handle case where unread-command-events is already nonempty. - * frame.el (set-frame-font): Renamed from set-default-font. + * frame.el (set-frame-font): Rename from set-default-font. 1997-02-01 Tom Tromey <tromey@cygnus.com> @@ -20484,7 +20484,7 @@ * compile.el (compilation-enter-directory-regexp) (compilation-leave-directory-regexp): Add .* at beginning. -1997-01-30 Barry A. Warsaw <cc-mode-help@python.org> +1997-01-30 Barry A. Warsaw <bwarsaw@cnri.reston.va.us> * cc-mode.el: Public Release 4.353. @@ -20504,7 +20504,7 @@ * cc-mode.el (c-Java-access-key): Set to nil since Java doesn't have C++-like access labels. - * cc-mode.el (c-style-alist): Added "python" style. + * cc-mode.el (c-style-alist): Add "python" style. * cc-mode.el (c-mode-menu): New function. (c-popup-menu, c-common-init): Use c-mode-menu. @@ -20525,9 +20525,9 @@ * cc-mode.el (c-emacs-features): Detect Infodock. (c-common-init, c-mode-map): Don't install menus for Infodock. - * cc-mode.el (c-indent-exp): Fixed infinite loop when multi-line C + * cc-mode.el (c-indent-exp): Fix infinite loop when multi-line C comment is last thing in buffer. - (c-guess-basic-offset): Fixed error when K&R C-like macro is first + (c-guess-basic-offset): Fix error when K&R C-like macro is first non-syntactic whitespace in file. * cc-mode.el (c-C++-comment-start-regexp): @@ -20705,7 +20705,7 @@ 1997-01-09 Simon Marshall <simon@wombat.gnu.ai.mit.edu> - * font-lock.el (font-lock-unique): Deleted. + * font-lock.el (font-lock-unique): Delete. (font-lock-prepend-text-property, font-lock-append-text-property): Don't call it; behave as to-be-written builtins. Declare as defuns. (font-lock-fillin-text-property): Declare as a defun. @@ -20731,7 +20731,7 @@ (expand-mode-hook, expand-mode-name): Variables deleted. (expand-load-hook): Variable renamed from expand-mode-load-hook. (expand-map): Variable deleted. - (expand-jump-to-next-slot): Renamed from expand-jump-to-next-mark. + (expand-jump-to-next-slot): Rename from expand-jump-to-next-mark. Add autoload. (expand-jump-to-previous-slot): Add autoload. Renamed from expand-jump-to-previous-mark. @@ -20803,11 +20803,11 @@ 1997-01-02 Jens Toivo Berger Thielemann <jensthi@ifi.uio.no> * word-help.el (word-help-mode-alist, reset-word-help) - (word-help-switch-help-file): Added support for completion. + (word-help-switch-help-file): Add support for completion. (word-help-complete, word-help-complete-list) (word-help-complete-index, word-help-extract-matches) (word-help-make-complete): New functions/variables for completion. - (word-help-mode-alist): Enhanced search regexps. + (word-help-mode-alist): Enhance search regexps. (word-help-index-mapper): Defaults now to extracting the first word. (word-help-mode-alist, word-help-index-mapper) (word-help-main-index, word-help-main-obarray) @@ -20850,8 +20850,8 @@ 1996-12-31 Richard Stallman <rms@ethanol.gnu.ai.mit.edu> - * simple.el (repeat-complex-command): Bind - minibuffer-history-position and minibuffer-history-sexp-flag + * simple.el (repeat-complex-command): + Bind minibuffer-history-position and minibuffer-history-sexp-flag only for the read-from-minibuffer call. 1996-12-30 Richard Stallman <rms@ethanol.gnu.ai.mit.edu> @@ -20929,7 +20929,7 @@ * expand.el: New file. - * skeleton.el (skeleton-positions): Renamed from skeleton-marks. + * skeleton.el (skeleton-positions): Rename from skeleton-marks. * skeleton.el (skeleton-marks): New variable. (skeleton-insert, skeleton-internal-1): Set skeleton-marks. @@ -20956,7 +20956,7 @@ (vip-convert-standard-file-name): New function. * ediff-util.el (ediff-file-under-version-control): New function. - (ediff-inferior-compare-regions): Improved interface. + (ediff-inferior-compare-regions): Improve interface. (ediff-maybe-checkout): New function. (ediff-maybe-save-and-delete-merge): New function. (ediff-setup): Now uses convert-standard-filename. @@ -20970,8 +20970,8 @@ subordinate Ediff sessions. * ediff-ptch.el (ediff-patch-file-internal): Now calls ediff-maybe-checkout. - (ediff-context-diff-label-regexp): Fixed regexp. - (ediff-map-patch-buffer): Fixed beg/end patch boundaries. + (ediff-context-diff-label-regexp): Fix regexp. + (ediff-map-patch-buffer): Fix beg/end patch boundaries. * ediff.el: Now supports autostore for merge jobs. 1996-12-27 Richard Stallman <rms@ethanol.gnu.ai.mit.edu> @@ -21018,15 +21018,15 @@ * vc-hooks.el (vc-user-login-name): New function. (vc-fetch-master-properties, vc-lock-from-permissions, vc-file-owner) - (vc-fetch-properties, vc-after-save, vc-mode-line, vc-status): Use - `vc-user-login-name' instead of `user-login-name'. + (vc-fetch-properties, vc-after-save, vc-mode-line, vc-status): + Use `vc-user-login-name' instead of `user-login-name'. * vc.el (vc-next-action-on-file, vc-update-change-log) (vc-backend-checkout, vc-backend-steal): Use `vc-user-login-name' instead of `user-login-name'. (vc-update-change-log): If `user-full-name' is nil, try `user-login-name'. Failing that, use uid as a string. - (vc-make-buffer-writable-hook): Removed (was unused). + (vc-make-buffer-writable-hook): Remove (was unused). 1996-12-20 Richard Stallman <rms@ethanol.gnu.ai.mit.edu> @@ -21294,7 +21294,7 @@ * thingatpt.el: Downcase arguments as Lisp symbols. Fix many doc strings. - (thing-at-point-file-name-chars): Renamed from file-name-chars. + (thing-at-point-file-name-chars): Rename from file-name-chars. Allow a colon. (thing-at-point-url-chars): New variable. (url): Define new kind of "thing". @@ -21309,7 +21309,7 @@ Two new arguments. (rmail-forward): Always call rmail-start-mail, never `mail'. - * sendmail.el (mail-reply-action): Renamed from mail-reply-buffer. + * sendmail.el (mail-reply-action): Rename from mail-reply-buffer. (mail-yank-original): Handle either an action or a buffer in mail-reply-action. (mail): Doc fix. @@ -21413,8 +21413,8 @@ (font-lock-face-attributes): Doc fix. (font-lock-match-c-style-declaration-item-and-skip-to-next): New function. Match just identifiers. Use it for C, Objective-C and Java. - (font-lock-match-c++-style-declaration-item-and-skip-to-next): Match - templates too. + (font-lock-match-c++-style-declaration-item-and-skip-to-next): + Match templates too. (c-font-lock-extra-types, c++-font-lock-extra-types) (objc-font-lock-extra-types, java-font-lock-extra-types): Use these variables in EVAL forms, i.e., do not eval when font-lock.el is loaded. @@ -21432,7 +21432,7 @@ (fast-lock-get-face-properties): Rewrite for face lists. Use it. * lazy-lock.el (lazy-lock-submit-bug-report): Function deleted. - (lazy-lock-defer-on-scrolling): Renamed from lazy-lock-defer-driven. + (lazy-lock-defer-on-scrolling): Rename from lazy-lock-defer-driven. (lazy-lock-defer-on-the-fly): New variable from lazy-lock-defer-time. (lazy-lock-install): Use it. (lazy-lock-defer-time): Doc fix. Add top-level code to detect use of @@ -21441,15 +21441,15 @@ (lazy-lock-stealth-load): New variable. (lazy-lock-fontify-after-idle): Use it. (lazy-lock-mode): Doc fix. - (lazy-lock-defer-line-after-change): Renamed from + (lazy-lock-defer-line-after-change): Rename from lazy-lock-defer-after-change. (lazy-lock-defer-rest-after-change) (lazy-lock-fontify-line-after-change) (lazy-lock-fontify-rest-after-change): New functions. (lazy-lock-install-hooks): Add one depending on deferral variables. (lazy-lock-unstall): Remove them. Fontify if Font Lock mode still on. - (lazy-lock-fontify-window, lazy-lock-fontify-conservatively): Use - with-current-buffer rather than save-excursion. + (lazy-lock-fontify-window, lazy-lock-fontify-conservatively): + Use with-current-buffer rather than save-excursion. (lazy-lock-percent-fontified): Cast size to float before multiplying. 1996-11-14 Karl Heuer <kwzh@gnu.ai.mit.edu> @@ -21553,7 +21553,7 @@ * comint.el (comint-output-filter): Run comint-output-filter-functions directly, not via comint-output-filter. - * compile.el (compile-auto-highlight): Renamed from + * compile.el (compile-auto-highlight): Rename from compile-highlight-display-limit. * time-stamp.el (time-stamp-dd/mm/yyyy): New function. @@ -21589,7 +21589,7 @@ 1996-11-02 Henry Guillaume <henry@qbd.com.au> * find-file.el (general): Enabled commentary for Finder. - (ff-search-directories): Changed /usr/include/* to /usr/include. + (ff-search-directories): Change /usr/include/* to /usr/include. (ff-get-file-name): Improve behavior when file is found in a buffer. 1996-11-02 Richard Stallman <rms@ethanol.gnu.ai.mit.edu> @@ -21679,7 +21679,7 @@ 1996-10-24 Dave Gillespie <daveg@synaptics.com> - * cl-macs.el (lexical-let): Fixed a bug involving nested + * cl-macs.el (lexical-let): Fix a bug involving nested lexical contexts and macros. 1996-10-23 Simon Marshall <simon@wombat.gnu.ai.mit.edu> @@ -21740,7 +21740,7 @@ 1996-10-20 Kevin Rodgers <kevinr@ihs.com> - * compile.el (compilation-skip-to-next-location): Defined. + * compile.el (compilation-skip-to-next-location): Define. (compilation-next-error-locus, compilation-parse-errors): Respect it. 1996-10-17 Andre Spiegel <spiegel@berlin.informatik.uni-stuttgart.de> @@ -21767,19 +21767,19 @@ 1996-10-14 Torbjorn Einarsson <T.Einarsson@clab.ericsson.se> - * f90.el (f90-no-block-limit): Fixed bug for indentation of + * f90.el (f90-no-block-limit): Fix bug for indentation of elsewhere and elseif. (f90-looking-at-where-or-forall): Now allows for labeled forall and where statements. (f90-font-lock-keywords-2): New highlighting for labeled where and forall. Fixed small bug with else highlighting. - (f90-fill-region): Moved indentation to f90-break-line. + (f90-fill-region): Move indentation to f90-break-line. (f90-break-line): Will now always indent the second line. (f90-indent-line): Simpler test for auto-fill. - (f90-auto-fill-mode): Removed. - (f90-electric-insert): Added for possibility of auto-filling of + (f90-auto-fill-mode): Remove. + (f90-electric-insert): Add for possibility of auto-filling of lines without spaces, as well as early updating of line. - (f90-mode-map): Added bindings of operators to f90-electric-insert. + (f90-mode-map): Add bindings of operators to f90-electric-insert. (f90-do-auto-fill): Now also updates line (changes case). 1996-10-12 Richard Stallman <rms@ethanol.gnu.ai.mit.edu> @@ -21865,21 +21865,21 @@ * browse-url.el (browse-url): New function. (browse-url-CCI-host): New variable. - (browse-url-at-mouse): Added event-buffer and event-point + (browse-url-at-mouse): Add event-buffer and event-point functions for XEmacs compatibility. (browse-url-file-url): Check for EFS after alist, URL-encode special chars. (browse-url-grail): New function. (browse-url-interactive-arg): Add new-window logic. - (browse-url-looking-at): Fixed. + (browse-url-looking-at): Fix. (browse-url-lynx-xterm): New function. (browse-url-lynx-emacs): Use term.el instead of terminal.el. (browse-url-netscape): Contact/start Netscape in the - background. Multi-display support. Renamed - browse-url-netscape-send. URL-encode comma. + background. Multi-display support. + Renamed browse-url-netscape-send. URL-encode comma. (browse-url-netscape-command): New variable. (browse-url-netscape-startup-arguments): New variable. - (browse-url-url-at-point): Improved matching to supply missing + (browse-url-url-at-point): Improve matching to supply missing "http://". Other fixes for byte-compilation. @@ -21903,7 +21903,7 @@ * rmail.el (rmail-mode-2): Don't run rmail-mode-hook here. (rmail-mode, rmail): Run it here. -1996-10-08 Barry A. Warsaw <cc-mode-help@python.org> +1996-10-08 Barry A. Warsaw <bwarsaw@cnri.reston.va.us> * cc-mode.el (c-mode-map): Install FSF mode menu into menubar using the name @@ -21912,7 +21912,7 @@ additional FSF menu. * cc-mode.el: - Removed the following variables from the built-in "cc-mode" style: + Remove the following variables from the built-in "cc-mode" style: c-echo-syntactic-information-p c-string-syntax-p c-tab-always-indent @@ -21921,7 +21921,7 @@ * cc-mode.el (c-indent-command): Doc fix. - * cc-mode.el (c-style-alist): Added "linux" style. + * cc-mode.el (c-style-alist): Add "linux" style. * cc-mode.el (c-lineup-comment): Preserve comment-column. @@ -21975,10 +21975,10 @@ functions inside a nested class since they will twice add the indentation of the inner class to the running total. - The solution is to not give one of the two symbols a relpos. The - decision was made to omit the relpos of the 'inline-open symbol. + The solution is to not give one of the two symbols a relpos. + The decision was made to omit the relpos of the 'inline-open symbol. - (c-mode-help-address): Added cc-mode-help@python.org. + (c-mode-help-address): Add cc-mode-help@python.org. (c-recognize-knr-p): No longer a user variable. (c++-mode, java-mode): Set c-recognize-knr-p to nil. @@ -22058,7 +22058,7 @@ (sgml-font-lock-keywords): Add an element for comments. * rmailsum.el (rmail-summary-line-count-flag): - Renamed from rmail-summary-line-count-p. + Rename from rmail-summary-line-count-p. * rmailsum.el (rmail-summary-line-count-p): New variable. (rmail-make-basic-summary-line): Optionally exclude the line count. @@ -22128,8 +22128,8 @@ (ps-print-prologue-1, ps-print-prologue-2): New variables. Major rewrite of the PostScript code to handle landscape mode, multiple columns and new font management. - (ps-landscape-mode, ps-number-of-columns, ps-inter-column): New - variables. + (ps-landscape-mode, ps-number-of-columns, ps-inter-column): + New variables. Add landscape mode and multiple columns with interspacing. (ps-font-info-database, ps-font-family, ps-font-size) (ps-header-font-family, ps-header-font-size, ps-header-title-font) @@ -22142,10 +22142,10 @@ (/ReportAllFontInfo): New PostScript function to get all the font families of the printer. (ps-setup): New function. - (ps-line-lengths, ps-nb-pages-buffer, ps-nb-pages-region): New - utility functions. - (ps-page-dimensions-get-width, ps-page-dimensions-get-height): New - macros. + (ps-line-lengths, ps-nb-pages-buffer, ps-nb-pages-region): + New utility functions. + (ps-page-dimensions-get-width, ps-page-dimensions-get-height): + New macros. (/HeaderOffset): Fix bug with /PrintStartY. (/SetHeaderLines): Fix bug. @@ -22236,7 +22236,7 @@ * tex-mode.el (tex-main-file): Add missing initial value. (tex-file): Set tex-print-file to source-file always. - (tex-last-file-texed): Renamed from tex-last-buffer-texed + (tex-last-file-texed): Rename from tex-last-buffer-texed and now holds a file name. (tex-region): Test and set tex-last-file-texed. @@ -22286,15 +22286,15 @@ * ffap.el (path-separator): Duplicate definition deleted. (ffap-what-domain): Don't define mail-extr-all-top-level-domains here. - * refbib.el (r2b-capitalize-title-stop-words): Renamed from capit... - (r2b-capitalize-title-stop-regexp): Renamed from capit... - (r2b-capitalize-title-region): Renamed from capitalize... - (r2b-capitalize-title): Renamed from capitalize... + * refbib.el (r2b-capitalize-title-stop-words): Rename from capit... + (r2b-capitalize-title-stop-regexp): Rename from capit... + (r2b-capitalize-title-region): Rename from capitalize... + (r2b-capitalize-title): Rename from capitalize... - * bib-mode.el (bib-capitalize-title-stop-words): Renamed from capit... - (bib-capitalize-title-stop-regexp): Renamed from capit... - (bib-capitalize-title-region): Renamed from capitalize... - (bib-capitalize-title): Renamed from capitalize... + * bib-mode.el (bib-capitalize-title-stop-words): Rename from capit... + (bib-capitalize-title-stop-regexp): Rename from capit... + (bib-capitalize-title-region): Rename from capitalize... + (bib-capitalize-title): Rename from capitalize... * edmacro.el (insert-kbd-macro): Duplicate definition deleted. @@ -22353,18 +22353,18 @@ New variables. (ediff-convert-standard-file-name): New function. Added on-line help, moved some functions to and from ediff-util.el. - (ediff-file-remote-p): Modified. + (ediff-file-remote-p): Modify. (ediff-set-face-pixmap): New function. (ediff-odd-diff-pixmap, ediff-even-diff-pixmap, ediff-fine-diff-pixmap): New variables. - * ediff-ptch.el (ediff-context-diff-label-regexp): Fixed regexp. - (ediff-map-patch-buffer): Fixed beg/end patch boundaries. + * ediff-ptch.el (ediff-context-diff-label-regexp): Fix regexp. + (ediff-map-patch-buffer): Fix beg/end patch boundaries. Now checks for the return code from the patch program. Fixed ediff-patch-options, ediff-backup-extension, ediff-backup-specs. * ediff-merg.el, ediff-diff.el, ediff-init.el: * ediff-hook.el: Changed ediff-meta to ediff-mult. * ediff-ptch.el (ediff-backup-specs): New variable. - * ediff.el (ediff-documentation): Modified. + * ediff.el (ediff-documentation): Modify. * ediff-help.el: New file. * ediff-mult.el (ediff-intersect-directories) (ediff-meta-insert-file-info): Functions modified. @@ -22411,7 +22411,7 @@ * vc.el (vc-print-log): Set the display window so that it shows the current log entry completely. - * vc-hooks.el (vc-find-cvs-master): Fixed handling of "locally + * vc-hooks.el (vc-find-cvs-master): Fix handling of "locally added" files. 1996-09-16 Erik Naggum <erik@naggum.no> @@ -22488,15 +22488,15 @@ * bindings.el: New file, split out from loaddefs.el. * loadup.el: Load bindings.el. - * gud.el (gud-find-c-expr): Renamed from find-c-expr. + * gud.el (gud-find-c-expr): Rename from find-c-expr. Don't get fooled by if and while statements. - (gud-expr-compound): Renamed from expr-compound. - (gud-expr-compound-sep): Renamed from expr-compound-sep. - (gud-next-expr): Renamed from expr-next. - (gud-prev-expr): Renamed from expr-prev. - (gud-forward-sexp): Renamed from expr-forward-sexp. - (gud-backward-sexp): Renamed from expr-backward-sexp. - (gud-innermost-expr): Renamed from expr-cur. + (gud-expr-compound): Rename from expr-compound. + (gud-expr-compound-sep): Rename from expr-compound-sep. + (gud-next-expr): Rename from expr-next. + (gud-prev-expr): Rename from expr-prev. + (gud-forward-sexp): Rename from expr-forward-sexp. + (gud-backward-sexp): Rename from expr-backward-sexp. + (gud-innermost-expr): Rename from expr-cur. 1996-09-10 Per Abrahamsen <abraham@dina.kvl.dk> @@ -22546,8 +22546,8 @@ 1996-09-05 Michael Kifer <kifer@cs.sunysb.edu> * viper-keym.el, viper.el (vip-scroll): - Changed to vip-scroll-screen, other modifications. - (vip-alternate-ESC): Changed to vip-alternate-Meta-key. + Change to vip-scroll-screen, other modifications. + (vip-alternate-ESC): Change to vip-alternate-Meta-key. * viper.el (vip-escape-to-vi, vip-prefix-arg-value) (vip-prefix-arg-value): Now work with prefix arguments and also will work with 2dw and d2d style commands. @@ -22556,7 +22556,7 @@ (vip-paren-match): Go to closing paren first. (vip-find-char-forward, vip-find-char-backward, vip-goto-char-forward) (vip-goto-char-backward): Functions modified. - (vip-set-hooks): Added viper to fortran-mode. + (vip-set-hooks): Add viper to fortran-mode. (viper-mode): Don't delete the startup message. * viper-keym.el: C-\ is now the meta key. C-z in insert mode now escapes to Vi. @@ -22565,9 +22565,9 @@ * viper-util.el, viper.el: Added pixmaps to replace-region and search faces. (vip-get-filenames-from-buffer): The argument is now optional. - (vip-ex-nontrivial-find-file-unix): Added the -d option to ls command. + (vip-ex-nontrivial-find-file-unix): Add the -d option to ls command. (vip-read-key): Inhibit quit added. - (vip-get-cursor-color): Fixed to work with XEmacs. + (vip-get-cursor-color): Fix to work with XEmacs. * viper-ex.el (ex-edit): Don't change to vi in dired mode. 1996-09-04 Richard Stallman <rms@ethanol.gnu.ai.mit.edu> @@ -22706,7 +22706,7 @@ (grep-regexp-alist, file-name-buffer-file-type-alist) (find-buffer-file-type, find-file-not-found-set-buffer-file-type) (find-file-binary, find-file-text, mode-line-format): - Moved to dos-nt.el. + Move to dos-nt.el. * winnt.el (save-to-unix-hook, revert-from-unix-hook) (using-unix-filesystems): Functions removed. diff --git a/lisp/ChangeLog.8 b/lisp/ChangeLog.8 index 6ceaf8491aa..df0188d8c76 100644 --- a/lisp/ChangeLog.8 +++ b/lisp/ChangeLog.8 @@ -3,13 +3,13 @@ * echistory.el (electric-command-history): Call Command-history-setup and command-history-mode using their new conventions. - * chistory.el (Command-history-setup): Don't switch buffers. Take - no args, and do not set major-mode, mode-name or the local map. + * chistory.el (Command-history-setup): Don't switch buffers. + Take no args, and do not set major-mode, mode-name or the local map. (command-history-mode): New function, does some of those things Command-history-setup used to do. (list-command-history): Call command-history-mode, not Command-history-setup. - (command-history): Renamed from command-history-mode. + (command-history): Rename from command-history-mode. 1999-12-31 Richard M. Stallman <rms@gnu.org> @@ -91,9 +91,9 @@ 1999-12-27 Jari Aalto <jari.aalto@poboxes.com> - * add-log.el (change-log-version-number-regexp-list): Added tag + * add-log.el (change-log-version-number-regexp-list): Add tag :version 20.6. - (change-log-version-info-enabled): Added tag :version 20.6. + (change-log-version-info-enabled): Add tag :version 20.6. 1999-12-27 Jari Aalto <jari.aalto@poboxes.com> @@ -103,13 +103,13 @@ (change-log-find-version): Rewritten. Use user-configurable version numbering regexp list change-log-version-number-regexp-list. - (change-log-find-version): Renamed to + (change-log-find-version): Rename to change-log-version-number-search. (add-log-file-name-function): New. - (change-log-search-vc-number): Added END parameter. Added doc + (change-log-search-vc-number): Add END parameter. Added doc string to function. - (change-log-version-rcs): Renamed. Was - change-log-search-vc-number. + (change-log-version-rcs): Rename. + Was change-log-search-vc-number. 1999-12-26 Thien-Thi Nguyen <ttn@delysid.gnu.org> @@ -144,7 +144,7 @@ (hs-hide-block, hs-show-block, hs-show-region, hs-hide-level) (hs-mouse-toggle-hiding, hs-minor-mode): Rewrite. - (hs-isearch-show): Renamed from `hs-isearch-open-invisible'. + (hs-isearch-show): Rename from `hs-isearch-open-invisible'. (hs-isearch-show-temporary): New funcs. (hs-show-block-at-point, java-hs-forward-sexp): Delete funcs. @@ -214,9 +214,9 @@ * progmodes/antlr-mode.el: Minor syntax highlighting changes. (antlr-font-lock-default-face): Deletia. - (antlr-font-lock-tokendef-face): Changed color. - (antlr-font-lock-tokenref-face): Changed color. - (antlr-font-lock-literal-face): Changed color. + (antlr-font-lock-tokendef-face): Change color. + (antlr-font-lock-tokenref-face): Change color. + (antlr-font-lock-literal-face): Change color. (antlr-font-lock-additional-keywords): Minor changes. 1999-12-20 Carsten Dominik <cd@gnu.org> @@ -351,7 +351,7 @@ (reftex-index-phrases-sort-prefers-entry) (reftex-index-phrases-sort-in-blocks): New options. (reftex-index-macros): Option structure changed. - (reftex-index-macros-builtin): Added `repeat' item to each entry. + (reftex-index-macros-builtin): Add `repeat' item to each entry. (reftex-label-alist): Additional item in each entry to specify if the environment should be listed in the TOC. (eval-when-compile (require 'cl)) added. @@ -415,8 +415,8 @@ Additional argument FORMAT-KEY to preselect a citation format; (eval-when-compile (require 'cl)) added. - * textmodes/reftex-parse.el (reftex-context-substring): Optional - parameter to-end. + * textmodes/reftex-parse.el (reftex-context-substring): + Optional parameter to-end. (reftex-section-info): Deal with environment matches; (eval-when-compile (require 'cl)) added. @@ -440,12 +440,12 @@ (ps-mule-plot-composition): New function. (ps-mule-prepare-font-for-components): New function. (ps-mule-plot-components): New function. - (ps-mule-composition-prologue-generated): Renamed from + (ps-mule-composition-prologue-generated): Rename from ps-mule-cmpchar-prologue-generated. (ps-mule-composition-prologue): New named from ps-mule-cmpchar-prologue. Modified for new composition. (ps-mule-plot-rule-cmpchar, ps-mule-plot-cmpchar) - (ps-mule-prepare-cmpchar-font): Deleted. + (ps-mule-prepare-cmpchar-font): Delete. (ps-mule-string-encoding): New arg NO-SETFONT. (ps-mule-bitmap-prologue): In PostScript code of BuildGlyphCommon, check Composing, not Cmpchar. @@ -463,8 +463,8 @@ * international/fontset.el (vertical-centering-font-regexp): New variable. - * international/mule.el (mule-version): Updated to 5.0 (AOI). - (mule-version-date): Updated to 1999.12.7. + * international/mule.el (mule-version): Update to 5.0 (AOI). + (mule-version-date): Update to 1999.12.7. (with-category-table): New macro. * international/mule-cmds.el (encode-coding-char): Don't check @@ -477,9 +477,9 @@ * international/mule-util.el (set-nested-alist): Set BRANCHES (if non-nil) at the tail of ALIST. (compose-region, decompose-region, decompose-string) - (reference-point-alist, compose-chars): Moved to composite.el. + (reference-point-alist, compose-chars): Move to composite.el. (compose-chars-component, compose-chars-rule, decompose-composite-char): - Deleted. + Delete. * international/quail.el (quail-install-map): New optional arg NAME. (quail-get-translation): If DEF is a symbol but not a function, @@ -513,16 +513,16 @@ * language/thai-util.el (thai-category-table): Make it by make-category-table. (thai-composition-pattern): New variable. - (thai-compose-region, thai-compose-string): Use - with-category-table. + (thai-compose-region, thai-compose-string): + Use with-category-table. (thai-post-read-conversion): Just call thai-compose-region. - (thai-pre-write-conversion): Deleted. + (thai-pre-write-conversion): Delete. (thai-composition-function): New function. * language/tibet-util.el: Most functions rewritten. - (tibetan-char-p): Renamed from tibetan-char-examin. + (tibetan-char-p): Rename from tibetan-char-examin. (tibetan-composable-examin, tibetan-complete-char-examin) - (tibetan-vertical-stacking, tibetan-composition): Deleted. + (tibetan-vertical-stacking, tibetan-composition): Delete. (tibetan-add-components): New function. (tibetan-composition-function): New function. @@ -543,8 +543,8 @@ 1999-12-14 Gerd Moellmann <gerd@gnu.org> - * international/mule-cmds.el (default-input-method): Specify - that it should be set after current-language-environment. + * international/mule-cmds.el (default-input-method): + Specify that it should be set after current-language-environment. * custom.el (custom-handle-keyword): Add :set-after. (custom-add-dependencies): New function. @@ -556,11 +556,11 @@ * progmodes/cc-make.el: Removed. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> * Release of cc-mode 5.26 -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> * cc-cmds.el (c-forward-conditional): Handle an arbitrary target depth. Optionally count #else lines as clause limits, @@ -571,35 +571,35 @@ (c-down-conditional-with-else): New commands that uses the added functionality in `c-forward-conditional'. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> * cc-align.el (c-lineup-comment): Preserve the alignment with a comment on the previous line instead of preserving the comment-column. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> Fixes to IDL mode after input from Eric Eide <eeide@cs.utah.edu>: - * cc-engine.el (c-beginning-of-statement-1): Allow - `c-conditional-key' to be nil, for the benefit of IDL mode. + * cc-engine.el (c-beginning-of-statement-1): + Allow `c-conditional-key' to be nil, for the benefit of IDL mode. * cc-engine.el (c-guess-basic-syntax): Ditto. - cc-langs.el (C-IDL-class-key): Fixed. Don't match `class' + cc-langs.el (C-IDL-class-key): Fix. Don't match `class' but do match CORBA 2.3 `valuetype'. * cc-langs.el (c-IDL-access-key): New defconst. Should be nil for IDL. - * cc-langs.el (c-IDL-conditional-key): New defconst. Should - be nil for IDL. + * cc-langs.el (c-IDL-conditional-key): New defconst. + Should be nil for IDL. * cc-langs.el (c-IDL-comment-start-regexp): New defconst. Like C++. * cc-mode.el (idl-mode): Use new `c-IDL-*' defconsts. Also, set `c-method-key' and `c-baseclass-key' to nil. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> * cc-menus.el (cc-imenu-c++-generic-expression): Match classes with nonhanging open braces. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> * cc-align.el: Added docstrings to all lineup functions. @@ -610,12 +610,12 @@ comments. Use c-comment-prefix-regexp and comment-start-skip instead of hardcoded regexps. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> - * cc-cmds.el (c-beginning-of-defun, c-end-of-defun): Fixed eob + * cc-cmds.el (c-beginning-of-defun, c-end-of-defun): Fix eob behavior and return value as documented. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> Changes for new style variable init system: * cc-langs.el (c-common-init): Dito. @@ -639,12 +639,12 @@ the throws clause that might follow the function prototype in C++. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> - * cc-defs.el (c-beginning-of-macro): Fixed bug where point + * cc-defs.el (c-beginning-of-macro): Fix bug where point could move forward for macros that doesn't start in column 0. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> * cc-align.el (c-indent-multi-line-block) (c-lineup-whitesmith-in-block): Two new lineup functions for @@ -654,7 +654,7 @@ style. It should now handle all different braces uniformly in both hanging and non-hanging cases. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> * cc-cmds.el (c-indent-exp): Use a marker to save point to make it stay in the same position relative to the surrounding @@ -676,7 +676,7 @@ <seanl@cs.umd.edu>. Also extended the bsd and whitesmith styles with consistent brace placement for all constructs. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> * cc-cmds.el (c-context-line-break): Continue C++ comments too when point is in the middle of them. @@ -702,8 +702,8 @@ `normal-auto-fill-function' to implement the `c-ignore-auto-fill' variable. - * cc-cmds.el (c-beginning-of-statement): Use - `c-comment-prefix-regexp' to avoid ending up inside the + * cc-cmds.el (c-beginning-of-statement): + Use `c-comment-prefix-regexp' to avoid ending up inside the comment prefix. Better handling of comment starters and enders. Catch comments better when traversing code. Stop at preprocessor directives. @@ -711,7 +711,7 @@ * cc-defs.el (c-forward-comment): New subst to hide platform dependent quirks in `forward-comment'. - * cc-engine.el (c-literal-limits): Added NOT-IN-DELIMITER + * cc-engine.el (c-literal-limits): Add NOT-IN-DELIMITER argument. (c-literal-limits-fast): Implemented NEAR and NOT-IN-DELIMITER arguments. Activate this function by default when @@ -722,16 +722,16 @@ arguments. * cc-align.el (c-lineup-C-comments): Fixes to handle the - changed anchor position in the `c' syntactic symbol. Handle - more than stars in the comment prefix; use the new variable + changed anchor position in the `c' syntactic symbol. + Handle more than stars in the comment prefix; use the new variable `c-comment-prefix-regexp'. Don't indent text not preceded by a comment prefix to the right of the comment opener if it's long. * cc-langs.el: Fixes to mode initialization for new line breaking and paragraph filling method. Adaptive fill mode is - now activated at startup instead of deactivated. The - variables used for adaptive filling and paragraph movement are + now activated at startup instead of deactivated. + The variables used for adaptive filling and paragraph movement are also changed to incorporate the value of `c-comment-prefix-regexp'. `substitute-key-definition' is used to override some functions in the global map instead of @@ -741,31 +741,31 @@ javadoc markup at mode init. * cc-mode.el (c-setup-filladapt): A new convenience function - to configure Kyle E. Jones' Filladapt mode for CC Mode. This - function is intended to be used explicitly by the end user + to configure Kyle E. Jones' Filladapt mode for CC Mode. + This function is intended to be used explicitly by the end user only. * cc-vars.el (c-comment-prefix-regexp): New variable used to recognize the comment fill prefix inside comments. (c-block-comment-prefix): New name for - `c-comment-continuation-stars', which is now obsolete. It's - generalized to handle any character sequence. + `c-comment-continuation-stars', which is now obsolete. + It's generalized to handle any character sequence. (c-ignore-auto-fill): New variable used to selectively disable Auto Fill mode in specific contexts. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> * cc-cmds.el (c-comment-indent): Leave at least one space between the comment and the last nonblank character in the case where we look at the indentation of the comment on the previous line (case 4). - * cc-engine.el (c-beginning-of-statement-1): Added ``' to the + * cc-engine.el (c-beginning-of-statement-1): Add ``' to the list of characters that may start a statement (it's a sort of prefix operator in Pike, and isn't used at all in any of the other languages). -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> * cc-engine.el (c-guess-basic-syntax): Report brace list opens inside continued statements as statement-cont instead of @@ -775,12 +775,12 @@ context. Case 10B.2 changed. Also changed (the somewhat esoteric) case 9A to cope with this. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> - * cc-cmds.el (c-electric-brace): Added electric handling of + * cc-cmds.el (c-electric-brace): Add electric handling of the open brace for brace-elseif-brace. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> * cc-defs.el (c-with-syntax-table): New macro to easily switch syntax tables temporarily. @@ -789,26 +789,26 @@ member init argument lists split over several lines. Case 5D changed. - * cc-langs.el (c-Java-javadoc-paragraph-start): Added new tag + * cc-langs.el (c-Java-javadoc-paragraph-start): Add new tag @throws introduced in Javadoc 1.2. - * cc-menus.el (cc-imenu-java-generic-expression): Applied - patch from RMS to avoid infinite backtracking. + * cc-menus.el (cc-imenu-java-generic-expression): + Applied patch from RMS to avoid infinite backtracking. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> * cc-align.el (c-lineup-arglist): Handle "arglists" surrounded by [ ]. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> * cc-align.el (c-lineup-dont-change): Compensate properly for the column in langelem. - * cc-engine.el (c-syntactic-information-on-region): New - function to help debugging the syntactic analysis. + * cc-engine.el (c-syntactic-information-on-region): + New function to help debugging the syntactic analysis. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> * cc-align.el (c-lineup-template-args): Handle nested template arglists. @@ -824,18 +824,18 @@ * cc-styles.el (c-offsets-alist): Use `c-lineup-template-args' by default. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> * cc-engine.el (c-guess-basic-syntax): Pike allows a comma immediately before the closing paren in an arglist, so don't check that in Pike mode. Case 7A changed. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> - * cc-cmds.el (c-indent-region): Fixed bug where comment-only + * cc-cmds.el (c-indent-region): Fix bug where comment-only lines were ignored under certain conditions. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> * cc-align.el (c-lineup-template-args): New function for aligning continued template argument lists. @@ -844,68 +844,68 @@ lists containing function arglists split over several lines. Case 5D.1 changed. - * cc-engine.el (c-guess-basic-syntax): Fixed bug where + * cc-engine.el (c-guess-basic-syntax): Fix bug where template-args-cont didn't get recognized when the first - arglist opener line doesn't contain a template argument. New - case 5K. + arglist opener line doesn't contain a template argument. + New case 5K. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> - * cc-defs.el (c-point): Changed from subst to macro for + * cc-defs.el (c-point): Change from subst to macro for efficiency. - (c-beginning-of-defun-1, c-end-of-defun-1): New - beginning-of-defun/end-of-defun wrappers separated from + (c-beginning-of-defun-1, c-end-of-defun-1): + New beginning-of-defun/end-of-defun wrappers separated from c-point. * cc-menus.el (imenu-generic-expression) - (imenu-case-fold-search, imenu-progress-message): Dummy - definitions to avoid compiler warnings if imenu can't be + (imenu-case-fold-search, imenu-progress-message): + Dummy definitions to avoid compiler warnings if imenu can't be loaded. * cc-menus.el (cc-imenu-init): New function called at mode init. - * cc-mode.el (c-mode, c++-mode, objc-mode, java-mode): Moved - imenu initializations to cc-imenu-init. + * cc-mode.el (c-mode, c++-mode, objc-mode, java-mode): + Move imenu initializations to cc-imenu-init. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> * cc-engine.el (c-guess-basic-syntax): Slightly better check for lambda-intro-cont in Pike mode. Case 6 changed. - * cc-engine.el (c-looking-at-inexpr-block): Fixed bug where + * cc-engine.el (c-looking-at-inexpr-block): Fix bug where anything following "new Foo()" was considered an anonymous class body in Java mode. -1999-12-12 Barry A. Warsaw <bug-cc-mode@gnu.org> +1999-12-12 Barry A. Warsaw <bwarsaw@cnri.reston.va.us> * cc-cmds.el (c-comment-line-break-function): When breaking in a string, don't insert a new line. -1999-12-12 Barry A. Warsaw <bug-cc-mode@gnu.org> +1999-12-12 Barry A. Warsaw <bwarsaw@cnri.reston.va.us> * cc-engine.el (c-at-toplevel-p): New interface function which returns information useful to add-on authors. It tells you whether you're at a toplevel statement or not. -1999-12-12 Barry A. Warsaw <bug-cc-mode@gnu.org> +1999-12-12 Barry A. Warsaw <bwarsaw@cnri.reston.va.us> * cc-cmds.el (c-comment-line-break-function): It is possible that forward-line does not land us at the bol, say if we're on the last line in a file. In that case, do a back-to-indentation instead of a forward-comment -1. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> * cc-engine.el (c-beginning-of-statement-1): Don't catch "default:" as normal label in case 4. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> * cc-engine.el (c-guess-basic-syntax): Use c-bitfield-key to recognize continued bitfield declarations. Case 5D.1 changed. * cc-langs.el: New variable c-bitfield-key. * cc-mode.el: New variable c-bitfield-key. -1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org> +1999-12-12 Martin Stjernholm <mast@lysator.liu.se> * cc-engine.el (c-inside-bracelist-p): Tighter test for Java anonymous array expressions (i.e. "new Foo[] {.. bracelist @@ -917,8 +917,8 @@ keymap and minor-mode-alist stuff. Don't set zmacs-region-stays. (footnote-insert-text-marker, Footnote-insert-pointer-marker): Avoid `acons'. - (footnote-mode-line-string, Footnote-add-footnote): Remove - autoload cookie. + (footnote-mode-line-string, Footnote-add-footnote): + Remove autoload cookie. 1999-12-12 Richard Sharman <rsharman@pobox.com> @@ -967,8 +967,8 @@ * files.el (after-find-file): Use auto-save-visited-file-name if set. - * mail/feedmail.el (feedmail-find-eoh): Take - feedmail-queue-alternative-mail-header-separator into account. + * mail/feedmail.el (feedmail-find-eoh): + Take feedmail-queue-alternative-mail-header-separator into account. 1999-12-09 Stefan Monnier <monnier@cs.yale.edu> @@ -976,7 +976,7 @@ * font-lock.el (font-lock-multiline): New variable. (font-lock-add-keywords): Rename `major-mode' into `mode'. - (font-lock-remove-keywords): Added a dummy `mode' argument for + (font-lock-remove-keywords): Add a dummy `mode' argument for potential future support. (font-lock-fontify-anchored-keywords) (font-lock-fontify-keywords-region): Only handle multiline strings @@ -1059,8 +1059,8 @@ (x-defined-colors, face-color-supported-p, face-color-gray-p): Remove. - * facemenu.el (facemenu-read-color, list-colors-display): Use - defined-colors for all frame types. + * facemenu.el (facemenu-read-color, list-colors-display): + Use defined-colors for all frame types. (facemenu-color-equal): Use color-values for all frame types. * faces.el (read-face-attribute): For :foreground and :background @@ -1078,7 +1078,7 @@ types other than x and w32, but only if the terminal supports colors. Call tty-color-define instead of face-register-tty-color. - * term/x-win.el (xw-defined-colors): Renamed from + * term/x-win.el (xw-defined-colors): Rename from x-defined-colors. * term/w32-win.el (xw-defined-colors): Likewise. @@ -1091,7 +1091,7 @@ 1999-12-06 Inge Frick <inge@nada.kth.se> - * dired-aux.el (dired-do-shell-command): Changed documentation. + * dired-aux.el (dired-do-shell-command): Change documentation. (dired-shell-stuff-it): A `?' in COMMAND has now the same meaning as `*'. @@ -1103,11 +1103,11 @@ 1999-12-06 Sam Steingold <sds@goems.com> - * progmodes/etags.el (etags-tags-completion-table): Modified the + * progmodes/etags.el (etags-tags-completion-table): Modify the regexp to allow for the CL symbols starting with `+*'. (tags-completion-table): Doc fix (it's an obarray, not an alist). - (tags-completion-table, tags-recognize-empty-tags-table): Remove - `function' quoting lambda. + (tags-completion-table, tags-recognize-empty-tags-table): + Remove `function' quoting lambda. (tags-with-face): New macro. (list-tags, tags-apropos): Use it. (tags-apropos-additional-actions): New user option. @@ -1116,31 +1116,31 @@ (tags-apropos-verbose): New user option. (etags-tags-apropos): Use it. (visit-tags-table-buffer, next-file): Use `unless'. - (recognize-empty-tags-table): Renamed to + (recognize-empty-tags-table): Rename to tags-recognize-empty-tags-table. (complete-tag): Call tags-complete-tag bypassing try-completion. 1999-12-06 Kenichi Handa <handa@etl.go.jp> - * international/mule.el (set-buffer-file-coding-system): Docstring - modified. + * international/mule.el (set-buffer-file-coding-system): + Docstring modified. 1999-12-05 Dirk Herrmann <D.Herrmann@tu-bs.de> - * textmodes/bibtex.el (bibtex-hs-forward-sexp): Added to support + * textmodes/bibtex.el (bibtex-hs-forward-sexp): Add to support using the hideshow package. - (hs-special-modes-alist): Added entry for bibtex to allow the use + (hs-special-modes-alist): Add entry for bibtex to allow the use of the hideshow package. - (bibtex-hide-entry-bodies): Deleted as hiding of entry bodies is + (bibtex-hide-entry-bodies): Delete as hiding of entry bodies is not longer provided by bibtex.el directly. Instead the hideshow package should be used. - (bibtex-mode-map, bibtex-edit-menu, bibtex-mode): Delete - references to bibtex-hide-entry-bodies. + (bibtex-mode-map, bibtex-edit-menu, bibtex-mode): + Delete references to bibtex-hide-entry-bodies. 1999-12-05 Dirk Herrmann <D.Herrmann@tu-bs.de> - * textmodes/bibtex.el: Copyright notice is up to date. Moved - maintainer information closer to the beginning of the bibtex.el + * textmodes/bibtex.el: Copyright notice is up to date. + Moved maintainer information closer to the beginning of the bibtex.el file. (bibtex-maintainer-salutation): New constant. (bibtex-version): New constant. @@ -1148,16 +1148,16 @@ bibtex-maintainer-salutation. (bibtex-entry-field-alist): Made booktitle field optional for @inproceedings entries when crossreferenced. - (bibtex-entry-field-alist): Added booktitle field to proceedings + (bibtex-entry-field-alist): Add booktitle field to proceedings entry type (for cross referencing). Thanks to Wagner Toledo Correa for the suggestion. - (bibtex-string-file-path): Fixed typo. + (bibtex-string-file-path): Fix typo. 1999-12-05 Carsten Dominik <dominik@strw.leidenuniv.nl> * textmodes/bibtex.el (bibtex-mode-map): Reserved the key `C-c &' for reftex.el. - (bibtex-edit-menu): Added `reftex-view-crossref-from-bibtex' to menu. + (bibtex-edit-menu): Add `reftex-view-crossref-from-bibtex' to menu. 1999-12-04 Dave Love <fx@gnu.org> @@ -1166,14 +1166,14 @@ 1999-12-04 Michael Kifer <kifer@cs.sunysb.edu> - * viper-cmd.el (viper-change-state): Use - viper-ESC-moves-cursor-back to decide whether to move the cursor + * viper-cmd.el (viper-change-state): + Use viper-ESC-moves-cursor-back to decide whether to move the cursor back. 1999-12-03 Kenichi Handa <handa@mule.m17n.org> - * international/mule-util.el (truncate-string-to-width): Docstring - fixed. + * international/mule-util.el (truncate-string-to-width): + Docstring fixed. 1999-12-02 Stefan Monnier <monnier@cs.yale.edu> @@ -1200,8 +1200,8 @@ * vc.el (vc-update-change-log): Look for rcs2log under exec-directory. - * emacs-lisp/lisp-mode.el (lisp-mode-variables): Change - outline-regexp, add outline-level. + * emacs-lisp/lisp-mode.el (lisp-mode-variables): + Change outline-regexp, add outline-level. (lisp-outline-level): New. * calendar/appt.el (appt-convert-time): Handle "12:MMam", @@ -1284,8 +1284,8 @@ * cus-start.el: Add use-dialog-box. * add-log.el (change-log-mode-hook): Customize. - (add-log-current-defun): Use - fortran-{beginning,end}-of-subprogram. + (add-log-current-defun): + Use fortran-{beginning,end}-of-subprogram. 1999-11-26 Richard M. Stallman <rms@gnu.org> @@ -1330,10 +1330,10 @@ * ediff-merge.el (ediff-looks-like-combined-merge) (ediff-get-combined-region): - Changed to support the new format for ediff-combination-pattern. + Change to support the new format for ediff-combination-pattern. * ediff-diff.el (ediff-set-fine-overlays-in-one-buffer): - Changed to support the new format for ediff-combination-pattern. + Change to support the new format for ediff-combination-pattern. 1999-11-24 Dave Love <fx@gnu.org> @@ -1368,8 +1368,8 @@ imenu-generic-expression. * sql.el (sql-mode): Use ?_ and ?. instead of 95 and 46 when - setting font-lock-defaults' SYNTAX-ALIST. Set - imenu-generic-expression, imenu-case-fold-search, and + setting font-lock-defaults' SYNTAX-ALIST. + Set imenu-generic-expression, imenu-case-fold-search, and imenu-syntax-alist. * sql.el (sql-interactive-mode): Use ?_ and ?. instead of 95 @@ -1389,30 +1389,30 @@ 1999-11-23 Dave Love <fx@gnu.org> - * progmodes/fortran.el (fortran-comment-line-start): Renamed from + * progmodes/fortran.el (fortran-comment-line-start): Rename from comment-line-start. - (fortran-comment-line-start-skip): Renamed from + (fortran-comment-line-start-skip): Rename from comment-line-start-skip. (fortran-mode-map): Use renamed functions. Add manual and custom entries to menu. (fortran-mode-hook): Customize. - (fortran-comment-indent-function): Renamed from + (fortran-comment-indent-function): Rename from fortran-comment-hook. (delete-horizontal-regexp): Function deleted. - (fortran-electric-line-number): Simplified. - (fortran-beginning-of-subprogram): Renamed from + (fortran-electric-line-number): Simplify. + (fortran-beginning-of-subprogram): Rename from beginning-of-fortran-subprogram. - (fortran-end-of-subprogram): Renamed from + (fortran-end-of-subprogram): Rename from end-of-fortran-subprogram. - (fortran-mark-subprogram): Renamed from mark-fortran-subprogram. - (fortran-previous-statement, fortran-next-statement): Simplified. + (fortran-mark-subprogram): Rename from mark-fortran-subprogram. + (fortran-previous-statement, fortran-next-statement): Simplify. (fortran-blink-match): New function. (fortran-blink-matching-if, fortran-blink-matching-do): Use it. (fortran-indent-to-column): Don't use delete-horizontal-regexp. - (fortran-find-comment-start-skip, fortran-is-in-string-p): Use - line-end-position. + (fortran-find-comment-start-skip, fortran-is-in-string-p): + Use line-end-position. (fortran-fill): No longer interactive. Simplified. - (fortran-break-line): Simplified. + (fortran-break-line): Simplify. (fortran-analyze-file-format): Use char-after, not looking-at. * emacs-lisp/find-func.el (find-function-regexp): @@ -1432,7 +1432,7 @@ * emacs-lisp/easy-mmode.el: Changed maintainer. (easy-mmode-define-toggle): New BODY arg; Never append `-mode'; Use defcustom for the hooks; Improve the auto-generated docstrings. - (easy-mmode-define-minor-mode): Renamed `define-minor-mode'. + (easy-mmode-define-minor-mode): Rename `define-minor-mode'. (define-minor-mode): Add BODY arg; Only declare the keymap if provided; Improve the auto-generated docstrings. @@ -1498,8 +1498,8 @@ * speedbar.el: Clean up comment at the start of the file. Remove RCS id. - * progmodes/compile.el (compilation-parse-errors): Use - compilation-buffer-p instead of testing major-mode. + * progmodes/compile.el (compilation-parse-errors): + Use compilation-buffer-p instead of testing major-mode. 1999-11-18 Dave Pearson <davep@hagbard.demon.co.uk> @@ -1546,9 +1546,9 @@ * goto-addr.el (goto-address-at-mouse) (goto-address-find-address-at-point): Use compose-mail. - (goto-address-mail-method): Removed variable. + (goto-address-mail-method): Remove variable. (goto-address-send-using-mh-e, goto-address-send-using-mhe) - (goto-address-send-using-mail): Removed functions. + (goto-address-send-using-mail): Remove functions. 1998-11-15 Sam Steingold <sds@goems.com> @@ -1583,7 +1583,7 @@ 1999-11-14 Alex Schroeder <alex@gnu.org> - * ansi-color.el (ansi-color-apply): Updated regexps to include + * ansi-color.el (ansi-color-apply): Update regexps to include highlighted face. 1999-01-14 Johan Vromans <jvromans@squirrel.nl> @@ -1599,11 +1599,11 @@ 1999-11-13 Peter Breton <pbreton@ne.mediaone.net> - * net-utils.el (run-network-program, net-utils-run-program): Use - the new backquote syntax. + * net-utils.el (run-network-program, net-utils-run-program): + Use the new backquote syntax. (smbclient-program, smbclient-program-options) - (smbclient-prompt-regexp, smbclient-font-lock-keywords): New - variables. + (smbclient-prompt-regexp, smbclient-font-lock-keywords): + New variables. (smbclient, smbclient-list-shares): New functions 1999-11-12 Sam Steingold <sds@ksp.com> @@ -1638,7 +1638,7 @@ 1999-11-12 Peter Kleiweg <kleiweg@let.rug.nl> - * progmodes/ps-mode.el (ps-mode-submit-bug-report): Added list + * progmodes/ps-mode.el (ps-mode-submit-bug-report): Add list of customizable variables to bug report message. Added system-type to package name in bug report. @@ -1655,8 +1655,8 @@ 1999-11-10 Peter Kleiweg <kleiweg@let.rug.nl> - * progmodes/ps-mode.el (ps-mode-maintainer-address): New - constant. + * progmodes/ps-mode.el (ps-mode-maintainer-address): + New constant. (ps-mode-submit-bug-report): New function. Entry added to menu. 1999-11-10 William M. Perry <wmperry@aventail.com> @@ -1685,7 +1685,7 @@ 1999-11-08 Peter Kleiweg <kleiweg@let.rug.nl> - * progmodes/ps-mode.el (ps-mode-print-function): Changed default + * progmodes/ps-mode.el (ps-mode-print-function): Change default lpr-command to "lp" for some system-types. (copied from lpr.el Emacs version 20.2.1). @@ -1727,8 +1727,8 @@ * isearch.el (isearch-complete-edit, isearch-ring-advance-edit): Use erase-field instead of erase-buffer. - * frame.el (blink-cursor-mode, blink-cursor-end): Use - internal-show-cursor with new interface. + * frame.el (blink-cursor-mode, blink-cursor-end): + Use internal-show-cursor with new interface. (blink-cursor-timer-function): New. (blink-cursor-start): Use blink-cursor-timer-function. @@ -1760,8 +1760,8 @@ 1999-11-01 Markus Rost <rost@ias.edu> - * dired-x.el (dired-smart-shell-command): Use - shell-command-history as in shell-command. + * dired-x.el (dired-smart-shell-command): + Use shell-command-history as in shell-command. 1999-11-01 Richard M. Stallman <rms@gnu.org> @@ -1775,7 +1775,7 @@ of show-cursor. (blink-cursor-start, blink-cursor-end): Ditto. - * textmodes/tex-mode.el (tex-default-mode): Changed to latex-mode. + * textmodes/tex-mode.el (tex-default-mode): Change to latex-mode. 1999-11-01 Richard M. Stallman <rms@gnu.org> @@ -1792,7 +1792,7 @@ * ediff.el: Version change. - * ediff-util.el (ediff-cleanup-mess): Fixed the case of dead windows. + * ediff-util.el (ediff-cleanup-mess): Fix the case of dead windows. make sure you are in a good frame before deleting other windows. (ediff-file-checked-in-p): Don't consider CVS @@ -1816,10 +1816,10 @@ * viper-keym.el: Fixed calls to viper-ex, change key C-c g to C-c C-g. - * viper-util.el (viper-nontrivial-find-file-function): Deleted. + * viper-util.el (viper-nontrivial-find-file-function): Delete. (viper-glob-unix-files, viper-glob-mswindows-files): New functions. (viper-save-cursor-color, viper-restore-cursor-color): - Improved cursor color handling. + Improve cursor color handling. (viper-get-saved-cursor-color-in-replace-mode) (viper-get-saved-cursor-color-in-insert-mode): New functions for better cursor color handling. @@ -1874,7 +1874,7 @@ `whitespace-check-<whitespace-type>' to nil. (whitespace-unchecked-whitespaces): New function to return the list of whitespaces for whom checks have been suppressed. - (whitespace-display-unchecked-whitespaces): Renamed to + (whitespace-display-unchecked-whitespaces): Rename to `whitespace-update-modeline' to reflect its functionality. 1999-10-30 Gerd Moellmann <gerd@gnu.org> @@ -1895,8 +1895,8 @@ * progmodes/ada-stmt.el, progmodes/ada-xref.el: Doc-string and comment fixes. - * progmodes/compile.el (compilation-error-regexp-alist): Recognize - MIPS Pro 7.3 compiler error message syntax. + * progmodes/compile.el (compilation-error-regexp-alist): + Recognize MIPS Pro 7.3 compiler error message syntax. 1999-10-27 Dave Love <fx@gnu.org> @@ -1909,7 +1909,7 @@ 1999-10-27 Dave Love <fx@gnu.org> * emacs-lisp/advice.el: Doc fixes. - (ad-lemacs-p): Removed. + (ad-lemacs-p): Remove. (advice): Add :link to defgroup. 1999-10-27 Kenichi Handa <handa@etl.go.jp> @@ -1924,11 +1924,11 @@ 1999-10-27 Richard M. Stallman <rms@gnu.org> - * emacs-lisp/advice.el (ad-activate-internal): Renamed from + * emacs-lisp/advice.el (ad-activate-internal): Rename from ad-activate. All callers changed, including those in data.c. - (ad-activate-internal-off): Renamed from ad-activate-off. + (ad-activate-internal-off): Rename from ad-activate-off. All uses changed. - (ad-activate): Renamed from ad-activate-on. All uses changed. + (ad-activate): Rename from ad-activate-on. All uses changed. (ad-start-advice, ad-stop-advice, ad-recover-normality): Alter the definition of ad-activate-internal, not ad-activate. @@ -1951,7 +1951,7 @@ 1999-10-25 Sam Steingold <sds@ksp.com> - * Makefile (compile-files): Fixed the "tr" strings. + * Makefile (compile-files): Fix the "tr" strings. (EMACS): Set to ../src/emacs. 1999-10-25 Gerd Moellmann <gerd@gnu.org> @@ -2037,10 +2037,10 @@ * ps-print-def.el: New file: common definitions for all parts of ps-print. - (ps-multibyte-buffer): Moved from ps-mule. + (ps-multibyte-buffer): Move from ps-mule. * ps-mule.el: File dependence fix. - (ps-multibyte-buffer): Moved to ps-print-def. + (ps-multibyte-buffer): Move to ps-print-def. * ps-print.el: Doc fix, better customization. (ps-print-region-function, ps-number-of-columns, ps-spool-tumble) @@ -2070,7 +2070,7 @@ * ps-print.el: Doc fix, n-up printing. (ps-print-version): New version number (5.0). - (ps-page-dimensions-database): Added document media. + (ps-page-dimensions-database): Add document media. (ps-n-up-printing, ps-n-up-margin, ps-n-up-border-p, ps-n-up-filling) (ps-page-order, ps-printing-region-p): New vars. (ps-n-up-printing, ps-n-up-filling, ps-header-sheet, ps-end-job): @@ -2085,8 +2085,8 @@ (ps-setup, ps-begin-file, ps-get-buffer-name, ps-begin-job) (ps-end-file, ps-dummy-page, ps-generate): Fix funs. (ps-print-prologue-1): Adjust PostScript programming for n-up printing. - (ps-count-lines): Changed to defun. - (ps-header-page): Changed to defsubst, fix fun. + (ps-count-lines): Change to defun. + (ps-header-page): Change to defsubst, fix fun. (ps-printing-region): Doc fix, adjust programming code. (ps-output-boolean, ps-background-pages, ps-background-text) (ps-background-image, ps-background, ps-get-boundingbox): @@ -2097,9 +2097,9 @@ * ps-print.el: Doc fix, duplex and setpagedevice configuration. (ps-print-version): New version number (4.2). (ps-spool-config, ps-spool-tumble): New vars. - (ps-print-prologue-1): Changed to defconst, adjust PostScript + (ps-print-prologue-1): Change to defconst, adjust PostScript programming, new PostScript procedure to handle errors. - (ps-print-prologue-2): Changed to defconst. + (ps-print-prologue-2): Change to defconst. (ps-print-duplex-feature): New const: duplex and tumble setting. (ps-setup, ps-begin-file): Fix funs. (ps-boolean-capitalized): New fun. @@ -2107,9 +2107,9 @@ 1999-10-19 Stefan Monnier <monnier@cs.yale.edu> * Makefile (dontcompilefiles): Obsoleted. - (DONTCOMPILE): Added emacs-lisp/cl-specs.el. + (DONTCOMPILE): Add emacs-lisp/cl-specs.el. (EL): Unused. - (temacs): Removed (unused). + (temacs): Remove (unused). (cus-load.el, finder-inf.el, loaddefs.el): New targets to build a dummy version of the file (necessary for the update to work properly). (autoloads): Force the use of `pwd`/loaddefs.el. @@ -2139,18 +2139,18 @@ value: \"lpr\" changed to "lpr". (ps-mode-version): New constant. (ps-mode-show-version): New function, added key in ps-mode-map. - (ps-run-messages): Removed. + (ps-run-messages): Remove. (ps-run-font-lock-keywords-2): New defcustom variable replacing ps-run-messages. These keywords now include the value of ps-run-prompt, making its fontification customizable. - (ps-run-init): Removed \\n from docstring, it is now added when + (ps-run-init): Remove \\n from docstring, it is now added when the value is used. - (ps-run-font-lock-keywords-1): Added checking for initial ^ in + (ps-run-font-lock-keywords-1): Add checking for initial ^ in ps-run-prompt. - (ps-mode): Added ps-run-font-lock-keywords-2 to list of + (ps-mode): Add ps-run-font-lock-keywords-2 to list of customizable variables in doc-string (its equivalent ps-run-messages was missing in previous version of the doc-string). - (ps-run-mode): Simplified assignment to font-lock-defaults, using + (ps-run-mode): Simplify assignment to font-lock-defaults, using symbols only. 1999-10-19 Alex Schroeder <alex@gnu.org> @@ -2177,7 +2177,7 @@ (set-display-table-and-terminal-coding-system): New function, containing code migrated out of set-language-environment. (set-language-environment, set-locale-environment): Use it. - (locale-translation-file-name): Moved here from startup.el. + (locale-translation-file-name): Move here from startup.el. (locale-language-names, locale-preferred-coding-systems): New vars. (locale-name-match, set-locale-environment): New functions. @@ -2253,7 +2253,7 @@ 1999-10-17 Sam Steingold <sds@ksp.com> - * bindings.el (completion-ignored-extensions): Added ".sparcf" + * bindings.el (completion-ignored-extensions): Add ".sparcf" for CMUCL on sparc and ".ufsl" for LispWorks. (bound-and-true-p): Bugfix: free variable `v'. @@ -2342,8 +2342,8 @@ 1999-10-12 Stefan Monnier <monnier@cs.yale.edu> - * simple.el (shell-command, shell-command-on-region): Use - make-temp-file. + * simple.el (shell-command, shell-command-on-region): + Use make-temp-file. (clone-buffer, clone-process, clone-buffer-hook): New functions. * subr.el (with-current-buffer): Don't use backquotes to avoid @@ -2369,16 +2369,16 @@ 1999-10-12 Richard Sharman <rsharman@pobox.com> * sh-script.el: Added support for indenting existing scripts. - (sh-mode-map): Added new bindings. - (sh-mode): Updated mode doc-string for new commands, added + (sh-mode-map): Add new bindings. + (sh-mode): Update mode doc-string for new commands, added make-local-variable calls, initialize mode-specific variables. - (sh-indent-line): Renamed to sh-basic-indent-line; sh-indent-line + (sh-indent-line): Rename to sh-basic-indent-line; sh-indent-line is now a different function. - (sh-header-marker): Changed docstring. + (sh-header-marker): Change docstring. (sh-set-shell): Initialize mode-specific variables. (sh-case, sh-for, sh-if, sh-indexed-loop, sh-repeat, sh-select) (sh-tmp-file, sh-until, sh-until, sh-while, sh-while-getopts): - Changed these define-skeleton calls to work with user-specified + Change these define-skeleton calls to work with user-specified indentation settings. (sh-basic-indent-line, sh-blink, sh-calculate-indent) (sh-check-paren-in-case, sh-check-rule, sh-do-nothing) @@ -2602,9 +2602,9 @@ (isearch-yank-x-selection, isearch-ring-advance-edit): Doc fix. (isearch-ring-retreat-edit): Doc fix. (isearch-mouse-yank): New command. - (isearch-last-command-char): Removed. Callers changed to use + (isearch-last-command-char): Remove. Callers changed to use last-command-char. - (isearch-char-to-string): Removed. Callers changed to use + (isearch-char-to-string): Remove. Callers changed to use char-to-string. 1999-09-26 Oleg S. Tihonov <tihonov@ffke-campus.mipt.ru> @@ -2652,7 +2652,7 @@ * textmodes/reftex-parse.el (reftex-parse-from-file): Scan for multiple thebibliography environments. - * textmodes/reftex-cite.el (reftex-pop-to-bibtex-entry): Fixed bug + * textmodes/reftex-cite.el (reftex-pop-to-bibtex-entry): Fix bug with recentering window. (reftex-extract-bib-entries-from-thebibliography) (reftex-offer-bib-menu, reftex-bibtex-selection-callback): @@ -2749,7 +2749,7 @@ `copy-file'. (dired-copy-file-recursive): New function. Copy directories recursively. - (dired-do-create-files): Added support for generalized directory + (dired-do-create-files): Add support for generalized directory target. How-to function may now return a function. New fluid variable `dired-one-file'. (dired-copy-how-to-fn): New variable. @@ -2770,8 +2770,8 @@ * whitespace.el (whitespace-modes): Add `change-log-mode' to the list of modes to be checked for bogus whitespaces. - * whitespace.el (whitespace-rescan-timer-time): Update - documentation. + * whitespace.el (whitespace-rescan-timer-time): + Update documentation. * whitespace.el (whitespace-display-unchecked-whitespaces): New function to update modeline with untested whitespaces. @@ -2816,8 +2816,8 @@ (widget-button-pressed-face): New variable. (widget-button-click): Use it. (widget-documentation-link-add): Specify mouse and button faces. - (widget-echo-help-mouse, widget-stop-mouse-tracking): Functions - removed now the functionality is built in. + (widget-echo-help-mouse, widget-stop-mouse-tracking): + Functions removed now the functionality is built in. * cus-edit.el: Don't define-widget-keywords. (multimedia): New group. @@ -2842,8 +2842,8 @@ (custom-variable-set, custom-variable-save, custom-face-state-set) (custom-variable-reset-saved, custom-variable-reset-standard) (custom-face-set, custom-face-save, custom-face-reset-saved) - (custom-face-reset-standard, customize-save-customized): Handle - custom comments. + (custom-face-reset-standard, customize-save-customized): + Handle custom comments. (custom-comment-face, custom-comment-tag-face): New face. (custom-comment): New widget. (custom-comment-create, custom-comment-delete) @@ -2936,8 +2936,8 @@ * emacs-lisp/byte-opt.el (byte-optimize-backward-char): (byte-optimize-backward-word): New optimizations. - (side-effect-free-fns, side-effect-and-error-free-fns): Add - entries. + (side-effect-free-fns, side-effect-and-error-free-fns): + Add entries. 1999-09-09 Gerd Moellmann <gerd@gnu.org> @@ -2973,7 +2973,7 @@ 1999-09-08 Peter Breton <pbreton@ne.mediaone.net> - * generic-x.el (generic-define-unix-modes): Added new modes: + * generic-x.el (generic-define-unix-modes): Add new modes: inetd-conf-generic-mode, etc-services-generic-mode, etc-passwd-generic-mode. These are all defined for Unix by default. (apache-generic-mode): Use an imenu-generic-expression to list @@ -2985,11 +2985,11 @@ font-lock-defaults setting. (java-properties-generic-mode): Supports both ! and # as comment characters. - (java-properties-generic-mode): Added an imenu-generic-expression. - (java-properties-generic-mode): Reworked to support the various + (java-properties-generic-mode): Add an imenu-generic-expression. + (java-properties-generic-mode): Rework to support the various different ways to separate name and value (viz, '=', ':' and whitespace). - (show-tabs-generic-mode): Added this new generic-mode. + (show-tabs-generic-mode): Add this new generic-mode. 1999-09-08 Richard Stallman <rms@gnu.org> @@ -3059,7 +3059,7 @@ 1999-09-07 Dave Pearson <davep@hagbard.demon.co.uk> - * quickurl.el (quickurl-list-focused-line): Removed. + * quickurl.el (quickurl-list-focused-line): Remove. (quickurl-list-insert): Now works out the focused line using `count-lines' instead of using `quickurl-list-focused-line'. @@ -3072,7 +3072,7 @@ * isearch.el (isearch-mode-map): Add mouse-2. - * mail/rmail.el (rmail-read-password): Deleted. + * mail/rmail.el (rmail-read-password): Delete. (rmail-get-pop-password): Use read-password. * quickurl.el: Don't conditionally define caddr. @@ -3085,8 +3085,8 @@ 1999-09-06 Stephen Eglen <stephen@gnu.org> - * progmodes/octave-inf.el (inferior-octave-startup-args): Add - --no-line-editing so that TABs in source files are not interpreted + * progmodes/octave-inf.el (inferior-octave-startup-args): + Add --no-line-editing so that TABs in source files are not interpreted as completion requests. 1999-09-06 Gerd Moellmann <gerd@gnu.org> @@ -3112,7 +3112,7 @@ 1999-09-06 Dave Love <fx@gnu.org> - * emacs-lisp/byte-opt.el (byte-boolean-vars): Removed. (Now primitive.) + * emacs-lisp/byte-opt.el (byte-boolean-vars): Remove. (Now primitive.) 1999-09-05 Richard Stallman <rms@gnu.org> @@ -3128,7 +3128,7 @@ 1999-09-05 Gerd Moellmann <gerd@gnu.org> - * faces.el (header-line): Renamed from `top-line'. + * faces.el (header-line): Rename from `top-line'. 1999-09-05 Gerd Moellmann <gerd@gnu.org> @@ -3183,20 +3183,20 @@ * startup.el (command-line): Compute the value of small-temporary-file-directory. - * ediff-init.el (ediff-temp-file-prefix): Use - small-temporary-file-directory if non-nil. + * ediff-init.el (ediff-temp-file-prefix): + Use small-temporary-file-directory if non-nil. * vc.el (vc-update-change-log): Likewise. * progmodes/cmacexp.el (c-macro-expansion): Likewise. - * simple.el (shell-command, shell-command-on-region): Use - make-temp-name properly. Use small-temporary-file-directory if + * simple.el (shell-command, shell-command-on-region): + Use make-temp-name properly. Use small-temporary-file-directory if non-nil, otherwise temporary-file-directory, to generate temporary files. - * dos-w32.el (direct-print-region-helper): Use - temporary-file-directory. (From Stefan Monnier.) + * dos-w32.el (direct-print-region-helper): + Use temporary-file-directory. (From Stefan Monnier.) 1999-09-02 Richard Stallman <rms@gnu.org> @@ -3237,8 +3237,8 @@ * progmodes/compile.el (compilation-error-regexp-alist): New item for SGI IRIX MipsPro compilers. - * speedbar.el (speedbar-directory-buttons): Recognize - device names when checking for file names. + * speedbar.el (speedbar-directory-buttons): + Recognize device names when checking for file names. * array.el (array-reconfigure-rows): Use generate-new-buffer. @@ -3271,8 +3271,8 @@ * comint.el (comint-input-ring-separator): New variable. (comint-read-input-ring): Doc change; use comint-input-ring-separator when reading file. - (comint-write-input-ring): Use - comint-input-ring-separator when writing file. + (comint-write-input-ring): + Use comint-input-ring-separator when writing file. 1999-08-29 Marc Girod <girod@shire.ntc.nokia.com> @@ -3306,8 +3306,8 @@ * calendar/cal-move.el: Call the new hook in every movement function. - * calendar/calendar.el (calendar-goto-astro-day-number): Autoload - the right function name. + * calendar/calendar.el (calendar-goto-astro-day-number): + Autoload the right function name. 1999-08-26 Stephen Gildea <gildea@stop.mail-abuse.org> @@ -3316,7 +3316,7 @@ (time-stamp): Support multi-line patterns. (time-stamp-inserts-lines): New variable. (time-stamp-count): New variable. - (time-stamp-string-preprocess): Fixed bug where "%%a" becomes + (time-stamp-string-preprocess): Fix bug where "%%a" becomes "Thu" instead of "%a". 1999-08-25 Gerd Moellmann <gerd@gnu.org> @@ -3338,7 +3338,7 @@ 1999-08-24 Gerd Moellmann <gerd@gnu.org> - * faces.el (margin): Renamed from bitmap-area. + * faces.el (margin): Rename from bitmap-area. 1999-08-24 Alex Schroeder <alex@gnu.org> @@ -3423,8 +3423,8 @@ 1999-08-16 Karl Heuer <kwzh@gnu.org> - * subr.el (assoc-ignore-case, assoc-ignore-representation): Moved - here from simple.el. + * subr.el (assoc-ignore-case, assoc-ignore-representation): + Move here from simple.el. 1999-08-16 Dave Love <fx@gnu.org> @@ -3461,17 +3461,17 @@ 1999-08-16 Carsten Dominik <cd@gnu.org> - * textmodes/reftex.el (reftex-pop-to-bibtex-entry): Fixed - conflict with pop-up-frames. + * textmodes/reftex.el (reftex-pop-to-bibtex-entry): + Fix conflict with pop-up-frames. (reftex-special-environment-parsers): New constant. (reftex-label-alist): car of an entry can also be a function. (reftex-what-special-env): Cew function. (reftex-label-location): Call `reftex-what-special-env'. (reftex-compile-variables): Check for symbol in `reftex-label-alist'. - (reftex-what-environment): Fixed bug with stacked environments of + (reftex-what-environment): Fix bug with stacked environments of same kind (e.g. enumerate). (reftex-process-string): Preserve default directory. - (reftex-label-alist-builtin): Changed prefixes of endnote and footnote. + (reftex-label-alist-builtin): Change prefixes of endnote and footnote. Also the magic words. (reftex-reference): Interpret new option `reftex-fref-is-default'. (reftex-replace-prefix-escapes): Interpret new `%S' format. @@ -3486,7 +3486,7 @@ boundaries has been moved to `F'. (reftex-select-label-map): Toggling display of file boundaries is now on the `F' key, for consistency with `reftex-toc-map'. - (reftex-erase-all-selection-and-index-buffers): Renamed from + (reftex-erase-all-selection-and-index-buffers): Rename from `reftex-erase-all-selection-buffer'. Now also kills the index buffers. (reftex-viewing-cross-references): Customization group renamed @@ -3604,7 +3604,7 @@ be the same size when necessary to fit all the rings in the window; and poles can be oriented horizontally. Face support is thrown in gratuitously. - (hanoi): Changed default number of rings back to 3. + (hanoi): Change default number of rings back to 3. (hanoi-unix, hanoi-unix-64): New commands. (hanoi-horizontal-flag, hanoi-move-period, hanoi-use-faces) (hanoi-pole-face, hanoi-base-face, hanoi-even-ring-face) @@ -3612,15 +3612,15 @@ (hanoi-internal, hanoi-current-time-float, hanoi-put-face) (hanoi-n, hanoi-insert-ring, hanoi-goto-char, hanoi-sit-for) (hanoi-ring-to-pos, hanoi-pos-on-tower-p): New functions. - (hanoi-0): Renamed from hanoi0, for symmetry with hanoi-n. - (hanoi-topos, hanoi-draw-ring): Removed. + (hanoi-0): Rename from hanoi0, for symmetry with hanoi-n. + (hanoi-topos, hanoi-draw-ring): Remove. 1999-08-12 Gerd Moellmann <gerd@gnu.org> * faces.el (face-valid-attribute-values): Return an alist for families on ttys. - (face-read-integer): Handle unspecified face attributes. Add - completion for `unspecified'. + (face-read-integer): Handle unspecified face attributes. + Add completion for `unspecified'. (read-face-attribute): Handle unspecified font attributes. (face-valid-attribute-values): Add `unspecified' to lists so that it can be chosen via completion. @@ -3658,7 +3658,7 @@ (easy-menu-change): Doc fix. * info-look.el (info-lookup-guess-c-symbol): Use skip-syntax-backward. - (info-lookup-guess-default): Simplified and cleaned up. + (info-lookup-guess-default): Simplify and cleaned up. (info-lookup-guess-default*): Preserve point. * view.el (view-mode-disable): If buffer-read-only is nil, @@ -3678,13 +3678,13 @@ 1999-08-10 Alex Schroeder <asc@bsiag.com> - * ansi-color.el (ansi-color-to-text-properties): Added New state 5 + * ansi-color.el (ansi-color-to-text-properties): Add New state 5 to prevent m-eating-bug. 1999-08-10 Eli Zaretskii <eliz@gnu.org> - * term/pc-win.el (msdos-bg-mode): Remove. Call - frame-set-background-mode instead. All callers changed. + * term/pc-win.el (msdos-bg-mode): Remove. + Call frame-set-background-mode instead. All callers changed. (msdos-face-setup): Don't force color display parameter, it is set by frame-set-background-mode. (make-msdos-frame): Call x-handle-reverse-video and @@ -3695,8 +3695,8 @@ 1999-08-10 Dave Love <fx@melange.gnu.org> - * emacs-lisp/advice.el (ad-make-single-advice-docstring): Treat - case with no docstring specially. + * emacs-lisp/advice.el (ad-make-single-advice-docstring): + Treat case with no docstring specially. 1999-08-09 Eli Zaretskii <eliz@gnu.org> @@ -3705,8 +3705,8 @@ 1999-08-07 Dave Love <fx@gnu.org> - * man.el (Man-softhyphen-to-minus): Revert previous change. Avoid - unibyte to multibyte conversion of search-forward (from Handa), + * man.el (Man-softhyphen-to-minus): Revert previous change. + Avoid unibyte to multibyte conversion of search-forward (from Handa), but avoid the replacement if the language is Latin-N. 1999-08-06 Richard Stallman <rms@gnu.org> @@ -3811,14 +3811,14 @@ (apply-on-rectangle): New function, mostly replaces `operate-on-rectangle'. All callers changed. (move-to-column-force): Pass new second argument to `move-to-column'. - (kill-rectangle): Added optional prefix arg to fill lines. + (kill-rectangle): Add optional prefix arg to fill lines. (delete-rectangle): Ditto. (delete-whitespace-rectangle): Ditto. (delete-extract-rectangle): Ditto. (open-rectangle): Ditto. (clear-rectangle): Ditto. (delete-whitespace-rectangle-line): New function. - (delete-rectangle-line): Added third arg FILL. + (delete-rectangle-line): Add third arg FILL. (delete-extract-rectangle-line): Ditto. (open-rectangle-line): Ditto. (clear-rectangle-line): Ditto. @@ -3876,7 +3876,7 @@ frame-delete-all. * frame.el: Change comments to doc strings and other doc fixes. - (frame-delete-all): Moved to subr.el as `assoc-delete-all'. + (frame-delete-all): Move to subr.el as `assoc-delete-all'. Callers changed. (set-background-color, set-foreground-color, set-cursor-color) (set-mouse-color, set-border-color): Offer completion of colors. @@ -3948,7 +3948,7 @@ * mouse.el (x-fixed-font-alist): Add lucidasanstypewriter. * msb.el: Require cl only when compiling. - (msb--home-dir): Deleted. + (msb--home-dir): Delete. (msb--format-title): Use abbreviate-file-name. (msb--choose-file-menu): Simplify string comparison. @@ -3980,7 +3980,7 @@ 1999-07-26 Kenichi Handa <handa@etl.go.jp> * international/ccl.el (ccl-embed-symbol): New function. - (ccl-program-p): Deleted. Now it's implemented in C code. + (ccl-program-p): Delete. Now it's implemented in C code. (ccl-compile-call): Use ccl-embed-symbol to embed a symbol. (ccl-compile-translate-character): Likewise. (ccl-compile-map-single): Likewise. @@ -4021,19 +4021,19 @@ * fortran.el (fortran-mode-syntax-table): Change `\' to `\' syntax. - (fortran-fontify-string, fortran-match-!-comment): Deleted. + (fortran-fontify-string, fortran-match-!-comment): Delete. (fortran-font-lock-syntactic-keywords): New variable. (fortran-mode): Use it. (fortran-font-lock-keywords-1): Don't do comments. - (beginning-of-fortran-subprogram, end-of-fortran-subprogram): Save - match data. + (beginning-of-fortran-subprogram, end-of-fortran-subprogram): + Save match data. * textmodes/sgml-mode.el (sgml-validate-command): Use nsgmls. - * msb.el (msb-menu-bar-update-buffers): Renamed from + * msb.el (msb-menu-bar-update-buffers): Rename from menu-bar-update-buffers. - (msb-custom-set, msb--toggle-menu-type): Call - msb-menu-bar-update-buffers. + (msb-custom-set, msb--toggle-menu-type): + Call msb-menu-bar-update-buffers. (msb-mode): Revise the hook setting. * font-lock.el (turn-on-font-lock): Use tty-display-color-p. @@ -4079,9 +4079,9 @@ 1999-07-21 Gerd Moellmann <gerd@gnu.org> - * cl-extra.el (cl-make-hash-table): Renamed from make-hash-table. - (cl-hash-table-p): Renamed from hash-table-p. - (cl-hash-table-count): Renamed from hash-table-count. + * cl-extra.el (cl-make-hash-table): Rename from make-hash-table. + (cl-hash-table-p): Rename from hash-table-p. + (cl-hash-table-count): Rename from hash-table-count. (maphash): Alias to cl-maphash removed. (gethash): Likewise. (puthash): Likewise. @@ -4148,7 +4148,7 @@ 1999-07-21 Gerd Moellmann <gerd@gnu.org> - * faces.el (face-underline): Removed. + * faces.el (face-underline): Remove. (face-underline-color): Ditto. 1999-07-21 Gerd Moellmann <gerd@gnu.org> @@ -4319,10 +4319,10 @@ * bindings.el (make-mode-line-mouse-sensitive): Use down-mouse-3 instead of mouse-3 to pop up menus. - (mode-line-kill-buffer): Removed. + (mode-line-kill-buffer): Remove. (make-mode-line-mouse-sensitive): Pop mouse buffer menu over buffer name. - (mode-line-buffer-menu-1): Removed. + (mode-line-buffer-menu-1): Remove. * startup.el (command-line-1): Call make-mode-line-mouse-sensitive. @@ -4405,7 +4405,7 @@ 1999-07-21 Gerd Moellmann <gerd@gnu.org> - * faces.el (frame-update-faces): Copied from 20.2. + * faces.el (frame-update-faces): Copy from 20.2. (frame-update-face-colors): Ditto. Code removed that isn't applicable in the new face implementation. @@ -4424,12 +4424,12 @@ 1999-07-21 Gerd Moellmann <gerd@gnu.org> - * faces.el (face-charset-registries): Removed since fontset.el + * faces.el (face-charset-registries): Remove since fontset.el is no always loaded. 1999-07-21 Gerd Moellmann <gerd@gnu.org> - * faces.el (internal-get-face): Added as obsolete function for + * faces.el (internal-get-face): Add as obsolete function for compatibility. 1999-07-21 Gerd Moellmann <gerd@gnu.org> @@ -4458,7 +4458,7 @@ * faces.el (face-id): Return the ID of a realized face for ASCII. - * fontset.el (x-charset-registries): Removed. Now in faces.el. + * fontset.el (x-charset-registries): Remove. Now in faces.el. (x-complement-fontset-spec): Use face-charset-registries. * faces.el (face-font-selection-order): Set font selection order @@ -4486,14 +4486,14 @@ * cus-face.el (custom-face-attributes): Add :bold and :italic for compatibility with old code. - * faces.el (set-face-attributes-from-resources): Additional - frame parameter. + * faces.el (set-face-attributes-from-resources): + Additional frame parameter. (make-face-x-resource-internal): Set attributes from resources for a given frame or all frames. 1999-07-21 Gerd Moellmann <gerd@gnu.org> - * faces.el (all-faces): Removed. + * faces.el (all-faces): Remove. * custom.el (defface): Add new face attributes to function comment. @@ -4512,8 +4512,8 @@ * cus-face.el (custom-face-attributes): Use new face attributes. - * faces.el (set-face-attribute-from-resource): Initialize - from resources only for X and W32. + * faces.el (set-face-attribute-from-resource): + Initialize from resources only for X and W32. * cus-face.el (custom-declare-face): Don't make frame-local faces. @@ -4599,8 +4599,8 @@ * faces.el (eval-when-compile): Add set-face-shadow-thickness. (internal-facep): Increase vector size. (make-face): Ditto. - (face-shadow-thickness): Added. - (set-face-shadow-thickness): Added. + (face-shadow-thickness): Add. + (set-face-shadow-thickness): Add. (modify-face): Add optional shadow-thickness parameter. (make-face-x-resource-internal): Add shadows. (copy-face): Ditto. @@ -4646,8 +4646,8 @@ * fill.el (canonically-space-region, justify-current-line): Add * to interactive spec. (fill-region-as-paragraph, fill-paragraph, fill-region) - (fill-nonuniform-paragraphs, fill-individual-paragraphs): Check - readonly buffer in interactive spec. + (fill-nonuniform-paragraphs, fill-individual-paragraphs): + Check readonly buffer in interactive spec. * paragraphs.el (kill-paragraph, backward-kill-paragraph) (backward-kill-sentence, kill-sentence): Add * to interactive spec. @@ -4662,7 +4662,7 @@ 1999-07-19 John Wiegley <jwiegley@borland.com> - * term.el (ansi-term-fg-faces-vector): Added support for ANSI + * term.el (ansi-term-fg-faces-vector): Add support for ANSI color codes 39 and 49, which by the way lynx uses them seem to mean "foreground reset" and "background reset". @@ -4727,7 +4727,7 @@ 1999-07-08 Espen Skoglund <espensk@stud.cs.uit.no> - * pascal.el (pascal-calculate-indent): Fixed a bug occurring when + * pascal.el (pascal-calculate-indent): Fix a bug occurring when the `end' keyword was in the very beginning of the buffer. 1999-07-08 Richard Stallman <rms@gnu.org> @@ -4759,8 +4759,8 @@ * isearch.el (isearch-process-search-char): Write octal 200 correctly. - * startup.el (normal-top-level-add-subdirs-to-load-path): Avoid - doing a `stat' when it isn't necessary because that can cause + * startup.el (normal-top-level-add-subdirs-to-load-path): + Avoid doing a `stat' when it isn't necessary because that can cause trouble when an NFS server is down. 1999-07-04 Richard Stallman <rms@gnu.org> @@ -4869,8 +4869,8 @@ 1999-06-18 Andrew Innes <andrewi@gnu.org> - * mail/smtpmail.el (smtpmail-send-it): Use - convert-standard-filename to make file names for queued mail safe + * mail/smtpmail.el (smtpmail-send-it): + Use convert-standard-filename to make file names for queued mail safe on Windows (`:' is invalid in file names on Windows). 1999-06-17 Kenichi Handa <handa@etl.go.jp> @@ -4911,8 +4911,8 @@ 1999-06-15 Markus Rost <markus.rost@mathematik.uni-regensburg.de> - * mail/rmailsum.el (rmail-summary-output-to-rmail-file): Avoid - multiple output of the last message. + * mail/rmailsum.el (rmail-summary-output-to-rmail-file): + Avoid multiple output of the last message. 1999-06-14 Eli Zaretskii <eliz@gnu.org> @@ -4977,8 +4977,8 @@ 1999-06-09 Dave Love <fx@gnu.org> - * progmodes/compile.el (compilation-error-regexp-alist): Allow - digits in program name in first pattern. + * progmodes/compile.el (compilation-error-regexp-alist): + Allow digits in program name in first pattern. 1999-06-09 Andre Spiegel <spiegel@inf.fu-berlin.de> @@ -4992,8 +4992,8 @@ 1999-06-05 Stephen Eglen <stephen@gnu.org> - * iswitchb.el (iswitchb-default-keybindings): Add - iswitchb-minibuffer-setup to minibuffer-setup-hook here rather + * iswitchb.el (iswitchb-default-keybindings): + Add iswitchb-minibuffer-setup to minibuffer-setup-hook here rather than when package is loaded. 1999-06-04 Richard M. Stallman <rms@gnu.org> @@ -5033,7 +5033,7 @@ 1999-06-04 Eric M. Ludlam <zappo@ultranet.com> - * speedbar.el (speedbar-hack-buffer-menu): Fixed so if the user + * speedbar.el (speedbar-hack-buffer-menu): Fix so if the user does not select a buffer from the buffers menu, then the attached frame is not switched to anything. @@ -5128,8 +5128,8 @@ 1999-05-25 Ken'ichi Handa <handa@gnu.org> - * mail/smtpmail.el (smtpmail-send-it): Bind - smtpmail-code-conv-from properly. + * mail/smtpmail.el (smtpmail-send-it): + Bind smtpmail-code-conv-from properly. (smtpmail-send-data-1): If DATA is a multibyte string, encode it by smtpmail-code-conv-from. @@ -5238,13 +5238,13 @@ 1995-05-11 Joel N. Weber II <devnull@melange.gnu.org> - * comint.el (comint-password-prompt-regexp): Modified to match the + * comint.el (comint-password-prompt-regexp): Modify to match the output of ksu and ssh-add. 1999-05-11 Kenichi HANDA <handa@etl.go.jp> * language/korea-util.el (isearch-toggle-korean-input-method): - Adjusted for the change of input method handling in isearch.el. + Adjust for the change of input method handling in isearch.el. (isearch-hangul-switch-symbol-ksc): Likewise. (isearch-hangul-switch-hanja): Likewise. @@ -5266,8 +5266,8 @@ 1999-05-09 Ken'ichi Handa <handa@gnu.org> - * ps-print.el (ps-control-character): Call - ps-mule-prepare-ascii-font to setup ASCII fonts. + * ps-print.el (ps-control-character): + Call ps-mule-prepare-ascii-font to setup ASCII fonts. * ps-mule.el (ps-mule-begin-job): Redo this change "if ps-multibyte-buffer is nil, use @@ -5278,16 +5278,16 @@ * ispell.el (ispell-local-dictionary-alist): New variable for customizing local dictionaries not accessible by everyone. (ispell-dictionary-alist): Loads `ispell-local-dictionary-alist'. - (ispell-required-version): Changed format `(major minor + (ispell-required-version): Change format `(major minor revision)' to support general pattern matching. (ispell-tex-skip-alists): AMS Tex block comment and `\author' skip region commented out due to incorrect skip potential in std latex. - (ispell-word): Removed `when' macro. Fixed bug of not restoring + (ispell-word): Remove `when' macro. Fixed bug of not restoring cursor point on small words for calls from `ispell-minor-mode'. (check-ispell-version): Tests and accepts versions major.minor and above, with adjustments for interactions in 3.1.0-3.1.11. (ispell-get-line): No longer skips ispell process special characters. - (ispell-comments-and-strings): Removed `when' macro call. + (ispell-comments-and-strings): Remove `when' macro call. (ispell-minor-check): Requires ispell-word to restore cursor point. (ispell-buffer-local-parsing): Supports checking comments only. @@ -5308,7 +5308,7 @@ 1999-05-07 Joel N. Weber II <devnull@melange.gnu.org> - * comint.el (comint-password-prompt-regexp): Modified so that it + * comint.el (comint-password-prompt-regexp): Modify so that it matches the output of kinit. 1999-05-06 Greg Stark <gsstark@mit.edu> @@ -5450,8 +5450,8 @@ 1999-04-26 John Wiegley <johnw@borland.com> - * progmodes/compile.el (compilation-error-regexp-alist): Recognize - C++Builder 4.0 error message syntax. + * progmodes/compile.el (compilation-error-regexp-alist): + Recognize C++Builder 4.0 error message syntax. 1999-04-26 Mark Diekhans <markd@Grizzly.COM> @@ -5460,8 +5460,8 @@ 1999-04-26 Yoshiki Hayashi <g740685@komaba.ecc.u-tokyo.ac.jp> - * textmodes/texinfmt.el (texinfo-format-buffer): Bind - coding-system-for-write, to avoid hanging when non-interactive. + * textmodes/texinfmt.el (texinfo-format-buffer): + Bind coding-system-for-write, to avoid hanging when non-interactive. 1999-04-26 Dirk Herrmann <D.Herrmann@tu-bs.de> @@ -5666,12 +5666,12 @@ 1999-03-25 Andrew Innes <andrewi@gnu.org> - * w32-fns.el (set-default-process-coding-system): Copied from + * w32-fns.el (set-default-process-coding-system): Copy from dos-w32.el, but modified to use Unix line endings for process input, and to add a suitable entry to process-coding-system-alist for DOS shells. - * dos-fns.el (set-default-process-coding-system): Copied from + * dos-fns.el (set-default-process-coding-system): Copy from dos-w32.el. * dos-w32.el (set-default-process-coding-system): Move function to @@ -5712,8 +5712,8 @@ 1999-03-18 Simon Marshall <simon@gnu.org> - * font-lock.el (c-font-lock-keywords-2): Added "complex" type. - (java-font-lock-keywords-2): Added "strictfp" keyword. + * font-lock.el (c-font-lock-keywords-2): Add "complex" type. + (java-font-lock-keywords-2): Add "strictfp" keyword. 1999-03-17 Jason Rumney <jasonr@altavista.net> @@ -5722,8 +5722,8 @@ 1999-03-17 Eli Zaretskii <eliz@gnu.org> - * international/mule-cmds.el (set-language-environment): Fix - previous change: don't use dos-codepage when unbound. + * international/mule-cmds.el (set-language-environment): + Fix previous change: don't use dos-codepage when unbound. 1999-03-17 Karl Heuer <kwzh@gnu.org> @@ -5747,7 +5747,7 @@ 1999-03-15 Simon Marshall <simon@gnu.org> - * font-lock.el (c-font-lock-keywords-2): Added "restrict" keyword. + * font-lock.el (c-font-lock-keywords-2): Add "restrict" keyword. 1999-03-14 Milan Zamazal <pdm@pvt.net> @@ -5777,7 +5777,7 @@ * speedbar.el: Added commentary about stealthy functions. (speedbar-message): New function. (speedbar-y-or-n-p): New function. - (speedbar-with-attached-buffer): Moved macro before reference. + (speedbar-with-attached-buffer): Move macro before reference. Now uses `save-selected-window'. (speedbar-mouse-hscroll, speedbar-track-mouse, speedbar-refresh) (speedbar-generic-item-info, speedbar-item-info-file-helper) @@ -5820,8 +5820,8 @@ 1999-03-09 Dave Love <fx@gnu.org> - * textmodes/sgml-mode.el (html-mode): Use - sentence-end-double-space when setting sentence-end. + * textmodes/sgml-mode.el (html-mode): + Use sentence-end-double-space when setting sentence-end. 1999-03-09 Ken'ichi Handa <handa@gnu.org> @@ -5864,8 +5864,8 @@ 1999-03-06 Dave Love <fx@gnu.org> - * progmodes/cc-cmds.el (c-outline-level): Bind - buffer-invisibility-spec. + * progmodes/cc-cmds.el (c-outline-level): + Bind buffer-invisibility-spec. * progmodes/c-mode.el (c-outline-level): Likewise. @@ -5905,8 +5905,8 @@ 1999-03-03 Dave Love <fx@gnu.org> * options.el (edit-options): Doc fix. - (list-options): Don't lose with unbound symbols. Maintain - Edit-options-mode. + (list-options): Don't lose with unbound symbols. + Maintain Edit-options-mode. 1999-03-01 Dave Love <fx@gnu.org> @@ -5918,7 +5918,7 @@ (ispell-dictionary-alist): Don't setq it, if ispell-dictionary-alist-override is set. - * simple.el (shell-command-default-error-buffer): Renamed from + * simple.el (shell-command-default-error-buffer): Rename from shell-command-on-region-default-error-buffer. (shell-command-on-region): Mention in echo area when there is some error output. Mention success or failure, too. @@ -5964,8 +5964,8 @@ (ps-font-size, ps-header-font-size, ps-header-title-font-size): Specifies landscape and portrait sizes. (ps-setup, ps-print-quote, ps-line-lengths-internal, ps-nb-pages) - (ps-get-page-dimensions, ps-begin-file, ps-begin-job, ps-generate): Fun - fix. + (ps-get-page-dimensions, ps-begin-file, ps-begin-job, ps-generate): + Fun fix. (ps-get-font-size): New fun. (ps-font-size-internal, ps-header-font-size-internal) (ps-header-title-font-size-internal): New vars. @@ -6009,8 +6009,8 @@ 1999-02-23 Ken'ichi Handa <handa@gnu.org> - * international/encoded-kb.el (encoded-kbd-handle-8bit): Allow - inputting ?\240. + * international/encoded-kb.el (encoded-kbd-handle-8bit): + Allow inputting ?\240. 1999-02-23 Karl Heuer <kwzh@gnu.org> @@ -6027,8 +6027,8 @@ 1999-02-22 Eli Zaretskii <eliz@gnu.org> - * arc-mode.el (archive-set-buffer-as-visiting-file): Save - excursion while calling set-auto-coding-function. + * arc-mode.el (archive-set-buffer-as-visiting-file): + Save excursion while calling set-auto-coding-function. * play/handwrite.el (handwrite): Require ps-print, and use ps-printer-name and ps-lpr-command. Call ps-print-region-function @@ -6036,8 +6036,8 @@ 1999-02-22 Kenichi Handa <handa@etl.go.jp> - * international/codepage.el (cp-coding-system-for-codepage-1): Put - charset-origin-alist property to a coding system for the codepage. + * international/codepage.el (cp-coding-system-for-codepage-1): + Put charset-origin-alist property to a coding system for the codepage. * international/mule.el: Modify comment for charset-origin-alist property of a coding system. @@ -6053,7 +6053,7 @@ 1999-02-21 Peter Breton <pbreton@ne.mediaone.net> - * dirtrack.el (dirtrack): Added docstring. Now returns input. + * dirtrack.el (dirtrack): Add docstring. Now returns input. 1999-02-18 Peter Breton <pbreton@ne.mediaone.net> @@ -6090,7 +6090,7 @@ (sql-stop): Use sql-input-ring-separator and sql-input-ring-file-name. (sql-input-ring-file-name): New variable with customization. (sql-input-ring-separator): New variable with customization. - (sql-set-sqli-buffer): Renamed from sql-change-sqli-buffer. + (sql-set-sqli-buffer): Rename from sql-change-sqli-buffer. Callers changed. (sql-show-sqli-buffer): The message for "sql-buffer is not set" now includes the name of the current buffer. @@ -6106,7 +6106,7 @@ 1999-02-18 Ken'ichi Handa <handa@gnu.org> - * international/mule.el (coding-system-list): Moved here from + * international/mule.el (coding-system-list): Move here from mule-util.el to avoid autoloading mule-util by the call of select-safe-coding-system. @@ -6122,12 +6122,12 @@ 1999-02-17 Peter Breton <pbreton@ne.mediaone.net> - * filecache.el (file-cache-filter-regexps): Added .class. + * filecache.el (file-cache-filter-regexps): Add .class. 1999-02-17 Ken'ichi Handa <handa@gnu.org> - * international/mule-util.el (decompose-region): Use - insert-buffer-substring instead of insert-buffer to avoid putting + * international/mule-util.el (decompose-region): + Use insert-buffer-substring instead of insert-buffer to avoid putting mark. 1999-02-17 Andreas Schwab <schwab@gnu.org> @@ -6179,8 +6179,8 @@ 1999-02-16 Ken'ichi Handa <handa@gnu.org> - * language/japanese.el (japanese-shift-jis): Add - charset-origin-alist property. + * language/japanese.el (japanese-shift-jis): + Add charset-origin-alist property. 1999-02-15 Richard Stallman <rms@gnu.org> @@ -6209,10 +6209,10 @@ 1999-02-14 Richard Stallman <rms@gnu.org> * international/iso-transl.el: - (iso-transl-ae): Renamed from iso-transl-e-slash. - (iso-transl-a-ring): Renamed from iso-transl-a-slash. - (iso-transl-AE): Renamed from iso-transl-E-slash. - (iso-transl-A-ring): Renamed from iso-transl-A-slash. + (iso-transl-ae): Rename from iso-transl-e-slash. + (iso-transl-a-ring): Rename from iso-transl-a-slash. + (iso-transl-AE): Rename from iso-transl-E-slash. + (iso-transl-A-ring): Rename from iso-transl-A-slash. (iso-transl-char-map): Related changes. * format.el (format-replace-strings): Fix value of TO in REVERSE case. @@ -6229,7 +6229,7 @@ 1999-02-12 Alex Schroeder <a.schroeder@bsiag.ch> * sql.el: Set version to 1.3.2. - (sql-solid-program): Added support for solid. + (sql-solid-program): Add support for solid. (sql-help): Doc mentions sql-solid. (sql-solid): Entry function for Solid. (sql-buffer): Doc explains the use of the variable and how to @@ -6243,16 +6243,16 @@ (sql-change-sqli-buffer): New function to change sql-buffer. (sql-mode): Doc explains how to change sql-buffer. (sql-send-paragraph): New function to send a paragraph. - (sql-mode-map): Added keybinding for sql-send-paragraph. + (sql-mode-map): Add keybinding for sql-send-paragraph. (sql-mysql): Doc corrected. (sql-ms): Doc corrected. * sql.el (sql-server): Doc fix. - (sql-mysql): Added the use of sql-server to specify the host, + (sql-mysql): Add the use of sql-server to specify the host, sql-database now specifies database instead of host. (sql-mode-menu): Send... menu items are only active if sql-buffer is non-nil. - (sql-help): Changed tag of entry functions a bit. + (sql-help): Change tag of entry functions a bit. * sql.el: Added keywords from `finder-by-keyword'. (sql-mode): Made sql-buffer a local variable, changed the @@ -6267,10 +6267,10 @@ sql-user and sql-password used during login. (sql-sybase): Quoted *SQL* in doc string, added comma. (sql-oracle): Likewise. - (sql-interactive-mode): Added extensive documentation for having + (sql-interactive-mode): Add extensive documentation for having multiple SQL buffers sending their stuff to different SQLi buffers, each running a different process. - (sql-buffer): Changed doc from *SQL* to SQLi. + (sql-buffer): Change doc from *SQL* to SQLi. (sql-get-login): Doc fix. 1999-02-12 Ken'ichi Handa <handa@gnu.org> @@ -6301,8 +6301,8 @@ 1999-02-12 Ken'ichi Handa <handa@gnu.org> - * international/quail.el (quail-show-kbd-layout): Bind - blink-matching-paren to nil. + * international/quail.el (quail-show-kbd-layout): + Bind blink-matching-paren to nil. * ps-mule.el (ps-mule-font-info-database-bdf): Fix ENCODING field for ASCII and Latin-1. @@ -6313,8 +6313,8 @@ 1999-02-12 Kenichi Handa <handa@etl.go.jp> - * international/mule-cmds.el (language-info-alist): Remove - description about charset-origin-alist. + * international/mule-cmds.el (language-info-alist): + Remove description about charset-origin-alist. * international/mule.el: Comment added for a new coding system property `charset-origin-alist'. @@ -6330,8 +6330,8 @@ ("Cyrillic-KOI8"): Remove charset-origin-alist property. ("Cyrillic-ALT"): Likewise. - * language/vietnamese.el (vietnamese-viqr): Add - charset-origin-alist property. + * language/vietnamese.el (vietnamese-viqr): + Add charset-origin-alist property. ("Vietnamese"): Remove charset-origin-alist property. * simple.el (what-cursor-position): Don't use the variable @@ -6371,8 +6371,8 @@ 1999-02-08 Eli Zaretskii <eliz@gnu.org> - * international/codepage.el (cp-coding-system-for-codepage-1): On - MS-DOS, use dos-unsupported-char-glyph for characters not + * international/codepage.el (cp-coding-system-for-codepage-1): + On MS-DOS, use dos-unsupported-char-glyph for characters not supported by the codepage. (cp-make-coding-systems-for-codepage): Likewise. @@ -6381,7 +6381,7 @@ * international/mule-util.el (coding-system-list): Don't sort coding-system-list here. - * international/mule.el (coding-system-lessp): Moved here from + * international/mule.el (coding-system-lessp): Move here from mule-util.el. (add-to-coding-system-list): New function. (make-subsidiary-coding-system, make-coding-system) @@ -6427,18 +6427,18 @@ 1999-02-05 Alex Schroeder <asc@bsiag.com> * progmodes/sql.el: Changed version to 1.2.1. - (sql-pop-to-buffer-after-send-region): Improved documentation. - (sql-mysql-program): Added MySQL support. + (sql-pop-to-buffer-after-send-region): Improve documentation. + (sql-mysql-program): Add MySQL support. (sql-prompt-length): Made prompt-length configurable. (sql-mode-syntax-table): Made apostrophe (') be a string delimiter. - (sql-help): Added MySQL support, changed documentation. + (sql-help): Add MySQL support, changed documentation. (sql-send-region): A message is displayed if something is sent. - (sql-mode): Added buffer-local comment-start. + (sql-mode): Add buffer-local comment-start. (sql-interactive-mode): Use sql-prompt-length to set left-margin. - (sql-interactive-mode): Added buffer-local comment-start. + (sql-interactive-mode): Add buffer-local comment-start. (sql-oracle): Set sql-prompt-length. (sql-sybase): Set sql-prompt-length. - (sql-mysql): Added MySQL support. + (sql-mysql): Add MySQL support. (sql-ingres): Set sql-prompt-length. (sql-ms): Set sql-prompt-length. (sql-postgres): Set sql-prompt-length. @@ -6495,8 +6495,8 @@ 1999-02-01 Ken'ichi Handa <handa@gnu.org> - * international/mule-util.el (compose-chars-component): Add - autoload cookie. + * international/mule-util.el (compose-chars-component): + Add autoload cookie. 1999-01-31 Ken'ichi Handa <handa@gnu.org> @@ -6506,8 +6506,8 @@ 1999-01-31 Markus Rost <markus.rost@mathematik.uni-regensburg.de> - * progmodes/compile.el (compilation-next-error-locus): Don't - decrease argument FIND-AT-LEAST of compilation-next-error-locus. + * progmodes/compile.el (compilation-next-error-locus): + Don't decrease argument FIND-AT-LEAST of compilation-next-error-locus. 1999-01-31 Eli Zaretskii <eliz@gnu.org> @@ -6538,8 +6538,8 @@ * tex-mode.el (tex-mode-map): Replace validate-tex-buffer by tex-validate-buffer. (plain-tex-mode, latex-mode, slitex-mode): Likewise. - (tex-validate-buffer): Renamed from validate-tex-buffer. Works - now with recent occur-mode. + (tex-validate-buffer): Rename from validate-tex-buffer. + Works now with recent occur-mode. (tex-validate-region): Really walk through all Sexps. (tex-region): Bind shell-dirtrack-verbose. (tex-file, tex-bibtex-file): Likewise. @@ -6639,8 +6639,8 @@ 1999-01-25 Edward M. Reingold <reingold@emr.cs.uiuc.edu> - * calendar/diary-lib.el (mark-diary-entries): Use - assoc-ignore-case and do not capitalize when matching month and + * calendar/diary-lib.el (mark-diary-entries): + Use assoc-ignore-case and do not capitalize when matching month and day names. * calendar/calendar.el (calendar-read-date): Ditto. @@ -6734,8 +6734,8 @@ 1999-01-23 Ken'ichi Handa <handa@gnu.org> - * international/fontset.el (create-fontset-from-x-resource): Make - style variants. + * international/fontset.el (create-fontset-from-x-resource): + Make style variants. 1999-01-22 Dave Love <fx@gnu.org> @@ -6748,7 +6748,7 @@ 1999-01-22 Jason Rumney <jasonr@altavista.net> - * term/w32-win.el (w32-standard-fontset-spec): Simplified. + * term/w32-win.el (w32-standard-fontset-spec): Simplify. 1999-01-22 Felix Lee <flee@cygnus.com> @@ -6782,8 +6782,8 @@ 1999-01-19 Jason Rumney <jasonr@altavista.net> - * term/w32-win.el (w32-standard-fontspec-spec): Change - iso8859-5 to koi8-r. Add iso8859-9. + * term/w32-win.el (w32-standard-fontspec-spec): + Change iso8859-5 to koi8-r. Add iso8859-9. 1999-01-19 Dave Love <fx@gnu.org> @@ -6807,8 +6807,8 @@ * textmodes/tex-mode.el (tex-define-common-keys): Remove key binding of tex-feed-input. (tex-mode-map): Bind tex-feed-input here. - (tex-start-shell): Use compilation-shell-minor-mode. Set - comint-input-filter-functions before running tex-shell-hook. + (tex-start-shell): Use compilation-shell-minor-mode. + Set comint-input-filter-functions before running tex-shell-hook. (tex-start-tex): Forget compilation errors. (tex-compilation-parse-errors): Rewritten to work also with compile-mouse-goto-error and compile-goto-error. Adjusted to @@ -6827,8 +6827,8 @@ 1999-01-18 Ken'ichi Handa <handa@gnu.org> - * international/ccl.el (ccl-compile-translate-character): Handle - the case that a translation table is CCL register correctly. + * international/ccl.el (ccl-compile-translate-character): + Handle the case that a translation table is CCL register correctly. * international/mule-cmds.el (select-safe-coding-system): Highlight at most 256 characters. @@ -6893,8 +6893,8 @@ 1999-01-17 Andrew Innes <andrewi@gnu.org> - * dos-w32.el (find-buffer-file-type-coding-system): Use - default-buffer-file-coding-system when file doesn't exist (and + * dos-w32.el (find-buffer-file-type-coding-system): + Use default-buffer-file-coding-system when file doesn't exist (and isn't covered by a special case) instead of forcing undecided-dos against the user's wishes. @@ -6916,8 +6916,8 @@ * lpr.el (printer-name): Update docstring about usage on MS-DOS and MS-Windows. (lpr-command) [ms-dos, windows-nt]: Initialize to empty string on - DOS and Windows platforms, to indicate direct printing. Update - the docstring accordingly. + DOS and Windows platforms, to indicate direct printing. + Update the docstring accordingly. * ps-print.el (ps-printer-name): Update docstring about usage on MS-DOS and MS-Windows. @@ -6952,8 +6952,8 @@ 1999-01-16 Dave Love <fx@gnu.org> - * help.el (temp-buffer-setup-hook, temp-buffer-show-hook): Revert - last change. + * help.el (temp-buffer-setup-hook, temp-buffer-show-hook): + Revert last change. 1999-01-15 Dave Love <fx@gnu.org> @@ -7002,8 +7002,8 @@ 1999-01-13 Eli Zaretskii <eliz@gnu.org> * international/codepage.el (cp850-decode-table): Replace nil - entries with codes of similary looking glyphs. (Suggested by - Jason Rumney <jasonr@altavista.net>.) + entries with codes of similary looking glyphs. ( + Suggested by Jason Rumney <jasonr@altavista.net>.) 1999-01-13 Dave Love <fx@gnu.org> @@ -7026,12 +7026,12 @@ * cus-start.el: Add inhibit-eol-conversion. - * help.el (temp-buffer-setup-hook, temp-buffer-show-hook): Swap - the values round. + * help.el (temp-buffer-setup-hook, temp-buffer-show-hook): + Swap the values round. 1999-01-11 Richard Stallman <rms@psilocin.ai.mit.edu> - * help.el (help-mode-finish): Renamed from help-mode-maybe. + * help.el (help-mode-finish): Rename from help-mode-maybe. Don't switch to Help mode here. (temp-buffer-setup-hook): Use help-mode-finish. (help-mode-setup): New function. @@ -7145,11 +7145,11 @@ 1999-01-06 Eli Zaretskii <eliz@gnu.org> - * international/codepage.el (cp-coding-system-for-codepage-1): Add - the valid-codes property. + * international/codepage.el (cp-coding-system-for-codepage-1): + Add the valid-codes property. - * international/mule-cmds.el (prefer-coding-system): Call - set-coding-priority, so that the internal array of priorities is + * international/mule-cmds.el (prefer-coding-system): + Call set-coding-priority, so that the internal array of priorities is also updated. * international/mule-util.el @@ -7164,8 +7164,8 @@ * emacs-lisp/debug.el (debug): Leave recursive minibuffer enabled if it was enabled before. - * view.el (View-revert-buffer-scroll-page-forward): Bind - view-scroll-auto-exit instead of obsolete view-mode-auto-exit. + * view.el (View-revert-buffer-scroll-page-forward): + Bind view-scroll-auto-exit instead of obsolete view-mode-auto-exit. * files.el (recover-session): Preserve point when inserting explanation. @@ -7438,9 +7438,9 @@ (cperl-syntaxify-by-font-lock): Set to t, should be safe now. Better default, customizes to `message' too, off in text-mode. - (cperl-array-face): Renamed from `font-lock-emphasized-face', + (cperl-array-face): Rename from `font-lock-emphasized-face', `defface'd. - (cperl-hash-face): Renamed from `font-lock-other-emphasized-face'. + (cperl-hash-face): Rename from `font-lock-other-emphasized-face'. `defface'd. (cperl-emacs-can-parse): New state variable. (cperl-indent-line): Corrected to use global state. @@ -7488,7 +7488,7 @@ inside of POD too. (cperl-backward-to-noncomment): Better treatment of PODs and HEREs. (cperl-clobber-mode-lists): New configuration variable. - (cperl-not-bad-style-regexp): Updated. + (cperl-not-bad-style-regexp): Update. Init: `cperl-is-face' was busted. (cperl-make-face): New macros. (cperl-force-face): New macros. @@ -7503,7 +7503,7 @@ (cperl-tags-hier-init): Gross hack to pretend we work (are we?). Another try to work around XEmacs problems. Better progress messages. (toplevel): Require custom unprotected => failure on 19.28. - (cperl-xemacs-p): Defined when compile too. + (cperl-xemacs-p): Define when compile too. (cperl-find-tags): Was writing line/pos in a wrong order, pos off by 1 and not at beg-of-line. (cperl-etags-snarf-tag): New macro. @@ -7599,8 +7599,8 @@ (speedbar-this-file-in-vc) Fix SCCS to use s. not p. files. (speedbar-tag-group-name-minimum-length): New variable. (speedbar-frame-parameter): New compatibility function. - (speedbar-frame-mode): Updated to use speedbar-frame-parameter. - (speedbar-apply-one-tag-hierarchy-method): Fixed up taging sub + (speedbar-frame-mode): Update to use speedbar-frame-parameter. + (speedbar-apply-one-tag-hierarchy-method): Fix up taging sub groups to keep things in the right order, and to help with some naming conventions. (speedbar-create-tag-hierarchy): Enable buffer local version of @@ -7726,8 +7726,8 @@ (ps-mule-plot-string): Set ps-mule-current-charset. (ps-mule-initialize): Add autoload cookie. Don't set ps-mule-font-info-database here. - (ps-mule-begin-job): Renamed from ps-mule-begin. Update - ps-mule-font-info-database and ps-control-or-escape-regexp. + (ps-mule-begin-job): Rename from ps-mule-begin. + Update ps-mule-font-info-database and ps-control-or-escape-regexp. (ps-mule-begin-page): New fun. * ps-print.el: Mule related code moved to ps-mule.el. @@ -7749,7 +7749,7 @@ * ps-print.el (ps-mule-font-info-database): Doc-string modified. (ps-mule-external-libraries): New element FEATURE. - (ps-mule-init-external-library): Adjusted for the above change. + (ps-mule-init-external-library): Adjust for the above change. (ps-mule-generate-font): Likewise. (ps-mule-generate-glyphs): Likewise. (ps-mule-prepare-font): Likewise. @@ -7766,7 +7766,7 @@ Handle the case of unknown charset. (find-multibyte-characters): If invalid multibyte characters are found, return the corresponding strings instead of character codes. - (find-multibyte-characters): Adjusted for the above change. + (find-multibyte-characters): Adjust for the above change. (select-safe-coding-system): For a unibyte buffer, always returns DEFAULT-CODING-SYSTEM. (get-charset-property): Fix previous change. Make it a function. @@ -7786,8 +7786,8 @@ 1998-12-14 Andreas Schwab <schwab@delysid.gnu.org> - * textmodes/texinfo.el (texinfo-tex-buffer): Bind - tex-start-options-string to empty string. + * textmodes/texinfo.el (texinfo-tex-buffer): + Bind tex-start-options-string to empty string. (texinfo-tex-region): Use texinfo-tex-trailer as documented. 1998-12-14 Andrew Innes <andrewi@delysid.gnu.org> @@ -7839,7 +7839,7 @@ * help.el (symbol-file-load-history-loaded): Variable renamed, and defvar moved from loadhist.el. - (symbol-file): Renamed from describe-function-find-file. + (symbol-file): Rename from describe-function-find-file. Load fns-VERSION.el here. (describe-variable, describe-function-1): Use symbol-file. @@ -7968,7 +7968,7 @@ * vc.el (vc-dired-window-configuration, vc-ediff-windows) (vc-ediff-result, vc-dired-switches, vc-dired-terse-mode): - Added defvars to suppress compilation warnings. + Add defvars to suppress compilation warnings. 1998-11-30 Ken Stevens <k.stevens@ieee.org> @@ -7984,13 +7984,13 @@ ispell-message-text-end, ispell-add-per-file-word-list. (ispell-dictionary-alist-1, ispell-dictionary-alist2): A coding system is now required for all languages. Casechars improved for - castellano, castellano8, and norsk dictionaries. Dictionary - norsk7-tex added. Dictionary polish added. + castellano, castellano8, and norsk dictionaries. + Dictionary norsk7-tex added. Dictionary polish added. (ispell-dictionary-alist): Redefined at load-time to support dictionary changes. (ispell-menu-map): Redefined at load-time to support menu changes. (ispell-check-version): New alias for `check-ispell-version'. - (ispell-parse-output): Fixed matching for ispell error messages. + (ispell-parse-output): Fix matching for ispell error messages. Correctly returns spelling suggestions in order generated by ispell process. (check-ispell-version): Ensure `case-fold-search' doesn't get @@ -8002,12 +8002,12 @@ (ispell-kill-ispell): Ensures ispell process has terminated before starting new process. This can otherwise confuse process filters and hang the ispell process. - (ispell-begin-skip-region-regexp, ispell-skip-region): Improved - skipping support for sgml. + (ispell-begin-skip-region-regexp, ispell-skip-region): + Improve skipping support for sgml. (ispell-minor-check): Support sgml labels. Fix mapping ^M to \r which could cause `ispell-complete-word' to hang. - (ispell-message): Improved message reference matching. Ensure - `case-fold-search' doesn't get redefined. + (ispell-message): Improve message reference matching. + Ensure `case-fold-search' doesn't get redefined. (ispell-buffer-local-parsing): Ensure `case-fold-search' doesn't get redefined. Fixed bug in returning to nroff mode from tex mode. (ispell-add-per-file-word-list): Ensure `case-fold-search' doesn't @@ -8108,8 +8108,8 @@ 1998-11-22 Andrew Innes <andrewi@delysid.gnu.org> - * mail/rmail.el (rmail-set-message-counters-counter): Detect - messages that have been added with DOS line endings and convert + * mail/rmail.el (rmail-set-message-counters-counter): + Detect messages that have been added with DOS line endings and convert the line endings for such messages. 1998-11-22 Emilio Lopes <Emilio.Lopes@Physik.TU-Muenchen.DE> @@ -8131,8 +8131,8 @@ 1998-11-21 Lars Magne Ingebrigtsen <larsi@gnus.org> - * message.el (message-ignored-supersedes-headers): Remove - NNTP-Posting-Date. + * message.el (message-ignored-supersedes-headers): + Remove NNTP-Posting-Date. 1998-11-21 Richard Stallman <rms@psilocin.ai.mit.edu> @@ -8243,8 +8243,8 @@ (tar-extract): Avoid multibyte<->unibyte conversion in insert-buffer-substring by setting both buffers unibyte temporarily. - (tar-copy): Set the buffer unibyte while doing a work. Write - without code conversion. + (tar-copy): Set the buffer unibyte while doing a work. + Write without code conversion. (tar-expunge): Set the buffer unibyte while doing a work. (tar-alter-one-field): Likewise. (tar-clear-modification-flags): Compare byte position with @@ -8262,7 +8262,7 @@ 1998-11-15 Dave Love <fx@gnu.org> * progmodes/fortran.el: Fix previous change: - (fortran-end-prog-re1): Changed. + (fortran-end-prog-re1): Change. (fortran-check-end-prog-re): New function. (beginning-of-fortran-subprogram, end-of-fortran-subprogram): Use it. @@ -8281,15 +8281,15 @@ New options. (reftex-use-text-after-label-as-context): Option removed. (reftex-extract-bib-entries): Protect use in non-latex buffers. - (reftex-toc-visit-location): Renamed from `reftex-toc-visit-line'. + (reftex-toc-visit-location): Rename from `reftex-toc-visit-line'. (reftex-latin1-to-ascii): Works now with and without Mule. - (reftex-truncate): Removed special stuff for Emacs 20.2. + (reftex-truncate): Remove special stuff for Emacs 20.2. (reftex-get-offset): Made more general. - (reftex-show-label-location): Renamed from + (reftex-show-label-location): Rename from `reftex-select-label-callback'. (reftex-pop-to-label): Function removed (using `reftex-show-label-location' instead. - (reftex-insert-docstruct): Renamed from + (reftex-insert-docstruct): Rename from `reftex-make-and-insert-label-list'. Function args changed. (reftex-toc): Now uses `reftex-insert-docstruct' and `reftex-find-start-point'. @@ -8327,7 +8327,7 @@ 1998-11-11 Per Starbäck <starback@update.uu.se> - * ispell.el (ispell-dictionary-alist-2): Removed svenska, renamed + * ispell.el (ispell-dictionary-alist-2): Remove svenska, renamed svenska8 to svenska, and fixed and extended CASECHARS for it. 1998-11-11 Andrew Innes <andrewi@delysid.gnu.org> @@ -8338,8 +8338,8 @@ 1998-11-11 Kenichi Handa <handa@etl.go.jp> - * international/mule-util.el (compose-chars-component): Signal - error if CH is a rule-based composition character. + * international/mule-util.el (compose-chars-component): + Signal error if CH is a rule-based composition character. (compose-chars): Signal error if an already composed character is going to be composed by rule-base. @@ -8465,8 +8465,8 @@ 1998-11-04 Kenichi Handa <handa@etl.go.jp> - * international/quail.el (quail-show-guidance-buf): Call - set-minibuffer-window to set minibuffer window of the current + * international/quail.el (quail-show-guidance-buf): + Call set-minibuffer-window to set minibuffer window of the current frame correctly. 1998-11-03 Theodore Jump <tjump@tertius.com> @@ -8527,13 +8527,13 @@ 1998-10-30 Kenichi Handa <handa@etl.go.jp> - * international/quail.el (quail-start-translation): Handle - switching of the frame in read-key-sequence. + * international/quail.el (quail-start-translation): + Handle switching of the frame in read-key-sequence. (quail-start-conversion): Likewise. (quail-show-guidance-buf): Detach quail-guidance-buf from any windows before setting an appropriate window for it. - (quail-hide-guidance-buf): Use window-minibuffer-p. Set - quail-guidance-win to nil. + (quail-hide-guidance-buf): Use window-minibuffer-p. + Set quail-guidance-win to nil. (quail-update-guidance): If quail-guidance-buf is not in the selected frame, call quail-show-guidance-buf again. @@ -8565,14 +8565,14 @@ * emacs-lisp/eldoc.el (eldoc-argument-case): Fix customize type. - * emacs-lisp/lisp-mnt.el (lm-report-bug): Use - report-emacs-bug-address instead of undefined bug-gnu-emacs. + * emacs-lisp/lisp-mnt.el (lm-report-bug): + Use report-emacs-bug-address instead of undefined bug-gnu-emacs. - * international/mule-cmds.el (select-message-coding-system): Doc - fix. + * international/mule-cmds.el (select-message-coding-system): + Doc fix. - * international/mule-diag.el (describe-coding-system): Describe - all flags. + * international/mule-diag.el (describe-coding-system): + Describe all flags. * mail/sendmail.el (sendmail-coding-system) (default-sendmail-coding-system): Doc fix. @@ -8580,8 +8580,8 @@ * simple.el (shell-command-on-region): Doc fix. * loadup.el: Write fns-*.el in current directory instead of - data-directory since no installation directory exists yet. Mark - buffer unmodified afterwards. + data-directory since no installation directory exists yet. + Mark buffer unmodified afterwards. * loadhist.el (symbol-file): Load fns-*.el from exec-directory instead of data-directory since it is architecture dependent. @@ -8597,11 +8597,11 @@ 1998-10-27 Richard Stallman <rms@psilocin.ai.mit.edu> - * progmodes/tcl-mode.el (tcl-font-lock-keywords): Added itcl and + * progmodes/tcl-mode.el (tcl-font-lock-keywords): Add itcl and namespace related keywords such as `class', `body', `private', `variable', `namespace eval', etc. (tcl-imenu-generic-expression): Handle itcl body and class definitions. - (tcl-mode): Added ":" as a word constituent to the syntax-alist of + (tcl-mode): Add ":" as a word constituent to the syntax-alist of imenu and font-lock so that searches for \sw would find words containing colons. @@ -8730,9 +8730,9 @@ (profile-functions): Simplify. (profile-print): Use float. Make output include space separators. (profile-add-time): New helper function. - (profile-function-prolog): Renamed from profile-start-function. + (profile-function-prolog): Rename from profile-start-function. Handle profile-distinct. - (profile-function-epilog): Renamed from profile-update-function. + (profile-function-epilog): Rename from profile-update-function. Handle profile-distinct. (profile-a-function): If the function to be profiled is an autoload form, load it. If it's lazy-loaded, fetch it. @@ -8882,8 +8882,8 @@ 1998-10-14 Emilio Lopes <Emilio.Lopes@Physik.TU-Muenchen.DE> - * progmodes/fortran.el (fortran-join-line): Use - `delete-indentation' instead of issuing an error message if not on + * progmodes/fortran.el (fortran-join-line): + Use `delete-indentation' instead of issuing an error message if not on a continuation line. Provide for joining several lines using prefix arg. @@ -8916,7 +8916,7 @@ 1998-10-13 Geoff Voelker <voelker@cs.washington.edu> * ls-lisp.el (ls-lisp-use-insert-directory-program): New variable. - (ls-lisp-insert-directory): Renamed from insert-directory. + (ls-lisp-insert-directory): Rename from insert-directory. (insert-directory): New function. 1998-10-13 Richard Stallman <rms@psilocin.ai.mit.edu> @@ -9049,7 +9049,7 @@ 1998-10-06 Peter Breton <pbreton@ne.mediaone.net> - * generic.el (generic-mode-with-type): Added hooks for generic-modes. + * generic.el (generic-mode-with-type): Add hooks for generic-modes. * net-utils.el (ftp, nslookup): Require comint. (network-service-connection): Likewise. @@ -9059,7 +9059,7 @@ (whois-get-tld): New function. * dirtrack.el: Mentioned dirtrack-debug-toggle in the docs. - (dirtrack-debug-toggle): Added this function. + (dirtrack-debug-toggle): Add this function. 1998-10-06 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -9074,9 +9074,9 @@ * arc-mode.el (archive-mode-revert): Arg no-auto-save renamed from no-autosave. * tar-mode.el (tar-mode-revert): Likewise. - * ediff-util.el (ediff-arrange-auto-save-in-merge-jobs): Renamed - from ediff-arrange-autosave-in-merge-jobs. Callers changed. - * gnus/message.el (message-auto-save-directory): Renamed from + * ediff-util.el (ediff-arrange-auto-save-in-merge-jobs): + Rename from ediff-arrange-autosave-in-merge-jobs. Callers changed. + * gnus/message.el (message-auto-save-directory): Rename from message-autosave-directory. All references changed. 1998-10-06 Jonathan I. Kamens <jik@kamens.brookline.ma.us> @@ -9091,15 +9091,15 @@ * replace.el (perform-replace): Position point properly before and after the recursive edit of C-r. - * progmodes/etags.el (tags-reset-tags-tables): Properly - find the markers in the old rings that are being discarded. + * progmodes/etags.el (tags-reset-tags-tables): + Properly find the markers in the old rings that are being discarded. 1998-10-06 Markus Rost <markus.rost@mathematik.uni-regensburg.de> * apropos.el (apropos-print): Control invalid characters. * play/landmark.el (lm-font-lock-face-O, lm-font-lock-face-X): - Renamed from lm-font-lock-O-face, lm-font-lock-X-face to avoid + Rename from lm-font-lock-O-face, lm-font-lock-X-face to avoid confusing customize. 1998-10-06 Eli Zaretskii <eliz@mescaline.gnu.org> @@ -9109,12 +9109,12 @@ 1998-10-05 Simon Marshall <simon@gnu.org> - * menu-bar.el (menu-bar-tools-menu): Added entry for Speedbar. + * menu-bar.el (menu-bar-tools-menu): Add entry for Speedbar. 1998-10-04 Eric Ludlam <zappo@gnu.org> - * speedbar.el (speedbar-initial-expansion-list-name): Remove - customization since it is not useful in this case. + * speedbar.el (speedbar-initial-expansion-list-name): + Remove customization since it is not useful in this case. (speedbar-frame-mode): Check if cfx or cfy is a list, and make sure it gets evalled to a number. Also verify that set-frame-name fn exists before calling it. @@ -9133,8 +9133,8 @@ 1998-10-02 Dave Love <fx@gnu.org> - * outline.el (hide-region-body): Bind - outline-view-change-hook to nil while making repeated calls to + * outline.el (hide-region-body): + Bind outline-view-change-hook to nil while making repeated calls to outline-flag-region. Run it once at the end. (hide-other, hide-sublevels, show-children): Likewise. @@ -9240,8 +9240,8 @@ * textmodes/texinfo.el (texinfo-show-structure): Bind inhibit-read-only. - * isearch.el (isearch-search-and-update): Properly - handle upper case letters in the reverse-search special case. + * isearch.el (isearch-search-and-update): + Properly handle upper case letters in the reverse-search special case. 1998-09-25 Markus Rost <markus.rost@mathematik.uni-regensburg.de> @@ -9329,14 +9329,14 @@ whenever appt-mode-string has changed. (appt-add, appt-delete): Add autoload cookies. (appt-check): Catch errors from calling `diary'. - (appt-max-time): Renamed from max-time. + (appt-max-time): Rename from max-time. (appt-now-displayed, appt-display-count): New variables. (appt-timer): Don't create one if we already have one. * textmodes/tex-mode.el (tex-compilation-parse-errors): More general code to use the source buffer instead of the zap file. - * hilit-chg.el (highlight-compare-with-file): Renamed from + * hilit-chg.el (highlight-compare-with-file): Rename from compare-with-file. * loadhist.el (load-history-loaded): New variable. @@ -9368,9 +9368,9 @@ * emacs-lisp/eldoc.el (eldoc-message): Check for 1-arg case, and store string in eldoc-last-message without consing a new string. Rearrange logic from nested if's into cond's. - (eldoc-print-fnsym-args): Renamed to eldoc-get-fnsym-args-string. + (eldoc-print-fnsym-args): Rename to eldoc-get-fnsym-args-string. Do not print message; just return string. - (eldoc-get-var-docstring): Renamed from eldoc-print-var-docstring. + (eldoc-get-var-docstring): Rename from eldoc-print-var-docstring. Do not print message; just return string. Cache that string in eldoc-last-data. (eldoc-last-data): Make into a vector. @@ -9395,14 +9395,14 @@ * progmodes/vhdl-mode.el (vhdl-header-file): Fix customize type. - * progmodes/cpp.el (cpp-face-light-list, cpp-face-dark-list): Fix - customize type. + * progmodes/cpp.el (cpp-face-light-list, cpp-face-dark-list): + Fix customize type. * progmodes/cperl-mode.el (cperl-lazy-help-time): Fix customize type. - * progmodes/compile.el (compilation-error-screen-columns): New - variable. + * progmodes/compile.el (compilation-error-screen-columns): + New variable. (compilation-next-error-locus): Use it to decide whether to use forward-char or move-to-column. @@ -9419,8 +9419,8 @@ * startup.el (site-run-file): Fix customize type. - * speedbar.el (speedbar-initial-expansion-list-name): Fix - customize type. + * speedbar.el (speedbar-initial-expansion-list-name): + Fix customize type. * shell.el (shell-input-autoexpand): Fix customize type. @@ -9445,24 +9445,24 @@ 1998-09-16 Kenichi Handa <handa@etl.go.jp> - * international/mule-cmds.el (reset-language-environment): Call - update-coding-systems-internal. + * international/mule-cmds.el (reset-language-environment): + Call update-coding-systems-internal. * international/mule-conf.el: Call update-coding-systems-internal at the tail. 1998-09-14 Dave Love <fx@gnu.org> - * vc-hooks.el (vc-menu-map): Change the vc-directory label. Don't - use the menu-enable properties, pending doing it correctly and + * vc-hooks.el (vc-menu-map): Change the vc-directory label. + Don't use the menu-enable properties, pending doing it correctly and acceptably fast. * map-ynp.el (map-y-or-n-p): Mention RET, `q' in the help text. 1998-09-13 Dave Love <d.love@dl.ac.uk> - * progmodes/hideshow.el (hs-grok-mode-type): Check - comment-{start,end} non-nil as well as bound. Report an error if + * progmodes/hideshow.el (hs-grok-mode-type): + Check comment-{start,end} non-nil as well as bound. Report an error if we can't grok the mode. 1998-09-13 Richard Stallman <rms@gnu.org> @@ -9603,9 +9603,9 @@ (reftex-label-illegal-re): Default changed, removed Latin1. (reftex-latin1-to-ascii): New function. (reftex-what-environment): Check for section regexp before use. - (reftex-find-tex-file, reftex-find-bib-file): Fixed bug with + (reftex-find-tex-file, reftex-find-bib-file): Fix bug with absolute path names. - (reftex-TeX-master-file): Changed sequence of file checks. + (reftex-TeX-master-file): Change sequence of file checks. (reftex-do-citation): Bibview cache only with RefTeX mode on. 1998-09-06 Richard Stallman <rms@gnu.org> @@ -9679,7 +9679,7 @@ 1998-09-04 Peter Breton <pbreton@ne.mediaone.net> - * net-utils.el (netstat-program-options): Changed from nil to "-a" + * net-utils.el (netstat-program-options): Change from nil to "-a" so that by default netstat shows all network connections. 1998-09-04 Bob Weiner <weiner@altrasoft.com> @@ -9699,8 +9699,8 @@ 1998-09-03 Bill Richter <richter@brouwer.math.nwu.edu> - * international/quail.el (quail-choose-completion-string): Store - completion `choice' in `quail-current-str'; don't insert it. + * international/quail.el (quail-choose-completion-string): + Store completion `choice' in `quail-current-str'; don't insert it. 1998-09-02 Kenichi Handa <handa@etl.go.jp> @@ -9727,8 +9727,8 @@ 1998-09-01 Dave Love <fx@gnu.org> - * international/mule-cmds.el (current-language-environment): Fix - setter function. + * international/mule-cmds.el (current-language-environment): + Fix setter function. 1998-09-01 Simon Marshall <simon@gnu.org> @@ -9808,8 +9808,8 @@ * ange-ftp.el (ange-ftp-allow-child-lookup): Reinstate checking dired-local-variables-file for dired-x. - * emacs-lisp/find-func.el (find-function-search-for-symbol): Look - for compressed library files too. + * emacs-lisp/find-func.el (find-function-search-for-symbol): + Look for compressed library files too. 1998-08-26 Kenichi Handa <handa@etl.go.jp> @@ -9842,8 +9842,8 @@ 1998-08-26 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus/gnus-start.el (gnus-save-newsrc-file): Bind - coding-system-for-write before saving. + * gnus/gnus-start.el (gnus-save-newsrc-file): + Bind coding-system-for-write before saving. 1998-08-26 Kevin Rodgers <kevinr@ihs.com> (tiny change) @@ -9861,15 +9861,15 @@ * repeat.el (repeat): Doc fix. [From rms:] (repeat-previous-repeated-command): New variable. - (repeat): Check for real-last-command being null or repeat. Set - repeat-previous-repeated-command. + (repeat): Check for real-last-command being null or repeat. + Set repeat-previous-repeated-command. * browse-url.el (browse-url-netscape): Fix format for hex escapes. 1998-08-25 Kenichi Handa <handa@etl.go.jp> - * gnus/message.el (message-send-mail-with-sendmail): Bind - coding-system-for-write by the return value of + * gnus/message.el (message-send-mail-with-sendmail): + Bind coding-system-for-write by the return value of select-message-coding-system. (message-send-mail-with-qmail): Likewise. @@ -9904,7 +9904,7 @@ * ps-print.el: Add codes to make ps-print.el work also on Emacs 20.2 and the earlier version. - (ps-mule-encode-7bit, ps-mule-encode-8bit): Modified for 20.2. + (ps-mule-encode-7bit, ps-mule-encode-8bit): Modify for 20.2. (ccl-encode-ethio-unicode, ps-mule-encode-ethiopic): Likewise. (ps-mule-find-wrappoint): Likewise. (ps-mule-generate-font): Change `X' to `x' in format control-string. @@ -9940,8 +9940,8 @@ New vars. (ps-mule-plot-rule-cmpchar, ps-mule-plot-cmpchar) (ps-mule-prepare-cmpchar-font): New funs. - (ps-mule-bitmap-prologue-generated, ps-mule-bitmap-prologue): New - vars. + (ps-mule-bitmap-prologue-generated, ps-mule-bitmap-prologue): + New vars. (ps-mule-generate-bitmap-prologue, ps-mule-generate-bitmap-font) (ps-mule-generate-bitmap-glyph): New funs. (ps-mule-initialize, ps-mule-begin): New funs. @@ -9963,10 +9963,10 @@ 1998-08-23 Kenichi HANDA <handa@etl.go.jp> - * international/mule-cmds.el (select-message-coding-system): New - function. - (set-language-environment-coding-systems): Set - default-sendmail-coding-system. + * international/mule-cmds.el (select-message-coding-system): + New function. + (set-language-environment-coding-systems): + Set default-sendmail-coding-system. * mail/sendmail.el (sendmail-coding-system): Doc-string modified. (default-sendmail-coding-system): New variable. diff --git a/lisp/ChangeLog.9 b/lisp/ChangeLog.9 index 56cce694704..d56f90ddc91 100644 --- a/lisp/ChangeLog.9 +++ b/lisp/ChangeLog.9 @@ -49,7 +49,7 @@ This avoids a call to eshell-file-attributes, which can be expensive in some situations. - * eshell/em-ls.el (eshell-ls-dired-initial-args): Added an extra + * eshell/em-ls.el (eshell-ls-dired-initial-args): Add an extra customization variable, to differentiate ls-in-dired from regular uses of ls. @@ -404,7 +404,7 @@ tcl-end-of-defun, tcl-submit-bug-report. (tcl-xemacs-menu): Fix up and pass it directly to easymenu. (tcl-add-emacs-menu): Remove. - (tcl-fill-mode-map, tcl-fill-inferior-map): Moved into the defvar. + (tcl-fill-mode-map, tcl-fill-inferior-map): Move into the defvar. (tcl-keyword-list): Add `chain'. (tcl-font-lock-syntactic-keywords): New variable. (tcl-pps-has-arg-6): Remove. @@ -414,14 +414,14 @@ (tcl-mode): Use define-derived-mode. Simplify. Set comment-indent-function. (tcl-indent-command): Use line-beginning-position and comment-indent. - (tcl-calculate-indent): Renamed from calculate-tcl-indent. + (tcl-calculate-indent): Rename from calculate-tcl-indent. (tcl-indent-line): Use tcl-calculate-indent. - (tcl-indent-exp): Renamed from indent-tcl-exp. Use new names. - (tcl-add-log-defun): Renamed from add-log-tcl-defun. Use match-string. + (tcl-indent-exp): Rename from indent-tcl-exp. Use new names. + (tcl-add-log-defun): Rename from add-log-tcl-defun. Use match-string. (tcl-filter): Use with-current-buffer, simplify. (inferior-tcl-mode): Use define-derived-mode. - (tcl-hairy-in-comment): Renamed tcl-in-comment. - (tcl-simple-in-comment, tcl-in-comment): Removed. + (tcl-hairy-in-comment): Rename tcl-in-comment. + (tcl-simple-in-comment, tcl-in-comment): Remove. (tcl-files-alist): New function. (tcl-help-snarf-commands): Use it and return the result directly rather than through a global variable. @@ -493,7 +493,7 @@ (view-lossage): Call `help-setup-xref' instead of doing it manually. * subr.el (symbol-file-load-history-loaded) - (load-symbol-file-load-history, symbol-file): Moved from `help.el'. + (load-symbol-file-load-history, symbol-file): Move from `help.el'. * loadup.el ("button"): Load removed. @@ -556,7 +556,7 @@ * woman.el (woman-mode-map): Copy button-buffer-map instead of making a new keymap. Don't bind mouse-2. Bind M-mouse-2 to `woman-follow-word' instead of `woman-mouse-2'. - (woman-follow-word): Renamed from `woman-mouse-2'. + (woman-follow-word): Rename from `woman-mouse-2'. Follow current unconditionally, since this function is now only bound to M-mouse-2. Use accessor functions. (WoMan-highlight-references): Use `make-text-button'. @@ -912,7 +912,7 @@ * calculator.el (calculator-copy-displayer): New user-option. (calculator-displayer-prev, calculator-displayer-next): - Renamed from calculator-displayed-{left,right}. + Rename from calculator-displayed-{left,right}. (calculator, calculator-standard-displayer) (calculator-num-to-string, calculator-update-display) (calculator-copy, calculator-put-value): Bug and display fixes. @@ -974,8 +974,8 @@ Use make-keymap instead of copy-keymap, since copying the global keymap messes up the menu bar. - * info.el (Info-goto-node, Info-menu): Doc fix. Suggested by - Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>. + * info.el (Info-goto-node, Info-menu): Doc fix. + Suggested by Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>. 2001-09-21 Eli Zaretskii <eliz@is.elta.co.il> @@ -1074,8 +1074,8 @@ * mail/rmail.el (top-level): Require mule-utils when compiling. (rmail-decode-babyl-format): Use detect-coding-with-priority instead of detect-coding-region, to favor detection of emacs-mule - encoded Babyl files written by rmailout.el etc. Suggested by - Kenichi Handa <handa@etl.go.jp>. + encoded Babyl files written by rmailout.el etc. + Suggested by Kenichi Handa <handa@etl.go.jp>. 2001-09-14 Eli Zaretskii <eliz@is.elta.co.il> @@ -1183,7 +1183,7 @@ 2001-09-07 Gerd Moellmann <gerd@gnu.org> * isearch.el (isearch-intersects-p): New function. - (isearch-close-unnecessary-overlays): Renamed from *unecessary*, + (isearch-close-unnecessary-overlays): Rename from *unecessary*, use isearch-intersects-p, and clean up. 2001-09-07 Eli Zaretskii <eliz@is.elta.co.il> @@ -1215,7 +1215,7 @@ * emacs-lisp/edebug.el (edebug-window-live-p): Use get-window-with-predicate. - * window.el (get-window-with-predicate): Renamed from some-window. + * window.el (get-window-with-predicate): Rename from some-window. (some-window): Make it an alias. 2001-09-06 Gerd Moellmann <gerd@gnu.org> @@ -1326,7 +1326,7 @@ 2001-08-31 Gerd Moellmann <gerd@gnu.org> - * isearch.el (isearch-mouse-2): Renamed from isearch-mouse-yank. + * isearch.el (isearch-mouse-2): Rename from isearch-mouse-yank. Instead of running mouse-yank-at-click, see what the event is bound to outside Isearch and run that. @@ -1584,8 +1584,8 @@ 2001-08-20 Gerd Moellmann <gerd@gnu.org> - * textmodes/texnfo-upd.el (texinfo-every-node-update): Remove - some spaces from a message. From Pavel Janík <Pavel@Janik.cz>. + * textmodes/texnfo-upd.el (texinfo-every-node-update): + Remove some spaces from a message. From Pavel Janík <Pavel@Janik.cz>. * whitespace.el (whitespace-global-mode): Add autoload cookie. @@ -1665,7 +1665,7 @@ * Makefile.in (DONTCOMPILE): Remove sc.el. - * Makefile.in (finder_setwins): Renamed from nonobsolete_setwins. + * Makefile.in (finder_setwins): Rename from nonobsolete_setwins. Don't include term/. * mail/sc.el: Moved to obsolete/. @@ -1745,7 +1745,7 @@ * calendar/calendar.el (calendar-mode-line-format): Use make-mode-line-mouse-map instead of make-mode-line-mouse2-map. - * bindings.el (make-mode-line-mouse-map): Renamed from + * bindings.el (make-mode-line-mouse-map): Rename from make-mode-line-mouse2-map. Take additional arg MOUSE. (mode-line-modified): Use mouse-3 instead of mouse-2. (mode-line-buffer-identification-keymap): Bind keys differently. @@ -1842,9 +1842,9 @@ * uniquify.el (uniquify-ref-base, uniquify-ref-filename) (uniquify-ref-buffer, uniquify-ref-proposed): New functions. (uniquify-fix-item-base, uniquify-fix-item-filename) - (uniquify-fix-item-buffer, uniquify-fix-item-proposed): Deleted. + (uniquify-fix-item-buffer, uniquify-fix-item-proposed): Delete. Callers changed. - (uniquify-set-proposed): Changed to work with a vector item. + (uniquify-set-proposed): Change to work with a vector item. (uniquify-rationalize-file-buffer-names): Use a list of arrays for the fix list, and a list of strings for the non-file buffer names. Both changes reduce consing. @@ -1880,7 +1880,7 @@ * uniquify.el: These changes correct a corner case that the old code managed correctly. - (uniquify-fix-item-proposed): Renamed from + (uniquify-fix-item-proposed): Rename from uniquify-fix-item-min-proposed. (uniquify-set-proposed): New function. (uniquify-rationalize-file-buffer-names): Code reshuffled for @@ -1946,7 +1946,7 @@ 2001-07-27 Gerd Moellmann <gerd@gnu.org> * emacs-lisp/lisp-mode.el (last-sexp-setup-props): New function. - (last-sexp-toggle-display): Renamed from last-sexp-print. + (last-sexp-toggle-display): Rename from last-sexp-print. (last-sexp-toggle-display, eval-last-sexp-1): Use last-sexp-setup-props. @@ -1978,8 +1978,8 @@ * emacs-lisp/lisp-mode.el (eval-print-last-sexp, eval-defun): Mention the effect of eval-expression-print-length and - eval-expression-print-level in the doc strings. Suggested by - Kevin Gallagher <kevingal@onramp.net>. + eval-expression-print-level in the doc strings. + Suggested by Kevin Gallagher <kevingal@onramp.net>. 2001-07-25 Gerd Moellmann <gerd@gnu.org> @@ -2013,7 +2013,7 @@ * uniquify.el: Overall speedup changes when using many buffers. (uniquify-fix-item-base, uniquify-fix-item-filename) - (uniquify-fix-item-buffer): Changed defmacro to defalias (cosmetic). + (uniquify-fix-item-buffer): Change defmacro to defalias (cosmetic). (uniquify-fix-item-unrationalized-buffer): Deleted: was the fourth place in the item, but was never used. (uniquify-fix-item-min-proposed): New defalias: the fourth place @@ -2026,7 +2026,7 @@ of buffer whose name was changed, but that return value was never used. (uniquify-item-lessp): Replaces uniquify-filename-lessp, works on the cached proposed name, does much less consing and is quicker. - (uniquify-filename-lessp): Deleted. + (uniquify-filename-lessp): Delete. (uniquify-rationalize-a-list): Use dolist (cosmetic change). Do not bind locally the uniquify-possibly-resolvable flag. Use the cached proposed name is possible. @@ -2075,7 +2075,7 @@ with-syntax-table. (ediff-coding-system-for-read): From ediff-diff.el. (ediff-coding-system-for-write): New variable. - (ediff-highest-priority): Fixed the bug having to do with disappearing + (ediff-highest-priority): Fix the bug having to do with disappearing overlays. (ediff-file-remote-p): Use file-remote-p, if available. (ediff-listable-file): New function. @@ -2088,8 +2088,8 @@ Use ediff-coding-system-for-read. (ediff-patch-file-internal): Use ediff-coding-system-for-write. - * ediff-diff.el (ediff-coding-system-for-read): Moved to ediff-init.el. - (ediff-match-diff3-line, ediff-get-diff3-group): Improved pattern. + * ediff-diff.el (ediff-coding-system-for-read): Move to ediff-init.el. + (ediff-match-diff3-line, ediff-get-diff3-group): Improve pattern. * ediff.el: Date of last update, copyright years. @@ -2099,8 +2099,8 @@ of Scott Bronson. (ex-cmd-assoc, ex-compile, ex-cmd-one-letr): New functions. (viper-check-sub, viper-get-ex-command, viper-execute-ex-command): - Deleted functions. - (viper-get-ex-com-subr, viper-ex, ex-mark): Changed to use the new + Delete functions. + (viper-get-ex-com-subr, viper-ex, ex-mark): Change to use the new ex-token-list. (viper-get-ex-address-subr): Convert registers to char data type. @@ -2111,7 +2111,7 @@ (viper-read-key): Use viper-read-key-sequence. * viper.el (viper-major-mode-modifier-list): - Added inferior-emacs-lisp-mode. + Add inferior-emacs-lisp-mode. (this-major-mode-requires-vi-state): New function that uses simple heuristics to decide if vi state is appropriate. (set-viper-state-in-major-mode): Use this-major-mode-requires-vi-state. @@ -2212,9 +2212,9 @@ * progmodes/tcl.el (tcl-fill-mode-map): Use tcl-indent-exp. (tcl-mode): Use tcl-add-log-defun. (tcl-indent-line): Use tcl-calculate-indent. - (tcl-calculate-indent): Renamed from calculate-tcl-indent. - (tcl-indent-exp): Renamed from indent-tcl-exp. - (tcl-add-log-defun): Renamed from add-log-tcl-defun. + (tcl-calculate-indent): Rename from calculate-tcl-indent. + (tcl-indent-exp): Rename from indent-tcl-exp. + (tcl-add-log-defun): Rename from add-log-tcl-defun. (tcl-indent-for-comment): Call comment-indent-function properly and handle the case where it returns nil. @@ -2251,7 +2251,7 @@ * mouse-sel.el (mouse-sel-bindings): Instead of unbinding mouse-1 etc., bind them to `ignore'. - * eshell/esh-mode.el (eshell-send-invisible): Renamed from + * eshell/esh-mode.el (eshell-send-invisible): Rename from send-invisible, which is already defined in Comint. (eshell-watch-for-password-prompt): Use it. @@ -2518,11 +2518,11 @@ 2001-07-11 Stefan Monnier <monnier@cs.yale.edu> - * vc.el (vc-prefix-map): Moved back to vc-hooks.el. + * vc.el (vc-prefix-map): Move back to vc-hooks.el. (vc-dired-mode-map): Fix the madness. * vc-hooks.el (vc-mode): Dummy function for doc purposes. - (vc-prefix-map): Moved back from vc.el. + (vc-prefix-map): Move back from vc.el. 2001-07-11 Gerd Moellmann <gerd@gnu.org> @@ -2554,7 +2554,7 @@ * startup.el (normal-top-level): Don't operate on the initial frame if we failed to create one. -2001-07-10 Martin Stjernholm <bug-cc-mode@gnu.org> +2001-07-10 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-indent-exp): Keep the indentation of the block itself, i.e. only indent the contents in it. @@ -2586,7 +2586,7 @@ * toolbar/*.pbm: Cleaned up. From Luis Fernandes <elf@ee.ryerson.ca>. -2001-07-09 Martin Stjernholm <bug-cc-mode@gnu.org> +2001-07-09 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el: Extended the kludge to interoperate with the delsel and pending-del packages wrt to the new function @@ -3115,7 +3115,7 @@ 2001-05-28 Miles Bader <miles@gnu.org> - * comint.el (comint-carriage-motion): Renamed from + * comint.el (comint-carriage-motion): Rename from `comint-cr-magic'. Operate on the buffer instead of the string (for use as a comint post-output filter, instead of as a pre-output filter). Handle backspaces too. Add to the @@ -3226,7 +3226,7 @@ 2001-05-21 Stefan Monnier <monnier@cs.yale.edu> * diff-mode.el (diff-jump-to-old-file, diff-update-on-the-fly): - Renamed by removing the silly `-flag' suffix. + Rename by removing the silly `-flag' suffix. (diff-mode, diff-minor-mode, diff-find-source-location): Update. 2001-05-20 Stefan Monnier <monnier@cs.yale.edu> @@ -3313,7 +3313,7 @@ 2001-05-18 Simon Josefsson <simon@josefsson.org> - * mail/smtpmail.el (maybe-append-domain): Renamed to + * mail/smtpmail.el (maybe-append-domain): Rename to `smtpmail-maybe-append-domain'. (smtpmail-via-smtp): Use the new name. @@ -3501,13 +3501,13 @@ 2001-05-08 John Wiegley <johnw@gnu.org> * calendar/timeclock.el (timeclock-workday-remaining): - Changed logic for determining how much time is remaining. + Change logic for determining how much time is remaining. (timeclock-workday-elapsed): Don't accept a "relative" argument for the current day's elapsed time. What could that have meant? (timeclock-workday-elapsed-string): No "relative" argument anymore. - (timeclock-when-to-leave): Changed logic, similarly to what was + (timeclock-when-to-leave): Change logic, similarly to what was done for `timeclock-workday-remaining'. - (timeclock-find-discrep): Removed "today-only" argument, which had + (timeclock-find-discrep): Remove "today-only" argument, which had no meaning. Fixed some more math problems. The function now returns a three member list: (TOTAL-TIME-DISCREPANCY TODAYS-TIME-DISCREPANCY TODAYS-ELAPSED-TIME). @@ -3601,10 +3601,10 @@ * mail/rmail.el (rmail-mode-map): Use rmail-sort-by-labels instead of rmail-sort-by-keywords. - * mail/rmailsort.el (rmail-sort-by-labels): Renamed from + * mail/rmailsort.el (rmail-sort-by-labels): Rename from rmail-sort-by-keywords. - * mail/rmailsum.el (rmail-summary-sort-by-labels): Renamed from + * mail/rmailsum.el (rmail-summary-sort-by-labels): Rename from rmail-summary-sort-by-keywords. Doc fix. (rmail-summary-mode): Doc fix. @@ -3626,15 +3626,15 @@ * progmodes/cperl-mode.el (cperl-font-lock-keywords) (cperl-font-lock-keywords-1, cperl-font-lock-keywords-2): - Renamed from perl-font-lock-keywords to avoid clashes. + Rename from perl-font-lock-keywords to avoid clashes. (cperl-mode, cperl-load-font-lock-keywords, cperl-init-faces) (cperl-load-font-lock-keywords-1, cperl-load-font-lock-keywords-2): - Updated correspondingly. + Update correspondingly. * diff-mode.el (diff-nonexistent-face, diff-font-lock-keywords): Typo `nonexistant' -> `nonexistent'. -2001-05-04 Martin Stjernholm <bug-cc-mode@gnu.org> +2001-05-04 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-electric-delete, c-electric-delete-forward): Split `c-electric-delete' into two functions where @@ -3644,7 +3644,7 @@ * progmodes/cc-mode.el: `c-electric-delete-forward' is now bound to C-d to get the electric behavior on that key too. - (c-fill-paragraph): Fixed bogus direct use of + (c-fill-paragraph): Fix bogus direct use of c-comment-prefix-regexp, which caused an error when it's a list. 2001-05-03 Eli Zaretskii <eliz@is.elta.co.il> @@ -3785,7 +3785,7 @@ 2001-04-23 John Wiegley <johnw@gnu.org> - * eshell/em-unix.el (eshell/diff): Fixed problems that were + * eshell/em-unix.el (eshell/diff): Fix problems that were occurring with Emacs 21's diff.el/compile.el interaction layer. 2001-04-23 Colin Walters <walters@cis.ohio-state.edu> @@ -3796,28 +3796,28 @@ 2001-04-23 John Wiegley <johnw@gnu.org> - * eshell/em-smart.el (eshell-smart-redisplay): Added some safety + * eshell/em-smart.el (eshell-smart-redisplay): Add some safety code to work around a redisplay problem I've been having. 2001-04-23 John Wiegley <johnw@gnu.org> * calendar/timeclock.el (timeclock-day-required): If the time required for a particular day is not set, use `timeclock-workday'. - (timeclock-find-discrep): Added some sample code in a comment. + (timeclock-find-discrep): Add some sample code in a comment. * eshell/eshell.el (eshell-command): Made a few changes so that `eshell-command' could be called programmatically. - * eshell/esh-mode.el (eshell-non-interactive-p): Moved to eshell.el. + * eshell/esh-mode.el (eshell-non-interactive-p): Move to eshell.el. - * eshell/eshell.el (eshell-non-interactive-p): Moved from esh-mode.el. + * eshell/eshell.el (eshell-non-interactive-p): Move from esh-mode.el. 2001-04-23 John Wiegley <johnw@gnu.org> * calendar/timeclock.el: Updated copyright. (timeclock-generate-report): Don't report the daily or two-week total, if no time has been worked in that period. - (timeclock-find-discrep): Moved call to `file-readable-p'; removed + (timeclock-find-discrep): Move call to `file-readable-p'; removed final computational form, which was unnecessary; corrected a parsing problem when timeclock-relative was nil. @@ -3876,7 +3876,7 @@ 2001-04-20 Alex Schroeder <alex@gnu.org> - * sql.el (sql-mode-menu): Added highlighting entries. + * sql.el (sql-mode-menu): Add highlighting entries. (sql-highlight-oracle-keywords): New function. (sql-highlight-postgres-keywords): New function. (sql-highlight-ansi-keywords): New function. @@ -3887,7 +3887,7 @@ 2001-04-19 Karl Fogel <kfogel@collab.net> - * saveplace.el (save-place-alist-to-file): Removed no-effect code + * saveplace.el (save-place-alist-to-file): Remove no-effect code that inserted file content only to delete it immediately. Probably a cut-and-paste bug. Thanks to Juanma Barranquero <lektu@terra.es> for the patch. @@ -3914,7 +3914,7 @@ * language/slovak.el ("Slovak"): Add tutorial entry. - * net/browse-url.el (browse-url-new-window-flag): Renamed from + * net/browse-url.el (browse-url-new-window-flag): Rename from browse-url-new-window-p. 2001-04-17 Eli Zaretskii <eliz@is.elta.co.il> @@ -3933,13 +3933,13 @@ 2001-04-17 Eli Zaretskii <eliz@is.elta.co.il> * vc-cvs.el (vc-cvs-print-log, vc-cvs-diff): Don't invoke CVS as - an async subprocess if start-process is unavailable. Suggested by - Tim Van Holder <tim.van.holder@pandora.be>. + an async subprocess if start-process is unavailable. + Suggested by Tim Van Holder <tim.van.holder@pandora.be>. 2001-04-15 Eli Zaretskii <eliz@is.elta.co.il> - * info.el (Info-additional-directory-list): Doc fix. Suggested by - Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>. + * info.el (Info-additional-directory-list): Doc fix. + Suggested by Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>. 2001-04-14 Eli Zaretskii <eliz@is.elta.co.il> @@ -4053,7 +4053,7 @@ 2001-04-10 John Wiegley <johnw@gnu.org> - * calendar/timeclock.el (timeclock-generate-report): Added a + * calendar/timeclock.el (timeclock-generate-report): Add a missing insert of the project name. 2001-04-09 Gerd Moellmann <gerd@gnu.org> @@ -4445,37 +4445,37 @@ * mail/sendmail.el (sendmail-send-it): Don't parse Resent-* headers. Always invoke sendmail with option -t. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> * Release of cc-mode 5.28. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-mode.el, progmodes/cc-vars.el (c-common-init) (c-default-style): - Removed the hardcoded switch to "java" style in Java mode. + Remove the hardcoded switch to "java" style in Java mode. It's instead taken care of by the default value for c-default-style. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-align.el (c-lineup-math): Fix bug where lineup was triggered by equal signs in string literals. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-cmds.el (c-fill-paragraph): Fixed bug in the paragraph + * progmodes/cc-cmds.el (c-fill-paragraph): Fix bug in the paragraph limit detection when at the ends of the buffer. - * progmodes/cc-engine.el (c-guess-basic-syntax): Removed bogus check for + * progmodes/cc-engine.el (c-guess-basic-syntax): Remove bogus check for "for" statement clause in case 7F; a better one is done earlier in case 7D anyway. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-cmds.el (c-guess-fill-prefix): Improved the heuristics + * progmodes/cc-cmds.el (c-guess-fill-prefix): Improve the heuristics somewhat more and did a small optimization. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-beginning-of-statement, c-end-of-statement): Use the limit argument only to limit the syntactic context @@ -4486,7 +4486,7 @@ fixes to the paragraph and comment prefix recognition, block comment ender handling etc. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-fill-paragraph): Take more care to preserve the relative position of the point. @@ -4505,12 +4505,12 @@ this doesn't apply to idl-mode, since IDL afaik doesn't have statements at all.) -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-inside-bracelist-p): Fix for handling bracelists where the declaration contains template arguments. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-comment-indent): Use `c-get-syntactic-indentation' to correctly calculate the @@ -4521,10 +4521,10 @@ indentation sum calculation from `c-indent-line' to a separate function. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-beginning-of-statement, c-comment-indent): - Fixed places where it was assumed that preprocessor directives + Fix places where it was assumed that preprocessor directives have to start in column zero. * progmodes/cc-engine.el (c-beginning-of-member-init-list): Handle C++ @@ -4536,7 +4536,7 @@ they'll get indented consistently with the same type of expression in a normal block. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-fill-paragraph): The kludge that checks whether the adaptive filling package fails to keep the comment @@ -4548,18 +4548,18 @@ * progmodes/cc-cmds.el (c-fill-paragraph): Made the way the paragraph around point is recognized more robust. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el, progmodes/cc-engine.el: * progmodes/cc-lobotomy.el (c-state-cache) (c-in-literal-cache, c-auto-fill-prefix, c-lit-limits) - (c-lit-type): Fixed all internal variables used dynamically so + (c-lit-type): Fix all internal variables used dynamically so that they are always bound. * progmodes/cc-cmds.el, progmodes/cc-engine.el: Improve recovery of syntactic errors: - (c-indent-region): Fixed reporting of syntactic errors so that + (c-indent-region): Fix reporting of syntactic errors so that the region is fully reindented even when an error occurs. The last syntactic error is printed afterwards. Also cleanup up a whole lot of code that tried to optimize indentation of whole @@ -4567,7 +4567,7 @@ (c-indent-sexp): Use c-indent-region. - (c-parsing-error): Changed this variable to hold the message + (c-parsing-error): Change this variable to hold the message for any syntactic error that is discovered. (c-parse-state): Search backward from point instead of the bod @@ -4578,16 +4578,16 @@ dangling "else" clauses instead of throwing an error, and fall back to a reasonable position. - (c-indent-line): Added argument to avoid reporting syntactic errors. + (c-indent-line): Add argument to avoid reporting syntactic errors. (c-show-syntactic-information): Don't report any syntactic errors. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-cmds.el (c-beginning-of-statement): Fixed bugs with + * progmodes/cc-cmds.el (c-beginning-of-statement): Fix bugs with paragraph recognition when moving by sentence in literals. - * progmodes/cc-langs.el (c-Java-javadoc-paragraph-start): Modified + * progmodes/cc-langs.el (c-Java-javadoc-paragraph-start): Modify paragraph start regexp for javadoc to recognize javadoc markup in general instead of a specific set of keywords, to be more future-safe. @@ -4610,24 +4610,24 @@ (c-current-comment-prefix): New variable containing the actual regexp from c-comment-prefix-regexp for the current buffer. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-cmds.el (c-electric-brace): Fixed check for special brace + * progmodes/cc-cmds.el (c-electric-brace): Fix check for special brace lists: We can't look at the syntax, since a brace list can get recognized as a plain statement-cont. - * progmodes/cc-engine.el (c-guess-basic-syntax): Fixed bug where a + * progmodes/cc-engine.el (c-guess-basic-syntax): Fix bug where a special brace list opener broken over two lines got recognized as a statement on the second line. Case 9A changed. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-cmds.el (c-electric-brace): Fixed bug in c-state-cache + * progmodes/cc-cmds.el (c-electric-brace): Fix bug in c-state-cache adjustment after line is reindented. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-defs.el (c-point): Added optional argument for position + * progmodes/cc-defs.el (c-point): Add optional argument for position to use instead of the current point. * progmodes/cc-defs.el, progmodes/cc-engine.el (c-add-class-syntax): @@ -4635,7 +4635,7 @@ starts at boi, to avoid the extra level of indentation in that case. Cases 4, 16A and 17E affected. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el: Use `indent-according-to-mode' instead of direct calls to `c-indent-line', to adhere better to Emacs conventions. @@ -4643,17 +4643,17 @@ * progmodes/cc-engine.el (c-indent-line): Use the syntax already bound to `c-syntactic-context', if there is any. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-engine.el (c-get-offset): Fixed bug where the indentation + * progmodes/cc-engine.el (c-get-offset): Fix bug where the indentation wasn't added up correctly when a lineup function returned nil. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-engine.el (c-collect-line-comments): Fixed bug where + * progmodes/cc-engine.el (c-collect-line-comments): Fix bug where empty lines were ignored when collecting line comments backwards. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-align.el (c-lineup-dont-change): Return an absolute indentation column to work correctly in the case when several @@ -4662,17 +4662,17 @@ * progmodes/cc-engine.el, progmodes/cc-styles.el: * progmodes/cc-vars.el (c-evaluate-offset) (c-get-offset, c-indent-line, c-valid-offset, c-read-offset) - (c-set-offset): Added absolute indentation column settings by + (c-set-offset): Add absolute indentation column settings by using the vector type. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el, progmodes/cc-vars.el (c-electric-paren, c-cleanup-list): Implemented two new cleanups `space-before-funcall' and `compact-empty-funcall'. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-defs.el (c-paren-re, c-identifier-re): Two new macros for helping building regexps. @@ -4684,32 +4684,32 @@ complete keyword lists. `c-keywords' is set to a regexp matching all keywords in the current language. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-engine.el (c-beginning-of-statement-1): Added '#' to the + * progmodes/cc-engine.el (c-beginning-of-statement-1): Add '#' to the list of characters to skip backwards over at the beginning of a statement, since it can precede string literals in Pike. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-cmds.el (c-guess-fill-prefix): Fixed bug with prefix + * progmodes/cc-cmds.el (c-guess-fill-prefix): Fix bug with prefix recognition when standing on the last line in a C++ comment with nothing but whitespace after the prefix. - * progmodes/cc-engine.el (c-backward-to-start-of-if): Fixed bug when + * progmodes/cc-engine.el (c-backward-to-start-of-if): Fix bug when given no limit argument. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-engine.el (c-inside-bracelist-p): Fixed brace list + * progmodes/cc-engine.el (c-inside-bracelist-p): Fix brace list recognition for the `[]= operator symbol in Pike. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-bytecomp.el (cc-eval-when-compile): New macro that works around a bug in `eval-when-compile' in the byte compiler. - * progmodes/cc-engine.el (c-forward-token-1): Fixed bug with return + * progmodes/cc-engine.el (c-forward-token-1): Fix bug with return value when count is zero and there's no token start within the limit. (c-guess-basic-syntax): Don't add 'comment-intro to lines with @@ -4719,12 +4719,12 @@ * progmodes/cc-mode-19.el: Fixes so that checks that must be done at compile time also are done then. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-defs.el: Make sure cc-mode-19 is loaded both at compile time and at runtime, and only when it's needed. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> Major cleanup for less error prone and more warning free compilation, including some fixes for bugs due to different @@ -4757,7 +4757,7 @@ README: Updated installation instructions. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el, progmodes/cc-langs.el, progmodes/cc-mode.el: Moved around things to improve the modularity: @@ -4766,11 +4766,11 @@ the various variables for configuring the language syntax. * progmodes/cc-engine.el, progmodes/cc-styles.el (c-evaluate-offset) - (c-get-offset): Moved from cc-styles to cc-engine since file + (c-get-offset): Move from cc-styles to cc-engine since file dependency analysis suggests they belong there (which also makes more sense). Thanks to Martin Buchholz for doing the analysis. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-fn-region-is-active-p): New function that wraps the corresponding macro, for use in places that aren't @@ -4781,19 +4781,19 @@ * progmodes/cc-mode.el (c-prepare-bug-report-hooks): Hook variable to add things to the bug report. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-cmds.el (c-guess-fill-prefix): Fixed bug where the + * progmodes/cc-cmds.el (c-guess-fill-prefix): Fix bug where the returned prefix could contain a newline when the search for a good prefix line failed. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-toggle-auto-state, c-toggle-hungry-state) (c-toggle-auto-hungry-state): Made the argument optional, as the documentation says it is. -2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-03-21 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-guess-basic-syntax): Don't treat the Pike multiline string syntax, #"...", as a cpp macro. @@ -4871,8 +4871,8 @@ of Scott Bronson. (ex-cmd-assoc, ex-cmd-one-letr): New functions. (viper-check-sub, viper-get-ex-command, viper-execute-ex-command): - Deleted functions. - (viper-get-ex-com-subr, viper-ex, ex-mark): Changed to use the new + Delete functions. + (viper-get-ex-com-subr, viper-ex, ex-mark): Change to use the new ex-token-list. * viper-util.el: Spaces, indentation. @@ -4886,9 +4886,9 @@ 2001-03-16 John Wiegley <johnw@gnu.org> - * calendar/timeclock.el (timeclock-reread-log): Fixed problem with + * calendar/timeclock.el (timeclock-reread-log): Fix problem with first-time checkins. - (timeclock-log-data): Fixed problem with reading timelog log file. + (timeclock-log-data): Fix problem with reading timelog log file. Resulting data in the "day list" was incorrect. (timeclock-find-discrep): Check if `timeclock-file' is readable before opening it. @@ -5023,7 +5023,7 @@ 2001-03-09 Gerd Moellmann <gerd@gnu.org> - * help.el (string-key-binding): Renamed from + * help.el (string-key-binding): Rename from mode-line-key-binding. Handle any event on a string. Check for `keymap' properties as well as `local-map' properties. @@ -5074,7 +5074,7 @@ 2001-03-07 Stefan Monnier <monnier@cs.yale.edu> * log-edit.el (log-edit-common-indent): New var. - (log-edit-set-common-indentation): Renamed from + (log-edit-set-common-indentation): Rename from log-edit-delete-common-indentation. Use the new var. (log-edit-insert-changelog, log-edit-done-hook): Use the new name. @@ -5405,8 +5405,8 @@ * startup.el (fancy-splash-screens): Use display-hourglass instead of display-busy-cursor. - * frame.el (display-hourglass): Renamed from busy-cursor. - (hourglass-delay): Renamed from busy-cursor-delay-seconds. + * frame.el (display-hourglass): Rename from busy-cursor. + (hourglass-delay): Rename from busy-cursor-delay-seconds. (show-cursor-in-non-selected-windows): Doc fix. 2001-02-20 Dave Love <fx@gnu.org> @@ -5557,9 +5557,9 @@ 2001-02-12 Michael Kifer <kifer@cs.sunysb.edu> - * ediff-diff.el (ediff-make-diff2-buffer): Removed bogus checks + * ediff-diff.el (ediff-make-diff2-buffer): Remove bogus checks for remote files. - (ediff-coding-system-for-read): Replaced the no-conversion default + (ediff-coding-system-for-read): Replace the no-conversion default with raw-text. * ediff-init.el: Removed :version from defcustom vars. @@ -5720,7 +5720,7 @@ 2001-02-06 Gerd Moellmann <gerd@gnu.org> - * dabbrev.el (dabbrev-ignored-buffer-regexps): Renamed from + * dabbrev.el (dabbrev-ignored-buffer-regexps): Rename from dabbrev-ignored-regexps. 2001-02-06 Eli Zaretskii <eliz@is.elta.co.il> @@ -6061,14 +6061,14 @@ 2001-01-25 John Wiegley <johnw@gnu.org> - * eshell/esh-util.el (eshell-ange-ls-uids): Changed use of `alist' + * eshell/esh-util.el (eshell-ange-ls-uids): Change use of `alist' to `repeat' in the :type field. - * pcomplete.el (pcomplete-file-ignore): Changed a :type field to + * pcomplete.el (pcomplete-file-ignore): Change a :type field to allow a choice of regexp or nil. (pcomplete-dir-ignore): Same. - * eshell/em-unix.el (eshell/occur): Fixed bug causing `occur' (as + * eshell/em-unix.el (eshell/occur): Fix bug causing `occur' (as a command) to always fail. 2001-01-25 Gerd Moellmann <gerd@gnu.org> @@ -6117,14 +6117,14 @@ 2001-01-24 Sam Steingold <sds@gnu.org> - * dired.el (dired-replace-in-string): Removed. + * dired.el (dired-replace-in-string): Remove. (dired-sort-toggle): Use `replace-regexps-in-string' instead of `dired-replace-in-string'. * dired-aux.el (dired-shell-stuff-it, dired-rename-subdir) (dired-rename-subdir-2, dired-insert-subdir-doinsert): Ditto. - * gs.el (gs-replace-in-string): Removed. + * gs.el (gs-replace-in-string): Remove. (gs-options): Use `replace-regexps-in-string' instead of `gs-replace-in-string'. @@ -6248,7 +6248,7 @@ 2001-01-19 Michael Kifer <kifer@cs.sunysb.edu> - * ediff-hook.el (ediff-xemacs-init-menus): Fixed add-menu-button. + * ediff-hook.el (ediff-xemacs-init-menus): Fix add-menu-button. * ediff-init.el (subst-char-in-string): Define and use it, unless it's already defined. @@ -6309,7 +6309,7 @@ overlay priorities should make it unnecessary, right? (isearch-highlight): Face suppressing behavior removed. (isearch-dehighlight): Face suppressing behavior removed. - (isearch-set-lazy-highlight-faces-at): Removed. + (isearch-set-lazy-highlight-faces-at): Remove. 2001-01-17 Kenichi Handa <handa@etl.go.jp> @@ -6546,19 +6546,19 @@ 2000-01-09 Alex Schroeder <alex@gnu.org> - * ansi-color.el (ansi-color-process): Removed, Emacs and XEmacs + * ansi-color.el (ansi-color-process): Remove, Emacs and XEmacs both use ansi-color-process-output, now. (ansi-color-process-output): Doesn't return string anymore. It is installed in comint-output-filter-functions for both Emacs and XEmacs, now. - (ansi-color-unfontify-region): Simplified code removing variables + (ansi-color-unfontify-region): Simplify code removing variables pos and start-ansi. (ansi-color-apply): Put text-property ansi-color before putting text-property face because ansi-color-unfontify-region is called immediately after the call to put-text-property. (ansi-color-context-region): Doc change. - (ansi-color-filter-region): Simplified code. - (ansi-color-apply-on-region): Changed start to start-marker, using + (ansi-color-filter-region): Simplify code. + (ansi-color-apply-on-region): Change start to start-marker, using a marker explicitly. Put text-property ansi-color before putting text-property face because ansi-color-unfontify-region is called immediately after the call to put-text-property. @@ -6566,15 +6566,15 @@ 2000-01-09 Alex Schroeder <alex@gnu.org> * ansi-color.el (ansi-color-faces-vector): Doc change. - (ansi-color-for-comint-mode): Changed :type property to choice. - (ansi-color-last-context): Removed. + (ansi-color-for-comint-mode): Change :type property to choice. + (ansi-color-last-context): Remove. (ansi-color-process-output): Don't use ansi-color-last-context, as the main functions will store their context now. (ansi-color-context): Doc change. (ansi-color-filter-apply): Rewrote it based on ansi-color-apply. Uses ansi-color-context such that repeated calls will strip partial escape sequences, too. - (ansi-color-apply): Simplified code. Colorize end of string if + (ansi-color-apply): Simplify code. Colorize end of string if face is not null. Store context in new (FACE STRING) format, such that repeated calls will strip partial escape sequences, too. Append faces to face property using ansi-color-apply-sequence such @@ -6583,7 +6583,7 @@ (ansi-color-filter-region): Rewrote it based on ansi-color-apply-on-region. Uses ansi-color-context-region such that repeated calls will strip partial escape sequences, too. - (ansi-color-apply-on-region): Simplified code. Colorize end of + (ansi-color-apply-on-region): Simplify code. Colorize end of region if face is not null. Store context in new (FACE POS) format, such that repeated calls will strip partial escape sequences, too. Append faces to face property using @@ -6644,8 +6644,8 @@ decide what to do. This function is added to comint-preoutput-filter-functions when the package is loaded. - (ansi-color-for-shell-mode-set): Removed. - (ansi-color-for-shell-mode): Removed. + (ansi-color-for-shell-mode-set): Remove. + (ansi-color-for-shell-mode): Remove. 2000-01-09 Alex Schroeder <alex@gnu.org> @@ -6696,14 +6696,14 @@ * vc.el (vc-default-latest-on-branch-p): New function, replaces constant implementations in backends. - * vc-cvs.el (vc-cvs-latest-on-branch-p): Removed. - (vc-cvs-checkout): Renamed arg WRITABLE to EDITABLE. + * vc-cvs.el (vc-cvs-latest-on-branch-p): Remove. + (vc-cvs-checkout): Rename arg WRITABLE to EDITABLE. - * vc-rcs.el (vc-rcs-checkout, vc-rcs-cancel-version): Renamed arg + * vc-rcs.el (vc-rcs-checkout, vc-rcs-cancel-version): Rename arg WRITABLE to EDITABLE. - * vc-sccs.el (vc-sccs-latest-on-branch-p): Removed. - (vc-sccs-checkout, vc-sccs-cancel-version): Renamed arg WRITABLE + * vc-sccs.el (vc-sccs-latest-on-branch-p): Remove. + (vc-sccs-checkout, vc-sccs-cancel-version): Rename arg WRITABLE to EDITABLE. 2001-01-08 Eli Zaretskii <eliz@is.elta.co.il> @@ -6713,7 +6713,7 @@ 2001-01-08 Gerd Moellmann <gerd@gnu.org> - * isearch.el (isearch-old-signal-hook): Removed. + * isearch.el (isearch-old-signal-hook): Remove. (isearch-mode): Add isearch-done to kbd-macro-termination-hook instead of setting signal-hook-function. (isearch-done): Remove isearch-done from kbd-macro-termination-hook. @@ -6791,7 +6791,7 @@ 2001-01-04 Gerd Moellmann <gerd@gnu.org> * tooltip.el (tooltip-cancel-delayed-tip) - (tooltip-start-delayed-tip): Renamed from tooltip-disable-timeout + (tooltip-start-delayed-tip): Rename from tooltip-disable-timeout and tooltip-add-timeout. (tooltip-show): Set border color from faces's foreground. (tooltip-show-help-function): If called with the same help string @@ -6825,8 +6825,8 @@ (dired-guess-shell-alist-default): Don't use xloadimage for PNG. (dired-guess-shell-alist-user): Customize. (dired-x-help-address): Set to bug-gnu-emacs. - (dired-x-maintainer, dired-x-file, dired-x-version): Deleted. - (dired-default-directory): Renamed from default-directory. + (dired-x-maintainer, dired-x-file, dired-x-version): Delete. + (dired-default-directory): Rename from default-directory. * hl-line.el (hl-line): Doc fix. @@ -6917,7 +6917,7 @@ * international/fontset.el (x-complement-fontset-spec): Resolve ASCII font name so that the same family name is used for fonts registered in x-font-name-charset-alist. - (create-fontset-from-fontset-spec): Adjusted for the above change. + (create-fontset-from-fontset-spec): Adjust for the above change. The name of fontset alias should be a unresolved ASCII font name. 2000-12-28 Gerd Moellmann <gerd@gnu.org> @@ -6932,13 +6932,13 @@ 2000-12-28 Kenichi Handa <handa@etl.go.jp> - * textmodes/artist.el (artist-butlast): Deleted. + * textmodes/artist.el (artist-butlast): Delete. (artist-ellipse-mirror-quadrant): Use butlast instead of artist-butlast. - * subr.el (butlast, nbutlast): Moved from cl.el to here. + * subr.el (butlast, nbutlast): Move from cl.el to here. - * emacs-lisp/cl.el (butlast, nbutlast): Moved to subr.el. + * emacs-lisp/cl.el (butlast, nbutlast): Move to subr.el. 2000-12-27 Eli Zaretskii <eliz@is.elta.co.il> @@ -6987,13 +6987,13 @@ 2000-12-25 Michael Kifer <kifer@cs.sunysb.edu> - * viper-init.el (viper-restore-cursor-type): Added condition-case guard. + * viper-init.el (viper-restore-cursor-type): Add condition-case guard. * ediff-init.el (ediff-quit-hook, ediff-suspend-hook): - Changed initialization; use add-hook. + Change initialization; use add-hook. (ediff-file-remote-p): Use file-local-copy. - * ediff-ptch.el (ediff-prompt-for-patch-buffer): Improved defaults. + * ediff-ptch.el (ediff-prompt-for-patch-buffer): Improve defaults. * ediff.el (ediff-patch-buffer): Bug fix. (ediff-revision): Allow selection of the file at the prompt. @@ -7037,7 +7037,7 @@ 2000-08-22 Emmanuel Briot <briot@gnat.com> - * xml.el (top level comment): Updated to reflect the fact that + * xml.el (top level comment): Update to reflect the fact that white spaces are relevant in the XML file. (xml-parse-file): Do not kill an existing Emacs buffer if the file to parse was already edited. This allows for on-the-fly analysis @@ -7158,7 +7158,7 @@ * progmodes/idlwave.el: Fixed copyright notice. - * textmodes/reftex-dcr.el (reftex-view-crossref): Added SPACE and + * textmodes/reftex-dcr.el (reftex-view-crossref): Add SPACE and TAB as key separators. 2000-12-19 Alex Schroeder <alex@gnu.org> @@ -7166,7 +7166,7 @@ * sql.el (sql-sybase-options): New option. (sql-sybase): Use it. Add sql-database to the list of parameters provided for login. The options -w 2048 -n are not used any more. - (sql-postgres-options): Changed default from "--pset" to "-P". + (sql-postgres-options): Change default from "--pset" to "-P". (sql-mysql-options): Doc change. (sql-stop): Doc change. @@ -7190,7 +7190,7 @@ 2000-12-18 Dave Love <fx@gnu.org> * simple.el (mail-user-agent): Doc fix. - (input-mode-8-bit): Removed. + (input-mode-8-bit): Remove. * international/mule.el (set-keyboard-coding-system): Doc fix. (keyboard-coding-system): New option. @@ -7373,12 +7373,12 @@ * international/characters.el: Fix cases and syntaxes for mule-unicode-0100-24ff. - * dired.el (dired-move-to-filename-regexp): Fixed for the case + * dired.el (dired-move-to-filename-regexp): Fix for the case that a Japanese character is not appended after day and year. * info.el (Info-suffix-list): Change format for a command that requires arguments. - (info-insert-file-contents): Adjusted for the above change. + (info-insert-file-contents): Adjust for the above change. 2000-12-12 Andreas Schwab <schwab@suse.de> @@ -7482,7 +7482,7 @@ * textmodes/reftex.el (reftex-scanning-info-available-p): New function. (reftex-TeX-master-file): Check for `tex-main-file' early enough. - * textmodes/reftex-global.el (reftex-create-tags-file): Fixed bug + * textmodes/reftex-global.el (reftex-create-tags-file): Fix bug when master file is not open. 2000-12-09 Stefan Monnier <monnier@cs.yale.edu> @@ -7670,12 +7670,12 @@ 2000-12-05 Rob Riepel <riepel@Stanford.EDU> - * emulation/tpu-edt.el (tpu-help): Fixed previous screen logic. - (tpu-search-highlight): Fixed comparison of overlay end positions. + * emulation/tpu-edt.el (tpu-help): Fix previous screen logic. + (tpu-search-highlight): Fix comparison of overlay end positions. (tpu-trim-line-ends): Implemented trimming logic locally. * emulation/tpu-extras.el (tpu-write-file-hook) - (tpu-set-cursor-bound): Replaced picture-clean with tpu-trim-line-ends. + (tpu-set-cursor-bound): Replace picture-clean with tpu-trim-line-ends. 2000-12-05 Kenichi Handa <handa@etl.go.jp> @@ -7956,8 +7956,8 @@ for the menu and would make command `imenu' awkward to use. (antlr-skip-file-prelude): With ANTLR-2.7+, you can specify named header actions and more than one. - (antlr-font-lock-tokendef-face): Changed color. - (antlr-font-lock-tokenref-face): Changed color. + (antlr-font-lock-tokendef-face): Change color. + (antlr-font-lock-tokenref-face): Change color. (antlr-font-lock-additional-keywords): Also highlight lowercase. (antlr-mode-syntax-table): New variable. (antlr-mode): Populate and use it instead `java-mode-syntax-table'. @@ -8198,7 +8198,7 @@ * ediff-init.el (ediff-abbrev-jobname): Use capitalize. - * ediff-wind.el (ediff-skip-unsuitable-frames): Deleted the + * ediff-wind.el (ediff-skip-unsuitable-frames): Delete the redundant skip-small-frames test. * viper-cmd.el (viper-change-state-to-vi): Disable overwrite mode. @@ -8297,11 +8297,11 @@ * progmodes/ada-mode.el (ada-mode): Use it instead of `ada-remove-trailing-spaces'. - (ada-remove-trailing-spaces): Removed. + (ada-remove-trailing-spaces): Remove. * textmodes/two-column.el (2C-merge): Recommend it in the doc. - * textmodes/picture.el (picture-clean): Removed. + * textmodes/picture.el (picture-clean): Remove. (picture-mode-exit): Call it instead of `picture-clean'. 2000-11-22 Gerd Moellmann <gerd@gnu.org> @@ -8333,7 +8333,7 @@ (string-rectangle): Check delete-selection-mode. * emacs-lisp/edebug.el (edebug-version) - (edebug-maintainer-address): Deleted. + (edebug-maintainer-address): Delete. (edebug-submit-bug-report): Just alias to report-emacs-bug. (edebug-read-function): Account for other `'#' read forms. (edebug-mode-menus): Make some items toggles. @@ -8344,11 +8344,11 @@ * recentf.el (recentf-menu-items-for-commands) (recentf-make-menu-items, recentf-make-menu-item) - (recentf-filter-changer): Added :help and :active menu-item properties. + (recentf-filter-changer): Add :help and :active menu-item properties. (recentf-build-dir-rules, recentf-dump-variable) (recentf-edit-list, recentf-open-files-item) - (recentf-open-files): Replaced unnecessary `mapcar' with new + (recentf-open-files): Replace unnecessary `mapcar' with new built-in `mapc'. 2000-11-23 Miles Bader <miles@gnu.org> @@ -8521,7 +8521,7 @@ since this function is only concerned with master state. * vc-hooks.el (vc-workfile-unchanged-p) - (vc-default-workfile-unchanged-p): Moved here from vc.el. + (vc-default-workfile-unchanged-p): Move here from vc.el. * vc.el (vc-workfile-unchanged-p) (vc-default-workfile-unchanged-p): See above. @@ -8581,7 +8581,7 @@ (vc-cvs-print-log, vc-cvs-diff): Use asynchronous mode only for remote repositories. - * vc.el (vc-annotate): Changed handling of prefix arg; now asks + * vc.el (vc-annotate): Change handling of prefix arg; now asks for both version and ratio in the minibuffer. * vc-cvs.el (vc-cvs-annotate-command): New optional arg VERSION. @@ -8638,7 +8638,7 @@ 2000-11-15 Eli Zaretskii <eliz@is.elta.co.il> - * textmodes/texinfo.el (texinfo-insert-@uref): Renamed from + * textmodes/texinfo.el (texinfo-insert-@uref): Rename from texinfo-insert-@url. (texinfo-insert-@url): A defalias for texinfo-insert-@uref. (texinfo-mode-map): Bind "C-c C-c u" to texinfo-insert-@uref. @@ -9030,9 +9030,9 @@ 2000-11-06 Miles Bader <miles@lsi.nec.co.jp> - * mwheel.el (mouse-wheel-scroll-amount): Renamed from + * mwheel.el (mouse-wheel-scroll-amount): Rename from `mwheel-scroll-amount'. - (mouse-wheel-follow-mouse): Renamed from `mwheel-follow-mouse'. + (mouse-wheel-follow-mouse): Rename from `mwheel-follow-mouse'. (mouse-wheel-mode): Use (featurep 'xemacs) instead of string-matching against the version string. @@ -9050,7 +9050,7 @@ * international/mule-conf.el (compound-text): Define this coding system here. Make x-ctext and ctext aliases of it. - * language/european.el (compound-text, ctext): Moved to + * language/european.el (compound-text, ctext): Move to international/mule-conf.el. 2000-11-05 Andrew Innes <andrewi@gnu.org> @@ -9263,13 +9263,13 @@ (ps-color-device): Use `color-values' to determine if device supports color. (ps-color-values): Try to use `x-color-values' when using XEmacs. - (ps-print-page-p): Changed from defsubst to defun. - (ps-page-number): Changed from defmacro to defun. + (ps-print-page-p): Change from defsubst to defun. + (ps-page-number): Change from defmacro to defun. (ps-header-sheet, ps-header-page): Fix bug on selected pages for printing. (ps-print-ensure-fontified): Ensure fontification when jit-lock is on. (ps-end-file, ps-dummy-page): Funs eliminated. - (ps-print-color-scale): Changed default value. + (ps-print-color-scale): Change default value. (ps-page-n-up, ps-print-page-p): New internal vars. (ps-print-preprint, ps-output, ps-begin-file, ps-begin-page) (ps-plot-region, ps-generate, ps-end-job): Code fix. @@ -9281,8 +9281,8 @@ 2000-10-31 Kenichi Handa <handa@etl.go.jp> * term/mac-win.el (decode-mac-roman, encode-mac-roman, mac-roman): - Moved to european.el. - (ccl-encode-mac-roman-font, fontset-mac): Modified for + Move to european.el. + (ccl-encode-mac-roman-font, fontset-mac): Modify for mule-unicode-2500-33ff and mule-unicode-e000-ffff. (mac-roman-kbd-insert, mac-roman-kbd-mode): These functions deleted. (mac-roman-kbd-mode, mac-roman-kbd-mode-map): These variables deleted. @@ -9327,7 +9327,7 @@ * international/mule-cmds.el (encode-coding-char): Check property safe-chars instead of safe-charsets. - * international/fontset.el (fontset-default): Modified for + * international/fontset.el (fontset-default): Modify for mule-unicode-2500-33ff and mule-unicode-e000-ffff. (x-font-name-charset-alist): Likewise. (ccl-encode-unicode-font): New CCL program. Record it in @@ -9367,7 +9367,7 @@ * eshell/esh-mode.el (window-height test): Make certain that `eshell-stringify-t' is non-nil. - (eshell-password-prompt-regexp): Changed to a much simpler + (eshell-password-prompt-regexp): Change to a much simpler password regexp. (eshell-send-input): If `eshell-invoke-directly' returns t, directly invoke the parsed command using `eval'. This improves @@ -9391,7 +9391,7 @@ (eshell-rewrite-if-command): Use `eshell-protect' to wrap the call bodies. (eshell-separate-commands): Whitespace fix. - (eshell-complex-commands): Added a new list of names, for + (eshell-complex-commands): Add a new list of names, for determining whether a given command is as simple as it looks. (eshell-invoke-directly): New function. Returns t if a command should be invoked directly (using `eval'), rather than indirectly @@ -9401,10 +9401,10 @@ * eshell/em-unix.el (eshell-default-target-is-dot): New variable, which provides an emulation of the DOS shell behavior of assuming that cp/mv/ln should copy/move/link to the current directory. - (eshell-remove-entries): Added a doc string. - (eshell-shuffle-files): Removed the check for `target' being null. - (eshell-mvcp-template, eshell-mvcpln-template): Renamed - `eshell-mvcp-template' to `eshell-mvcpln-template', and extended + (eshell-remove-entries): Add a doc string. + (eshell-shuffle-files): Remove the check for `target' being null. + (eshell-mvcp-template, eshell-mvcpln-template): + Rename `eshell-mvcp-template' to `eshell-mvcpln-template', and extended it to do a smarter check of whether a destination was provided. (eshell/mv, eshell/cp): Enable `:preserve-args'. (eshell/ln): Enable `:preserve-args', and use @@ -9413,7 +9413,7 @@ (eshell/du, eshell/diff, eshell/locate): Stringify the argument list after flattening it. This makes it possible to cat files with numerical names. - (eshell-unix-initialize): Added several names to + (eshell-unix-initialize): Add several names to `eshell-complex-commands. (eshell-unix-command-complex-p): Return t if a given command name may result in external processes being invoked. @@ -9428,12 +9428,12 @@ (eshell-refresh-windows): Use `if' instead of `when'. (eshell-smart-scroll-window): Calling `save-current-buffer' was not necessary. - (eshell-currently-handling-window): Added a missing global variable. + (eshell-currently-handling-window): Add a missing global variable. * eshell/em-ls.el (eshell-do-ls): Code simplification. (eshell-ls-sort-entries, eshell-ls-entries, eshell-ls-dir): Whitespace fix. - (eshell-ls-exclude-hidden): Added this variable in addition to + (eshell-ls-exclude-hidden): Add this variable in addition to `eshell-ls-exclude-regexp'. This one prevents files beginning with . from even being read, which can improve memory consumption quite a bit. @@ -9441,7 +9441,7 @@ read file entries beginning with a dot. In home directories with lots of hidden files, fully two-thirds of the time spent in ls is used to read directory entries that are immediately thrown away. - (eshell-ls-initial-args): Added back this configuration variable, + (eshell-ls-initial-args): Add back this configuration variable, for specifying default initial arguments to every call to ls. Much faster than using an alias to do the same thing. (eshell-do-ls): Use `eshell-ls-initial-args', if set. @@ -9450,7 +9450,7 @@ * eshell/em-dirs.el (eshell/pwd): Small code simplification. * eshell/esh-util.el: Don't require `ange-ftp' if it's not available. - (eshell-stringify-t): Added a customization variable, to indicate + (eshell-stringify-t): Add a customization variable, to indicate whether `t' should be rendered as a string at all. If not, one can still determine if the result of an expression is true using "file-exists-p FILE && echo true". @@ -9460,7 +9460,7 @@ * eshell/esh-module.el: Whitespace fix. * eshell/em-alias.el (eshell-alias-initialize): - Added `eshell-command-aliased-p' to `eshell-complex-commands'. + Add `eshell-command-aliased-p' to `eshell-complex-commands'. (eshell-command-aliased-p): New function that returns t if a command name names an aliased. @@ -9476,10 +9476,10 @@ characters. * viper-util.el (viper-memq-char, viper=): New functions for working with characters. - (viper-change-cursor-color): Fixed buglet. + (viper-change-cursor-color): Fix buglet. Many functions changed to use viper= instead of = when comparing characters. - * viper.el (viper-insert-state-mode-list): Added eshell. + * viper.el (viper-insert-state-mode-list): Add eshell. * ediff-init.el (ediff-before-setup-hook): New hook. Several typos fixed in various docstrings. @@ -9712,7 +9712,7 @@ (delimit-columns-end): New vars. (delimit-columns-customize, delimit-columns-format): New funs. (delimit-columns-region, delimit-columns-rectangle) - (delimit-columns-rectangle-line): Modified to support column + (delimit-columns-rectangle-line): Modify to support column formatting. 2000-10-24 Dave Love <fx@gnu.org> @@ -9820,9 +9820,9 @@ * woman.el (woman-italic-face, woman-bold-face) (woman-unknown-face): Add dark-background variants. - (woman-default-faces): Renamed from `woman-colour-faces'. + (woman-default-faces): Rename from `woman-colour-faces'. Set using the stored defaults, rather than using hard-wired colors. - (woman-monochrome-faces): Renamed from `woman-black-faces'. + (woman-monochrome-faces): Rename from `woman-black-faces'. Just make the foreground `unspecified' rather than "black". (woman-menu): Rename menu entries accordingly. @@ -9865,13 +9865,13 @@ (vc-delete-automatic-version-backups, vc-make-version-backup): New functions. (vc-before-save): Use the latter. - (vc-default-make-version-backups-p): Added `-p' suffix to avoid + (vc-default-make-version-backups-p): Add `-p' suffix to avoid confusion. - * vc-cvs.el (vc-cvs-make-version-backups-p): Added `-p' suffix as + * vc-cvs.el (vc-cvs-make-version-backups-p): Add `-p' suffix as expected by vc[-hooks].el. - * vc.el (vc-checkout): Added `-p' suffix in call to + * vc.el (vc-checkout): Add `-p' suffix in call to vc-make-version-backups-p; use vc-make-version-backup to actually make the backup. (vc-version-other-window, vc-version-backup-file): Handle both @@ -9882,7 +9882,7 @@ 2000-10-22 Miles Bader <miles@gnu.org> * comint.el (comint-highlight-input, comint-highlight-prompt): - Renamed, `-face' at end removed. + Rename, `-face' at end removed. (comint-send-input, comint-output-filter): Use renamed faces. * window.el (fit-window-to-buffer): Change defaulting of @@ -9989,7 +9989,7 @@ * dirtrack.el (dirtrack): Fix call to run-hooks. - * cmuscheme.el (cmuscheme-program-name): Renamed from + * cmuscheme.el (cmuscheme-program-name): Rename from scheme-program-name because xscheme.el contains a defcustom with the same name. As a consequence, customizing group `cmuscheme' loaded `xscheme' which redefined run-scheme. @@ -10090,8 +10090,8 @@ 2000-10-18 Miles Bader <miles@gnu.org> - * comint.el (comint-delete-output): Renamed from `comint-kill-output'. - (comint-kill-output): Changed into an alias for `comint-delete-output', + * comint.el (comint-delete-output): Rename from `comint-kill-output'. + (comint-kill-output): Change into an alias for `comint-delete-output', and made obsolete. (comint-mode-map): Rename references to comint-kill-output. @@ -10113,7 +10113,7 @@ * diff-mode.el (diff-header-face, diff-file-header-face): Add specific setting for dark background. - (diff-context-face): Renamed from diff-comment-face. + (diff-context-face): Rename from diff-comment-face. Set explicitly rather than inheriting from font-lock-comment-face. 2000-10-17 Eli Zaretskii <eliz@is.elta.co.il> @@ -10208,7 +10208,7 @@ * whitespace.el: Doc fixes. (top-level): Don't add hooks here. - (whitespace-running-emacs): Deleted. + (whitespace-running-emacs): Delete. (timer): Don't require. (whitespace): Add back :version conditional on xemacs test. (whitespace-spacetab-regexp, whitespace-indent-regexp) @@ -10302,7 +10302,7 @@ 2000-10-13 John Wiegley <johnw@gnu.org> - * eshell/esh-util.el (require): Added a missing `require' form, + * eshell/esh-util.el (require): Add a missing `require' form, needed when compiling (for an ange-ftp macro definition). 2000-10-13 Dave Love <fx@gnu.org> @@ -10318,10 +10318,10 @@ 2000-10-13 Stephen Gildea <gildea@stop.mail-abuse.org> - * time-stamp.el (time-stamp): Fixed bug in new multi-line code + * time-stamp.el (time-stamp): Fix bug in new multi-line code that breaks with old list format timestamps. (time-stamp-warn-inactive, time-stamp-old-format-warn) - (time-stamp-count, time-stamp-conversion-warn): Improved doc strings. + (time-stamp-count, time-stamp-conversion-warn): Improve doc strings. 2000-10-13 John Wiegley <johnw@gnu.org> @@ -10333,7 +10333,7 @@ 2000-10-13 John Wiegley <johnw@gnu.org> - * desktop.el (desktop-buffer-modes-to-save): Added a global for + * desktop.el (desktop-buffer-modes-to-save): Add a global for specifying what "other" kinds of buffers should be saved. This used to be hard-coded. (desktop-buffer-misc-functions): A global for specifying how @@ -10345,7 +10345,7 @@ (desktop-buffer-info-misc-data): Aux function for determining Info buffer auxiliary info. (desktop-buffer-dired-misc-data): Likewise, but for dired buffers. - (desktop-buffer-info): Changed this function to use the info + (desktop-buffer-info): Change this function to use the info gathered above. (desktop-create-buffer): Be a little more careful about what `minor-mode' means before calling it. This is important for some @@ -10363,7 +10363,7 @@ (eshell-ls-annotate): Use `eshell-file-attributes'. (eshell-ls-file): Made the user-id printing code a bit smarter. - * eshell/esh-util.el (eshell-ange-ls-uids): Added variable, to + * eshell/esh-util.el (eshell-ange-ls-uids): Add variable, to allow identification of alias user ids in remote directories. It's manual, but there's no other way to know when the current user on the local machine, is also the owning user on the remote machine. @@ -10386,7 +10386,7 @@ full-fledged FTP client, with much more manipulation ability than most other clients. - * eshell/em-unix.el (eshell-du-prefer-over-ange): Added a new + * eshell/em-unix.el (eshell-du-prefer-over-ange): Add a new variable, which means that Eshell's du should always be preferred in remote directories. (eshell-shuffle-files): Use `eshell-file-attributes', rather than @@ -10395,7 +10395,7 @@ when reading remote directories. This is an Eshell-specific variable (not part of ange-ftp). (eshell/ln): Bind `ange-cache'. - (eshell/du): Added some extra logic for determining when to use + (eshell/du): Add some extra logic for determining when to use Eshell's du (which is slow), and when to use the external version (which may or may not exist). @@ -10404,7 +10404,7 @@ `get-buffer-process', since backgrounded processes don't count in the context of this function's logic. - * eshell/esh-arg.el (eshell-parse-double-quote): Moved a call to + * eshell/esh-arg.el (eshell-parse-double-quote): Move a call to `forward-char', so that null strings are parsed correctly. 2000-09-13 John Wiegley <johnw@gnu.org> @@ -10471,7 +10471,7 @@ 2000-10-12 Gerd Moellmann <gerd@gnu.org> * startup.el (fancy-splash-screens): Don't add a pre-command hook. - (fancy-splash-pre-command, fancy-splash-pending-command): Removed. + (fancy-splash-pre-command, fancy-splash-pending-command): Remove. (command-line-1): Don't use fancy-splash-pending-command. (fancy-splash-screens-1): Goto point-min after inserting text. @@ -10633,7 +10633,7 @@ * progmodes/etags.el: Docstring fixes. Maintainer line updated. (initialize-new-tags-table): Use run-hook-with-args-until-success. (find-tag): Use pop-to-buffer if switch-to-buffer failed. - (tags-table-format-functions): Renamed from tags-table-format-hooks. + (tags-table-format-functions): Rename from tags-table-format-hooks. * vc.el (vc-version-diff): diff-switches can be a list. Use relative filenames for prettier output. @@ -10658,8 +10658,8 @@ (jit-lock-unregister): Don't bother handling complex hooks any more. (jit-lock-refontify): New function. (jit-lock-fontify-buffer): Use it. - (jit-lock-function-1): Replaced by jit-lock-fontify-now. - (jit-lock-fontify-now): Renamed from jit-lock-function-1. + (jit-lock-function-1): Replace by jit-lock-fontify-now. + (jit-lock-fontify-now): Rename from jit-lock-function-1. Add optional args START and END. Never call font-lock-fontify-region directly. (jit-lock-function, jit-lock-stealth-fontify): Use it. @@ -10681,9 +10681,9 @@ * play/spook.el (spook-phrases-file): Use expand-file-name, not concat. - * emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression): Don't - insist on symbols starting with word syntax. - (lisp-mode-shared-map): Renamed from shared-lisp-mode-map. + * emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression): + Don't insist on symbols starting with word syntax. + (lisp-mode-shared-map): Rename from shared-lisp-mode-map. (eval-defun-1): Doc fix. (indent-sexp): Use nconc to build up indent-stack. @@ -10732,8 +10732,8 @@ 2000-10-08 Eli Zaretskii <eliz@is.elta.co.il> - * international/titdic-cnv.el (quail-cxterm-package-ext-info): Fix - typos in doc strings. + * international/titdic-cnv.el (quail-cxterm-package-ext-info): + Fix typos in doc strings. * font-lock.el (font-lock-mode, global-font-lock-mode): Mention in the doc strings how to customize Font Lock faces. @@ -10846,7 +10846,7 @@ * net/net-utils.el (nslookup-prompt-regexp, ftp-prompt-regexp) (smbclient-prompt-regexp): Add usage note to doc string. - (ftp-font-lock-keywords, smbclient-font-lock-keywords): Removed. + (ftp-font-lock-keywords, smbclient-font-lock-keywords): Remove. (ftp-mode, smbclient-mode): Don't set `font-lock-defaults'. Use add-hook for adding the comint filter function, and only do so if it's not already in the global hook list. @@ -11002,7 +11002,7 @@ (ftp-font-lock-keywords, smbclient-font-lock-keywords): Only set if window-system is non-nil. (net-utils-run-program): Returns buffer. - (network-connection-reconnect): Added this function. + (network-connection-reconnect): Add this function. * generic.el: Incorporates extensive cleanup and docfixes by @@ -11011,16 +11011,16 @@ (generic-mode-name, generic-comment-list) (generic-keywords-list, generic-font-lock-expressions) (generic-mode-function-list, generic-mode-syntax-table): - Removed variables. - (generic-mode-alist): Renamed to generic-mode-list. + Remove variables. + (generic-mode-alist): Rename to generic-mode-list. (generic-find-file-regexp): Default changed to "^#". (generic-read-type): Uses completing read on generic-mode-list. - (generic-mode-sanity-check): Removed this function. - (generic-add-to-auto-mode): Removed this function. + (generic-mode-sanity-check): Remove this function. + (generic-add-to-auto-mode): Remove this function. (generic-mode-internal): Bind mode-specific definitions into function instead of putting them in alist. - (generic-mode-set-comments): Reworked extensively. - (generic-mode-find-file-hook): Simplified regexp searching. + (generic-mode-set-comments): Rework extensively. + (generic-mode-find-file-hook): Simplify regexp searching. (generic-make-keywords-list): Omit extra pair of parens. * find-lisp.el (find-lisp-find-files-internal): @@ -11028,13 +11028,13 @@ * generic-x.el (apache-conf-generic-mode): Regexp now allows leading whitespace. - (rc-generic-mode): Added eval-when-compile + (rc-generic-mode): Add eval-when-compile around generic-make-keywords-list. Deleted duplicate regexp. - (rul-generic-mode): Added eval-when-compile + (rul-generic-mode): Add eval-when-compile around generic-make-keywords-list. (etc-fstab-generic-mode): New generic mode. - (rul-generic-mode): Removed one eval-when-compile + (rul-generic-mode): Remove one eval-when-compile which caused a max-specpdl-size exceeded error. 2000-10-04 Miles Bader <miles@gnu.org> @@ -11084,7 +11084,7 @@ * isearch.el (isearch-faces): New custom group. (isearch): New defface; was already tested for in the code. - (isearch-lazy-highlight-face): Changed to defface from defcustom. + (isearch-lazy-highlight-face): Change to defface from defcustom. (isearch-highlight): Always use face `isearch'. 2000-10-02 Dave Love <fx@gnu.org> @@ -11155,14 +11155,14 @@ is visited. (vc-start-entry): New argument initial-contents. Don't visit the file if it isn't already visited. Brought documentation up-to-date. - (vc-next-action, vc-register): Updated calls to vc-start-entry. + (vc-next-action, vc-register): Update calls to vc-start-entry. (vc-checkin): New optional arg initial-contents, which is passed to vc-start-entry. (vc-finish-logentry): Make sure to bury log buffer only if there really is one. Call `vc-resynch-buffer' on log-file, not buffer-file-name. (vc-default-comment-history, vc-default-wash-log): New functions. - (vc-index-of): Removed. + (vc-index-of): Remove. (vc-transfer-file): Make do without the above. (vc-default-receive-file): Call comment-history unconditionally. Pass the resulting string to vc-checkin, instead of inserting it into the @@ -11175,8 +11175,8 @@ 2000-10-01 Miles Bader <miles@gnu.org> - * emacs-lisp/easy-mmode.el (easy-mmode-define-navigation): Call - `recenter' with an arg to prevent redrawing the display. + * emacs-lisp/easy-mmode.el (easy-mmode-define-navigation): + Call `recenter' with an arg to prevent redrawing the display. 2000-09-30 Stefan Monnier <monnier@cs.yale.edu> @@ -11191,7 +11191,7 @@ (latex-imenu-create-index): Use it. Move the regexp construction outside loops (and use push). (tex-font-lock-keywords-1, tex-font-lock-keywords-2) - (tex-font-lock-keywords): Moved from font-lock.el. + (tex-font-lock-keywords): Move from font-lock.el. (tex-comment-indent): Remove. (tex-common-initialization): Don't set comment-indent-function. (latex-block-default): New var. @@ -11267,7 +11267,7 @@ 2000-09-29 Miles Bader <miles@gnu.org> * image-file.el (image-file-name-extensions): New variable. - (image-file-name-regexps): Renamed from `image-file-regexps'. + (image-file-name-regexps): Rename from `image-file-regexps'. New default value is nil. Call `auto-image-file-mode'. (image-file-name-regexp): New function. (auto-image-file-mode): New minor mode. @@ -11547,9 +11547,9 @@ type. (cperl-mode): Set normal-auto-fill-function and don't zap auto-fill-function. - (cperl-imenu--function-name-regexp-perl): Renamed from + (cperl-imenu--function-name-regexp-perl): Rename from imenu-example--function-name-regexp-perl. - (cperl-imenu--create-perl-index): Renamed from + (cperl-imenu--create-perl-index): Rename from imenu-example--create-perl-index. (cperl-xsub-scan): Don't require cl. @@ -11618,8 +11618,8 @@ 2000-09-20 Dave Love <fx@gnu.org> * iswitchb.el: Some doc fixes. - (iswitchb-mode-map): Define completely initially. Inherit - minibuffer-local-map. + (iswitchb-mode-map): Define completely initially. + Inherit minibuffer-local-map. (iswitchb-completion-help) <!iswitchb-xemacs>: Use fundamental-mode. (iswitchb-global-map): New variable. @@ -11704,7 +11704,7 @@ * toolbar/tool-bar.el: Renamed from toolbar.el. Change `toolbar' to `tool-bar' generally in symbols. Make some items invisible in `special' major modes. - (tool-bar-add-item-from-menu): Renamed from toolbar-like-menu-item. + (tool-bar-add-item-from-menu): Rename from toolbar-like-menu-item. Add arg PROPS. * startup.el (fancy-splash-screen) <defgroup>: Fix syntax. @@ -11862,8 +11862,8 @@ * strokes.el: Sync with maintainer's current version with changes for Emacs, but avoid runtime cl and levents. (toplevel): Change autoloads and compilation requires. - (strokes-version, strokes-bug-address, strokes-lift): Values - changed. + (strokes-version, strokes-bug-address, strokes-lift): + Values changed. (strokes-xpm-header, strokes-insinuated): New variable. (strokes): Add :link. (strokes-mode): Customized. @@ -11890,8 +11890,8 @@ (strokes-xpm-encode-length-as-string, strokes-xpm-decode-char) (strokes-xpm-to-compressed-string, strokes-decode-buffer) (strokes-encode-buffer, strokes-xpm-for-compressed-string) - (strokes-compose-complex-stroke, strokes-alphabetic-lessp): New - functions. + (strokes-compose-complex-stroke, strokes-alphabetic-lessp): + New functions. 2000-09-15 Gerd Moellmann <gerd@gnu.org> @@ -11944,10 +11944,10 @@ 2000-09-14 Alex Schroeder <alex@gnu.org> * ansi-color.el (ansi-colors): Doc change. - (ansi-color-get-face): Simplified regexp. - (ansi-color-faces-vector): Added more faces, doc change. + (ansi-color-get-face): Simplify regexp. + (ansi-color-faces-vector): Add more faces, doc change. (ansi-color-names-vector): Doc change. - (ansi-color-regexp): Simplified regexp. + (ansi-color-regexp): Simplify regexp. (ansi-color-parameter-regexp): New regexp. (ansi-color-filter-apply): Doc change. (ansi-color-filter-region): Doc change. @@ -11955,11 +11955,11 @@ deal with zero length parameters. (ansi-color-apply-on-region): Doc change. (ansi-color-map): Doc change. - (ansi-color-map-update): Removed debugging message. - (ansi-color-get-face-1): Added condition-case to trap + (ansi-color-map-update): Remove debugging message. + (ansi-color-get-face-1): Add condition-case to trap args-out-of-range errors. (ansi-color-get-face): Doc change. - (ansi-color-make-face): Removed. + (ansi-color-make-face): Remove. (ansi-color-for-shell-mode): New option. 2000-09-13 Kenichi Handa <handa@etl.go.jp> @@ -12022,25 +12022,25 @@ 2000-09-12 Kenichi Handa <handa@etl.go.jp> - * international/quail.el (quail-define-package): Docstring - modified. + * international/quail.el (quail-define-package): + Docstring modified. 2000-09-12 Kenichi Handa <handa@etl.go.jp> - * international/titdic-cnv.el (quail-cxterm-package-ext-info): Add - extra docstrings for "chinese-ccdospy", "chinese-ecdict", + * international/titdic-cnv.el (quail-cxterm-package-ext-info): + Add extra docstrings for "chinese-ccdospy", "chinese-ecdict", "chinese-etzy", "chinese-sw", and "chinese-ziranma". Modify the docstring of "chinese-py". - * international/quail.el (quail-translation-docstring): New - variable. + * international/quail.el (quail-translation-docstring): + New variable. (quail-show-keyboard-layout): Docstring modified. (quail-select-current): Likewise. (quail-build-decode-map): Change arg MAP to MAP-LIST to avoid infinite recursive call. (quail-help): Check quail-translation-docstring. Format of the output changed. - (quail-help-insert-keymap-description): Adjusted for the above + (quail-help-insert-keymap-description): Adjust for the above change. 2000-09-11 Gerd Moellmann <gerd@gnu.org> @@ -12151,7 +12151,7 @@ 2000-09-07 Kenichi Handa <handa@etl.go.jp> - * help.el (help-make-xrefs): Adjusted for the change of + * help.el (help-make-xrefs): Adjust for the change of help-xref-mule-regexp. (help-insert-xref-button): New function. @@ -12205,10 +12205,10 @@ (vc-merge): Use RET for first version to trigger merge-news, not prefix arg. (vc-annotate): Handle backends that do not support annotation. - (vc-default-merge-news): Removed. The existence of a merge-news + (vc-default-merge-news): Remove. The existence of a merge-news implementation is now checked on caller sites. - * vc-hooks.el (vc-default-mode-line-string): Removed CVS special + * vc-hooks.el (vc-default-mode-line-string): Remove CVS special case. * vc-cvs.el (vc-cvs-mode-line-string): New function, handles the @@ -12227,11 +12227,11 @@ (vc-after-save): Call `vc-dired-resynch-file' only if vc is loaded. * vc.el: Require dired-aux during compilation. - (vc-name-assoc-file): Moved to vc-sccs.el. + (vc-name-assoc-file): Move to vc-sccs.el. (with-vc-properties): New macro. (vc-checkin, vc-checkout, vc-revert, vc-cancel-version) (vc-finish-steal): Use it. - (vc-cancel-version): Moved RCS-specific code to vc-rcs.el. The call + (vc-cancel-version): Move RCS-specific code to vc-rcs.el. The call to the backend-specific function is now supposed to do the checkout, too. (vc-log-edit): Handle FILE being nil and added a FIXME for log-edit. @@ -12239,15 +12239,15 @@ * vc-cvs.el (vc-cvs-checkin, vc-cvs-checkout): Don't bother to set file properties; that gets done in the generic code now. - * vc-rcs.el (vc-rcs-uncheck): Renamed to `vc-rcs-cancel-version'. + * vc-rcs.el (vc-rcs-uncheck): Rename to `vc-rcs-cancel-version'. Changed parameter list, added code from vc.el that does the checkout, possibly with a double-take. - * vc-sccs.el (vc-sccs-name-assoc-file): Moved here from vc.el. - (vc-sccs-add-triple, vc-sccs-rename-file, vc-sccs-lookup-triple): Use - the above under the new name. - (vc-sccs-uncheck): Renamed to `vc-sccs-cancel-version'. Changed - parameter list, added checkout command. + * vc-sccs.el (vc-sccs-name-assoc-file): Move here from vc.el. + (vc-sccs-add-triple, vc-sccs-rename-file, vc-sccs-lookup-triple): + Use the above under the new name. + (vc-sccs-uncheck): Rename to `vc-sccs-cancel-version'. + Changed parameter list, added checkout command. (vc-sccs-checkin, vc-sccs-checkout): Don't bother to set file properties; that gets done in the generic code now. @@ -12288,8 +12288,8 @@ * sql.el (sql-mode-menu): Work around missing variable mark-active in XEmacs. - (sql-mode): Added call to easy-menu-add for XEmacs compatibility. - (sql-interactive-mode): Added call to easy-menu-add for XEmacs + (sql-mode): Add call to easy-menu-add for XEmacs compatibility. + (sql-interactive-mode): Add call to easy-menu-add for XEmacs compatibility. 2000-09-04 Gerd Moellmann <gerd@gnu.org> @@ -12339,8 +12339,8 @@ (vc-default-could-register): New function. (vc-dired-buffers-for-dir, vc-dired-resynch-file): New functions. (vc-resynch-buffer): Call vc-dired-resynch-file. - (vc-start-entry, vc-finish-logentry, vc-revert-buffer): Use - vc-resynch-buffer instead of vc-resynch-window. + (vc-start-entry, vc-finish-logentry, vc-revert-buffer): + Use vc-resynch-buffer instead of vc-resynch-window. (vc-next-action-dired): Don't redisplay here, that gets done as a result of the individual file operations. (vc-retrieve-snapshot): Corrected prompt order. @@ -12349,8 +12349,8 @@ * vc-cvs.el (vc-cvs-stay-local): Allow it to be a hostname regexp as well. - (vc-cvs-remote-p): Renamed to vc-cvs-stay-local-p. Handle - hostname regexps. Updated all callers. + (vc-cvs-remote-p): Rename to vc-cvs-stay-local-p. + Handle hostname regexps. Updated all callers. (vc-cvs-responsible-p): Handle directories as well. (vc-cvs-could-register): New function. (vc-cvs-retrieve-snapshot): Parse "cvs update" output, keep file @@ -12387,7 +12387,7 @@ (vc-dired-mode-map): Inherit from dired-mode-map. (vc-dired-mode): Local value of dired-move-to-filename-regexp simplified. - (vc-dired-state-info): Removed, updated caller. + (vc-dired-state-info): Remove, updated caller. (vc-default-dired-state-info): Use parentheses instead of hyphens. (vc-dired-hook): Use vc-BACKEND-dir-state, if available. (vc-dired-listing-switches): New variable. @@ -12428,7 +12428,7 @@ * vc.el (vc-next-action-on-file): Corrected several messages. (vc-merge): Add prefix arg `merge-news'; handle it. - * vc-cvs.el (vc-cvs-workfile-version): Removed comment that this + * vc-cvs.el (vc-cvs-workfile-version): Remove comment that this is not reached. It is. (vc-cvs-merge): Set state to 'edited after merge. (vc-cvs-merge-news): Set workfile version to nil if not known. @@ -12456,9 +12456,9 @@ (vc-new-comment-index): New function. (vc-previous-comment): Use it. Make the minibuffer message slightly less terse. - (vc-comment-search-reverse): Make it work forward as well. Don't - set vc-comment-ring-index if no match is found. Use - vc-new-comment-index. + (vc-comment-search-reverse): Make it work forward as well. + Don't set vc-comment-ring-index if no match is found. + Use vc-new-comment-index. (vc-comment-search-forward): Use vc-comment-search-reverse. (vc-dired-mode-map): Don't inherit from dired-mode-map since define-derived-mode will do it for us. Bind `v' to a keymap that @@ -12482,7 +12482,7 @@ (vc-cvs-stay-local): Default to t. (vc-cvs-remote-p): New function and property. (vc-cvs-state): Stay local only if the above is t. - (vc-handle-cvs): Removed. + (vc-handle-cvs): Remove. (vc-cvs-registered): Don't check vc-handle-cvs -- it should all be done via vc-handled-backends now. (vc-cvs-header): Escape Id. @@ -12499,10 +12499,10 @@ * vc.el (vc-exec-after): Fix disassembly of previous sentinel. (vc-print-log): Search current revision from beginning of buffer. (vc-revert-buffer): Clear echo area after the diff is finished. - (vc-prefix-map): Removed definition of "t" for terse display in vc + (vc-prefix-map): Remove definition of "t" for terse display in vc dired. - (vc-dired-mode-map): Inherit from dired-mode-map. Added - definition of "vt" for terse display. + (vc-dired-mode-map): Inherit from dired-mode-map. + Added definition of "vt" for terse display. (vc-dired-mode): Fix dired-move-to-filename-regexp. 2000-09-04 Stefan Monnier <monnier@cs.yale.edu> @@ -12520,11 +12520,11 @@ (vc-print-log): Use vc-exec-after and use log-view-goto-rev if present. - * vc-sccs.el (vc-sccs-state-heuristic): Use - file-ownership-preserved-p. + * vc-sccs.el (vc-sccs-state-heuristic): + Use file-ownership-preserved-p. - * vc-rcs.el (vc-rcs-state-heuristic): Use - file-ownership-preserved-p. + * vc-rcs.el (vc-rcs-state-heuristic): + Use file-ownership-preserved-p. (vc-rcs-checkout): Remove the error-handling for missing-rcs. 2000-09-04 Andre Spiegel <spiegel@gnu.org> @@ -12553,11 +12553,11 @@ current buffer without any fuss'. (vc-version-diff): Change the `diff' backend operation to just put the diff in the current buffer without erasing it. Always use - *vc-diff* even for directory-diffs. Use vc-setup-buffer. Protect - shrink-window-if-larger-than-buffer. + *vc-diff* even for directory-diffs. Use vc-setup-buffer. + Protect shrink-window-if-larger-than-buffer. (vc-print-log): Change the `print-log' backend operation to just - put the log in the current buffer without erasing it. Protect - shrink-window-if-larger-than-buffer. + put the log in the current buffer without erasing it. + Protect shrink-window-if-larger-than-buffer. (vc-update-change-log): Fix setd typo. * vc-sccs.el (vc-sccs-workfile-unchanged-p): Fix parenthesis. @@ -12567,8 +12567,8 @@ (vc-rcs-diff): Insert in the current buffer and remove unused arg CMP. - * vc-cvs.el (vc-cvs-state, vc-cvs-fetch-status): Use - with-temp-file. Use the new BUFFER=t argument to vc-do-command. + * vc-cvs.el (vc-cvs-state, vc-cvs-fetch-status): + Use with-temp-file. Use the new BUFFER=t argument to vc-do-command. (vc-cvs-print-log, vc-cvs-diff): Insert in the current buffer. 2000-09-04 Andre Spiegel <spiegel@gnu.org> @@ -12578,13 +12578,13 @@ (vc-default-workfile-unchanged-p): New function. Delegates to a full vc-BACKEND-diff. - * vc-hooks.el (vc-simple-command): Removed. + * vc-hooks.el (vc-simple-command): Remove. * vc-rcs.el (vc-rcs-workfile-unchanged-p): Use vc-do-command instead of vc-simple-command. - (vc-rcs-fetch-master-state): Removed check for unlocked-changes to + (vc-rcs-fetch-master-state): Remove check for unlocked-changes to avoid doing a diff when opening a file. - (vc-rcs-state): Added check for unlocked-changes. + (vc-rcs-state): Add check for unlocked-changes. (vc-rcs-header): Escape Id. (vc-rcs-workfile-unchanged-p): Remove optional arg VERSION. (vc-rcs-state): Call vc-workfile-unchanged-p, not the RCS-specific @@ -12600,7 +12600,7 @@ 2000-09-04 Stefan Monnier <monnier@cs.yale.edu> - * vc.el (vc-editable-p): Renamed from vc-writable-p. + * vc.el (vc-editable-p): Rename from vc-writable-p. (with-vc-file, vc-merge): Use vc-editable-p. (vc-do-command): Remove unused var vc-file and fix the doubly-defined `status' var. Add a user message when starting an @@ -12674,8 +12674,8 @@ way the function itself works. (vc-file-owner): Remove. - * vc-cvs.el (vc-cvs-registered): Use with-temp-buffer. Reorder - extraction of fields and call to file-attributes because of a + * vc-cvs.el (vc-cvs-registered): Use with-temp-buffer. + Reorder extraction of fields and call to file-attributes because of a temporary bug in rcp.el. (vc-cvs-fetch-status): Use with-current-buffer. @@ -12726,8 +12726,8 @@ * vc-rcs.el (vc-rcs-exists): Remove. (vc-rcs-header): New var. - * vc-sccs.el (vc-sccs-responsible-p, vc-sccs-register): Use - `vc-sccs-search-project-dir' instead of `vc-sccs-project-dir'. + * vc-sccs.el (vc-sccs-responsible-p, vc-sccs-register): + Use `vc-sccs-search-project-dir' instead of `vc-sccs-project-dir'. (vc-sccs-header): New var. * vc.el (vc-do-command): Get rid of the `last' argument. @@ -12761,8 +12761,8 @@ (vc-cancel-version): prettify error message with \\[...]. (vc-rename-master): New function. (vc-rename-file): Use vc-BACKEND-rename-file (which might in turn - use vc-rename-master) instead of vc-BACKEND-record-rename. Make - the CVS special case generic. + use vc-rename-master) instead of vc-BACKEND-record-rename. + Make the CVS special case generic. (vc-default-record-rename): Remove. (vc-file-tree-walk-internal): Only call FUNC for files that are under control of some VC backend and replace `concat' with @@ -12771,7 +12771,7 @@ (vc-version-diff, vc-snapshot-precondition, vc-create-snapshot) (vc-retrieve-snapshot): Update call to vc-file-tree-walk. - * vc-sccs.el (vc-sccs-rename-file): Renamed from + * vc-sccs.el (vc-sccs-rename-file): Rename from vc-sccs-record-rename. Use `find-file-noselect' rather than `find-file' and call `vc-rename-master' to do the actual move. (vc-sccs-diff): Remove unused `backend' variable. @@ -12833,7 +12833,7 @@ 2000-09-04 Stefan Monnier <monnier@cs.yale.edu> - * vc.el (vc-locking-user): Moved from vc-hooks.el. + * vc.el (vc-locking-user): Move from vc-hooks.el. 2000-09-04 Stefan Monnier <monnier@cs.yale.edu> @@ -12859,9 +12859,9 @@ using the default function. (vc-call-backend): If calling the default function, pass it the backend as first argument. Update the docstring accordingly. - (vc-default-state-heuristic, vc-default-mode-line-string): Update - for the new backend argument. - (vc-make-backend-sym): Renamed from vc-make-backend-function. + (vc-default-state-heuristic, vc-default-mode-line-string): + Update for the new backend argument. + (vc-make-backend-sym): Rename from vc-make-backend-function. (vc-find-backend-function): Use the new name. (vc-default-registered): New function. @@ -12927,8 +12927,8 @@ 2000-09-04 Andre Spiegel <spiegel@gnu.org> - * vc.el (vc-file-clear-masterprops): Removed. - (vc-checkin, vc-revert-buffer): Removed calls to the above. + * vc.el (vc-file-clear-masterprops): Remove. + (vc-checkin, vc-revert-buffer): Remove calls to the above. (vc-version-diff): Use buffer-size without argument. (vc-register): Heed vc-initial-comment. @@ -12937,12 +12937,12 @@ * vc-rcs.el (vc-rcs-register): Parse command output to find master file name and workfile version. - (vc-rcs-checkout): Removed call to vc-file-clear-masterprops. + (vc-rcs-checkout): Remove call to vc-file-clear-masterprops. - * vc-cvs.el (vc-cvs-merge-news, vc-cvs-checkout): Removed call to + * vc-cvs.el (vc-cvs-merge-news, vc-cvs-checkout): Remove call to vc-file-clear-masterprops. - * vc-sccs.el (vc-sccs-checkout): Removed call to + * vc-sccs.el (vc-sccs-checkout): Remove call to vc-file-clear-masterprops. If writable, set vc-state to 'edited rather than user login name. @@ -12969,7 +12969,7 @@ 2000-09-04 Andre Spiegel <spiegel@gnu.org> * vc.el (with-vc-file, vc-next-action, vc-version-diff) - (vc-dired-mark-locked): Replaced usage of vc-locking-user with + (vc-dired-mark-locked): Replace usage of vc-locking-user with vc-state or vc-up-to-date-p. (vc-merge): Use vc-backend-defines to check whether merging is possible. Set state to 'edited after successful merge. @@ -13015,25 +13015,25 @@ * vc-cvs.el (vc-cvs-print-log, vc-cvs-diff): Run cvs asynchronously. * vc.el (vc-do-command): kill-all-local-variables, to reset any - major-mode in which the buffer might have been put earlier. Use - `remove' and `when'. Allow `okstatus' to be `async' and use + major-mode in which the buffer might have been put earlier. + Use `remove' and `when'. Allow `okstatus' to be `async' and use `start-process' in this case. (vc-version-diff): Handle the case where the diff looks empty because of the use of an async process. 2000-09-04 Andre Spiegel <spiegel@gnu.org> - * vc.el (vc-next-action-on-file): Removed optional parameter + * vc.el (vc-next-action-on-file): Remove optional parameter `simple'. Recompute state unconditionally. - (vc-default-toggle-read-only): Removed. + (vc-default-toggle-read-only): Remove. - * vc-hooks.el (vc-backend-functions): Removed vc-toggle-read-only. + * vc-hooks.el (vc-backend-functions): Remove vc-toggle-read-only. (vc-toggle-read-only): Undid prev change. - * vc-cvs.el (vc-cvs-stay-local): Renamed from + * vc-cvs.el (vc-cvs-stay-local): Rename from vc-cvs-simple-toggle. Redocumented. (vc-cvs-state): If locality is wanted, use vc-cvs-state-heuristic. - (vc-cvs-toggle-read-only): Removed. + (vc-cvs-toggle-read-only): Remove. 2000-09-04 Stefan Monnier <monnier@cs.yale.edu> @@ -13051,7 +13051,7 @@ (vc-dired-mode-map): Properly defvar it. (vc-print-log): Call log-view-mode if available. (small-temporary-file-directory): defvar instead of use boundp. - (vc-merge-news): Moved to vc-cvs.el. + (vc-merge-news): Move to vc-cvs.el. (vc-default-merge-news): New function. * vc-sccs.el: Require 'vc and 'vc-sccs-hooks. @@ -13075,7 +13075,7 @@ call to vc-rcs-latest-on-branch-p. Hopefully that was the right one. * vc-rcs-hooks.el: Provide 'vc-rcs-hooks. - (vc-rcs-trunk-p, vc-rcs-branch-part): Moved from vc-rcs.el. + (vc-rcs-trunk-p, vc-rcs-branch-part): Move from vc-rcs.el. (vc-rcs-latest-on-branch-p): Use the `version' argument rather than the apparently unbound `workfile-version'. @@ -13116,8 +13116,8 @@ * vc-cvs.el (vc-cvs-checkout): Docstring fix. Added a `(if workfile' that got lost when the code was extracted from vc.el. And merged the tail with the rest of the code (not possible in the - old vc.el where the tail was shared among all backends). And - explicitly set the state to 'edited if `writable' is set. + old vc.el where the tail was shared among all backends). + And explicitly set the state to 'edited if `writable' is set. * vc-cvs-hooks.el (vc-cvs-registered): Use expand-file-name. (vc-cvs-state): Be careful to return the value from @@ -13128,16 +13128,16 @@ workfile was nil). * vc.el: Removed those pesky unnecessary `(function' quotes. - (vc-annotate-mode-map, vc-annotate-mode-syntax-table): Initialize - directly in the defvar. + (vc-annotate-mode-map, vc-annotate-mode-syntax-table): + Initialize directly in the defvar. (vc-do-command): Bind inhibit-read-only so as to properly handle the case where the destination buffer has been made read-only. (vc-diff): Delegate to vc-version-diff in all cases. (vc-version-diff): Setup the *vc-diff* buffer as was done in vc-diff. - (vc-annotate-mode-variables): Removed (code moved partly to + (vc-annotate-mode-variables): Remove (code moved partly to defvars and partly to vc-annotate-add-menu). (vc-annotate-mode): Turned into a derived-mode. - (vc-annotate-add-menu): Moved in code in + (vc-annotate-add-menu): Move in code in vc-annotate-mode-variables. (vc-update-change-log): Use make-temp-file if available. @@ -13148,51 +13148,51 @@ 2000-09-04 Andre Spiegel <spiegel@inf.fu-berlin.de> - * vc.el (vc-next-action-on-file): Added handling of state + * vc.el (vc-next-action-on-file): Add handling of state `unlocked-changes'. (vc-checkout-carefully): Is now practically obsolete, unless the above is too slow to be enabled unconditionally. - (vc-update-change-log): Fixed typo. + (vc-update-change-log): Fix typo. - * vc-sccs.el (vc-sccs-steal-lock): Renamed from `vc-sccs-steal'. + * vc-sccs.el (vc-sccs-steal-lock): Rename from `vc-sccs-steal'. * vc-sccs-hooks.el (vc-sccs-state): Somewhat rewritten. Now handles state `unlocked-changes'. (vc-sccs-workfile-unchanged-p): New function, to support the above. - * vc-rcs.el (vc-rcs-steal-lock): Renamed from `vc-rcs-steal'. + * vc-rcs.el (vc-rcs-steal-lock): Rename from `vc-rcs-steal'. - * vc-rcs-hooks.el (vc-rcs-state): Fixed typo. + * vc-rcs-hooks.el (vc-rcs-state): Fix typo. (vc-rcs-fetch-master-state): Bug fixes. Recognize state `unlocked-changes'. - (vc-rcs-workfile-unchanged-p): Renamed from + (vc-rcs-workfile-unchanged-p): Rename from `vc-rcs-workfile-unchanged'. This is not a real backend-specific function yet, but supposed to become one soon. - * vc-hooks.el (vc-backend-functions): Renamed `vc-steal' to + * vc-hooks.el (vc-backend-functions): Rename `vc-steal' to `vc-steal-lock'. - (vc-call-backend): Changed error message. - (vc-state): Added description of state `unlocked-changes'. + (vc-call-backend): Change error message. + (vc-state): Add description of state `unlocked-changes'. 2000-09-04 Andre Spiegel <spiegel@inf.fu-berlin.de> - * vc-cvs-hooks.el (vc-cvs-registered): Fixed bug that caused it to + * vc-cvs-hooks.el (vc-cvs-registered): Fix bug that caused it to always return t in CVS-controlled directories. * vc.el (vc-responsible-backend): New function. (vc-register): Largely rewritten. - (vc-admin): Removed (implementation moved into vc-register). + (vc-admin): Remove (implementation moved into vc-register). (vc-checkin): Redocumented. (vc-finish-logentry): If no backend defined yet (because we are in the process of registering), use the responsible backend. * vc-hooks.el (vc-backend-hook-functions, vc-backend-functions): - Updated function lists. - (vc-call-backend): Fixed typo. + Update function lists. + (vc-call-backend): Fix typo. * vc-sccs.el, vc-rcs.el, vc-cvs.el (vc-BACKEND-responsible-p): New functions. - (vc-BACKEND-register): Renamed from `vc-BACKEND-admin'. + (vc-BACKEND-register): Rename from `vc-BACKEND-admin'. Removed query option. Redocumented. 2000-09-04 Andre Spiegel <spiegel@inf.fu-berlin.de> @@ -13204,18 +13204,18 @@ 2000-09-04 Martin Lorentzson <martinl@gnu.org> - * vc-rcs.el (vc-rcs-backend-release-p): function added. other - stuff updated to reference this function instead of the old + * vc-rcs.el (vc-rcs-backend-release-p): function added. + other stuff updated to reference this function instead of the old `vc-backend-release-p'. 2000-09-04 Andre Spiegel <spiegel@inf.fu-berlin.de> - * vc-sccs-hooks.el (vc-uses-locking): Renamed to + * vc-sccs-hooks.el (vc-uses-locking): Rename to vc-checkout-model. Return appropriate values. Updated callers. 2000-09-04 Martin Lorentzson <martinl@gnu.org> - * vc.el (vc-backend-release, vc-backend-release-p): Moved to vc-rcs.el. + * vc.el (vc-backend-release, vc-backend-release-p): Move to vc-rcs.el. (vc-backend-revert): Function moved into `vc-revert'; `vc-next-action' must be updated to accommodate this change. (vc-backend-steal): Function moved into `vc-finish-steal'. @@ -13295,31 +13295,31 @@ 2000-09-04 Andre Spiegel <spiegel@inf.fu-berlin.de> * vc.el (vc-next-action-on-file): Rewritten for the new state model. - (vc-backend-merge-news): Renamed to `vc-merge-news'. (Specific parts + (vc-backend-merge-news): Rename to `vc-merge-news'. (Specific parts still need to be split, and implemented for RCS). 2000-09-04 Martin Lorentzson <martinl@gnu.org> * vc-sccs-hooks.el (vc-sccs-state-heuristic): Bug found and fixed. - * vc-sccs.el (vc-sccs-admin): Added the query-only option as + * vc-sccs.el (vc-sccs-admin): Add the query-only option as required by the vc.el file. - * vc-rcs.el (vc-rcs-admin): Added the query-only option as + * vc-rcs.el (vc-rcs-admin): Add the query-only option as required by the vc.el file. (vc-rcs-exists): Function added. - * vc-cvs.el (vc-cvs-admin): Added the query-only option as + * vc-cvs.el (vc-cvs-admin): Add the query-only option as required by the vc.el file. - * vc.el (vc-admin): Updated to handle selection of appropriate + * vc.el (vc-admin): Update to handle selection of appropriate backend. Current implementation is crufty and need re-thinking. * vc-hooks.el (vc-parse-buffer): Bug found and fixed. 2000-09-04 Martin Lorentzson <martinl@gnu.org> - * vc-cvs.el (vc-cvs-annotate-difference): Updated to handle + * vc-cvs.el (vc-cvs-annotate-difference): Update to handle beginning of annotate buffers correctly. * vc.el (vc-annotate-get-backend, vc-annotate-display-default) @@ -13338,11 +13338,11 @@ 2000-09-04 Martin Lorentzson <martinl@gnu.org> - * vc-sccs-hooks.el (vc-sccs-registered): Updated. + * vc-sccs-hooks.el (vc-sccs-registered): Update. - * vc-rcs-hooks.el (vc-rcs-registered): Updated. + * vc-rcs-hooks.el (vc-rcs-registered): Update. - * vc-cvs-hooks.el (vc-cvs-registered): Updated. + * vc-cvs-hooks.el (vc-cvs-registered): Update. 2000-09-04 Martin Lorentzson <martinl@gnu.org> @@ -13434,8 +13434,8 @@ * vc-hooks.el (vc-master-templates): Is really obsolete. Comment out the definition for now. What is the right procedure to get rid of it? - (vc-registered, vc-backend, vc-buffer-backend, vc-name): Largely - rewritten. + (vc-registered, vc-backend, vc-buffer-backend, vc-name): + Largely rewritten. (vc-default-registered): Remove. (vc-check-master-templates): New function; does mostly what the above did before. @@ -13482,12 +13482,12 @@ * vc.el (vc-backend-checkout): Function removed and replaced in the vc-backend.el files. - * vc-sccs.el (vc-sccs-checkout): Added function `vc-sccs-checkout'. + * vc-sccs.el (vc-sccs-checkout): Add function `vc-sccs-checkout'. - * vc.el (vc-backend-admin): Removed and replaced in the + * vc.el (vc-backend-admin): Remove and replaced in the vc-backend.el files. - * vc.el (Martin): Removed all the annotate functionality since it + * vc.el (Martin): Remove all the annotate functionality since it is CVS backend specific. 2000-09-04 Andre Spiegel <spiegel@inf.fu-berlin.de> @@ -13513,7 +13513,7 @@ (vc-logentry-check-hook): New option. (vc-steal-lock): Use compose-mail. (vc-dired-mode-map): Defvar when compiling. - (vc-add-triple, vc-record-rename, vc-lookup-triple): Moved to + (vc-add-triple, vc-record-rename, vc-lookup-triple): Move to vc-sccs.el and renamed. Callers changed. (vc-backend-checkout, vc-backend-logentry-check) (vc-backend-merge-news): Doc fix. @@ -13538,7 +13538,7 @@ (vc-rcs-checkin): New functions (code from vc.el). (vc-rcs-previous-version, vc-rcs-system-release, vc-rcs-checkout): Doc fix. - (vc-rcs-release): Deleted. (Duplicated vc-rcs-system-release). + (vc-rcs-release): Delete. (Duplicated vc-rcs-system-release). * vc-sccs.el: Require vc when compiling. (vc-sccs-print-log, vc-sccs-assign-name, vc-sccs-merge) @@ -13547,7 +13547,7 @@ (vc-sccs-checkin, vc-sccs-logentry-check): New functions (code from vc.el). (vc-sccs-add-triple, vc-sccs-record-rename) - (vc-sccs-lookup-triple): Moved from vc.el and renamed. + (vc-sccs-lookup-triple): Move from vc.el and renamed. (vc-sccs-admin): Doc fix. 2000-09-04 Martin Lorentzson <martinl@gnu.org> @@ -13557,64 +13557,64 @@ (vc-rcs-release-p, vc-rcs-admin, vc-rcs-checkout): New functions from vc.el. - * vc-sccs.el (vc-admin-sccs): Added from vc.el + * vc-sccs.el (vc-admin-sccs): Add from vc.el * vc-cvs.el: Moved the annotate functionality from vc.el. - (vc-cvs-admin, vc-cvs-fetch-status): Added from vc.el. + (vc-cvs-admin, vc-cvs-fetch-status): Add from vc.el. 2000-09-04 Dave Love <fx@gnu.org> * vc.el (vc-backend-release): Call vc-system-release. * vc-sccs.el (vc-sccs-system-release): - Renamed from vc-sccs-backend-release. + Rename from vc-sccs-backend-release. * vc-rcs.el (vc-rcs-system-release): - Renamed from vc-rcs-backend-release. + Rename from vc-rcs-backend-release. * vc-cvs.el (vc-cvs-system-release): - Renamed from vc-cvs-backend-release. + Rename from vc-cvs-backend-release. 2000-09-04 Dave Love <fx@gnu.org> - * vc.el (vc-rcs-release, vc-cvs-release, vc-sccs-release): Moved to + * vc.el (vc-rcs-release, vc-cvs-release, vc-sccs-release): Move to backend files. (vc-backend-release): Dispatch to backend functions. (vc-backend-release-p): Don't mention CVS, RCS. [The SCCS case probably needs attention.] - * vc-sccs.el, vc-rcs.el (vc-sccs-release): Moved from vc.el. + * vc-sccs.el, vc-rcs.el (vc-sccs-release): Move from vc.el. (vc-sccs-backend-release): New function. - * vc-cvs.el (vc-cvs-release): Moved from vc.el. + * vc-cvs.el (vc-cvs-release): Move from vc.el. (vc-cvs-backend-release): New function. * vc.el (vc-dired-mode, vc-dired-reformat-line, vc-dired-purge): Doc fix. - (vc-fetch-cvs-status): Moved to vc-cvs.el and renamed. + (vc-fetch-cvs-status): Move to vc-cvs.el and renamed. (vc-default-dired-state-info): New function. (vc-dired-state-info): Dispatch to backends. (vc-dired-hook): Doc fix. Simplify, pending removal of CVS specifics. - * vc-cvs.el (vc-cvs-dired-state-info, vc-cvs-fetch-status): Moved - from vc.el and renamed. + * vc-cvs.el (vc-cvs-dired-state-info, vc-cvs-fetch-status): + Move from vc.el and renamed. 2000-09-04 Andre Spiegel <spiegel@inf.fu-berlin.de> * vc.el (vc-file-clear-masterprops, vc-latest-on-branch-p) - (vc-version-other-window, vc-backend-assign-name): Removed - references to vc-latest-version; sometimes changed into + (vc-version-other-window, vc-backend-assign-name): + Remove references to vc-latest-version; sometimes changed into vc-workfile-version. - * vc-rcs-hooks.el (vc-master-workfile-version): Renamed to + * vc-rcs-hooks.el (vc-master-workfile-version): Rename to vc-rcs-master-workfile-version. (vc-rcs-workfile-version): Use the above. Don't call vc-latest-version (that was unreachable code, anyway). (vc-rcs-fetch-master-properties): Doc fix. - * vc-hooks.el (vc-latest-version, vc-your-latest-version): Removed. - (vc-backend-hook-functions): Removed them from this list, too. - (vc-fetch-properties): Removed. + * vc-hooks.el (vc-latest-version, vc-your-latest-version): Remove. + (vc-backend-hook-functions): Remove them from this list, too. + (vc-fetch-properties): Remove. (vc-workfile-version): Doc fix. * vc-rcs-hooks.el (vc-rcs-consult-headers): New function. @@ -13622,7 +13622,7 @@ (vc-rcs-uses-locking): Use it. * vc-hooks.el (vc-consult-rcs-headers): - Moved into vc-rcs-hooks.el, under the name + Move into vc-rcs-hooks.el, under the name vc-rcs-consult-headers. * vc-cvs-hooks.el (vc-cvs-workfile-version): Don't consult RCS @@ -13638,7 +13638,7 @@ New functions. * vc-hooks.el (vc-master-locks, vc-master-locking-user): - Moved into both + Move into both vc-rcs-hooks.el and vc-sccs-hooks.el. These properties and access functions are implementation details of those two backends. @@ -13654,31 +13654,31 @@ * vc-cvs-hooks.el (vc-cvs-fetch-master-properties): CVS-specific code moved here from vc-hooks. - * vc-hooks.el (vc-parse-locks, vc-fetch-master-properties): Split - into back-end specific parts and removed. Callers not updated + * vc-hooks.el (vc-parse-locks, vc-fetch-master-properties): + Split into back-end specific parts and removed. Callers not updated yet; because I guess these callers will disappear into back-end specific files anyway. 2000-09-04 Andre Spiegel <spiegel@inf.fu-berlin.de> * vc.el (with-vc-file, vc-next-action-on-file, vc-merge) - (vc-backend-checkout): Changed calls to `vc-checkout-model' to + (vc-backend-checkout): Change calls to `vc-checkout-model' to `vc-uses-locking'. - * vc-hooks.el (vc-checkout-model): Renamed to vc-uses-locking. + * vc-hooks.el (vc-checkout-model): Rename to vc-uses-locking. Store yes/no in the property, and return t/nil. Updated all callers. - * vc-sccs-hooks.el (vc-sccs-checkout-model): Renamed to + * vc-sccs-hooks.el (vc-sccs-checkout-model): Rename to vc-sccs-uses-locking. Don't set property. (vc-sccs-locking-user): Don't set property. - * vc-cvs-hooks.el (vc-cvs-checkout-model): Renamed to + * vc-cvs-hooks.el (vc-cvs-checkout-model): Rename to vc-cvs-uses-locking. Don't set property here; leave that to vc-hooks. (vc-cvs-locking-user): Reflect above change. Streamlined. - * vc-rcs-hooks.el (vc-rcs-checkout-model): Renamed to + * vc-rcs-hooks.el (vc-rcs-checkout-model): Rename to vc-rcs-uses-locking. (vc-rcs-locking-user): Reflect above change. @@ -13709,36 +13709,36 @@ 2000-09-04 Dave Love <fx@gnu.org> * vc-hooks.el (vc-rcsdiff-knows-brief, vc-rcs-lock-from-diff) - (vc-master-workfile-version): Moved from vc-hooks. + (vc-master-workfile-version): Move from vc-hooks. * vc-rcs-hooks.el: Fix duplicate code in last change. * vc-rcs-hooks.el: Require vc-hooks when compiling. (vc-rcs-master-templates): Improve :type. (vc-rcsdiff-knows-brief, vc-rcs-lock-from-diff) - (vc-master-workfile-version): Moved from vc-hooks. + (vc-master-workfile-version): Move from vc-hooks. * vc-sccs-hooks.el: Require vc-hooks when compiling. (vc-sccs-master-templates): Improve :type. (vc-sccs-lock-file): Moved/renamed from vc-hooks.el vc-lock-file. - * vc-hooks.el (vc-lock-file): Moved to vc-sccs-hooks and renamed. + * vc-hooks.el (vc-lock-file): Move to vc-sccs-hooks and renamed. * vc-cvs-hooks.el: Require vc-hooks when compiling. - (vc-cvs-master-templates): Improve :type. Use - vc-cvs-find-cvs-master. - (vc-handle-cvs, vc-cvs-parse-status, vc-cvs-status): Moved here + (vc-cvs-master-templates): Improve :type. + Use vc-cvs-find-cvs-master. + (vc-handle-cvs, vc-cvs-parse-status, vc-cvs-status): Move here from vc-hooks. - (vc-vc-find-cvs-master): Renamed to vc-cvs-find-cvs-master. + (vc-vc-find-cvs-master): Rename to vc-cvs-find-cvs-master. * vc-hooks.el (vc-handle-cvs, vc-cvs-parse-status, vc-cvs-status): - Moved to vc-cvs-hooks. + Move to vc-cvs-hooks. * vc-hooks.el: Add doc strings in various places. Simplify the minor mode setup. (vc-handled-backends): New user variable. - (vc-parse-buffer, vc-insert-file, vc-default-registered): Minor - simplification. + (vc-parse-buffer, vc-insert-file, vc-default-registered): + Minor simplification. 2000-09-04 Dave Love <fx@gnu.org> @@ -13796,11 +13796,11 @@ 2000-09-04 Dave Love <fx@gnu.org> - * mouse.el (mouse-major-mode-menu, mouse-popup-menubar): Run - menu-bar-update-hook. + * mouse.el (mouse-major-mode-menu, mouse-popup-menubar): + Run menu-bar-update-hook. - * help.el (help-manyarg-func-alist): Add - find-operation-coding-system. + * help.el (help-manyarg-func-alist): + Add find-operation-coding-system. * wid-edit.el (widget-sexp-validate): Fix garbled code. @@ -13823,7 +13823,7 @@ 2000-09-01 John Wiegley <johnw@gnu.org> - * pcomplete.el (pcomplete-dirs-or-entries): Added a missing + * pcomplete.el (pcomplete-dirs-or-entries): Add a missing predicate, which caused entries in the completion list to be doubled. @@ -13843,8 +13843,8 @@ 2000-08-28 John Wiegley <johnw@gnu.org> - * eshell/esh-var.el (pcomplete/eshell-mode/unset): Added - completion function for Eshell's implementation of `unset'. + * eshell/esh-var.el (pcomplete/eshell-mode/unset): + Add completion function for Eshell's implementation of `unset'. 2000-09-02 Eli Zaretskii <eliz@is.elta.co.il> @@ -13863,8 +13863,8 @@ 2000-08-30 Andrew Innes <andrewi@gnu.org> * timer.el (run-with-idle-timer): Undo last change, so that timer - is not activated immediately if Emacs is already idle. Some - existing code relies on this behavior. + is not activated immediately if Emacs is already idle. + Some existing code relies on this behavior. 2000-08-30 Miles Bader <miles@gnu.org> @@ -13924,22 +13924,22 @@ * help.el (help-xref-mule-regexp): New variable. (help-make-xrefs): Handle help-xref-mule-regexp. - * international/mule-cmds.el (help-xref-mule-regexp-template): New - variable. + * international/mule-cmds.el (help-xref-mule-regexp-template): + New variable. (describe-input-method): Temporarily activate the specified input method to display the information. (describe-language-environment): Hyperlinks to mule related items. - * international/mule-diag.el (charset-multibyte-form-string): New - function. + * international/mule-diag.el (charset-multibyte-form-string): + New function. (list-character-sets-1): Use charset-multibyte-form-string. (describe-character-set): New function. (describe-coding-system): Hyperlinks to safe character sets. * international/quail.el (quail-help): New arg PACKAGE. Hyperlinks to mule related items. - (quail-help-insert-keymap-description): Use - substitute-command-keys instead of describe-bindings. + (quail-help-insert-keymap-description): + Use substitute-command-keys instead of describe-bindings. (quail-translation-help): Hyperlinks to mule related items. 2000-08-28 John Wiegley <johnw@gnu.org> @@ -13948,7 +13948,7 @@ have a defsubst call itself. Made `eshell-flatten-list' back into a function again. - * eshell/em-smart.el (eshell-smart-redisplay): Added a safety + * eshell/em-smart.el (eshell-smart-redisplay): Add a safety catch, in case re-centering point at bottom messes up the display. This happens frequently in Emacs 21, due I believe to variable line heights. @@ -13978,11 +13978,11 @@ (eshell-copy-handles): Created a new macro for duplicating the current set of open handles. This is needed by the looping functions. - (eshell-do-eval): Fixed while and if, so that the eshell-test-body + (eshell-do-eval): Fix while and if, so that the eshell-test-body is not incorrectly stomped on. - * eshell/em-cmpl.el (eshell-cmpl-use-paring): Mirror - declaration for pcomplete-use-paring. + * eshell/em-cmpl.el (eshell-cmpl-use-paring): + Mirror declaration for pcomplete-use-paring. (eshell-cmpl-initialize): Set pcomplete-use-paring based on the value of eshell-cmpl-use-paring. * pcomplete.el (pcomplete-use-paring): New config variable, to @@ -13990,7 +13990,7 @@ (pcomplete-do-complete): If pcomplete-use-paring is t, pare out completion alternatives that have already been used. - * eshell/esh-mode.el (eshell-repeat-argument): Added function, + * eshell/esh-mode.el (eshell-repeat-argument): Add function, bound to C-c C-y, which will repeat the previous N arguments (based on prefix argument). (eshell-mode): Bind C-c C-y to eshell-repeat-argument. @@ -14001,8 +14001,8 @@ name to delete is. * eshell/esh-util.el (eshell-read-passwd-file): Only keep the - first entry that correlates to a passwd/group number. Later - entries (used for group/user name aliasing to multiple IDs) are + first entry that correlates to a passwd/group number. + Later entries (used for group/user name aliasing to multiple IDs) are ignored. * eshell/em-xtra.el (eshell/expr): @@ -14011,7 +14011,7 @@ * eshell/em-dirs.el (eshell-dirs-substitute-cd): Flatten the argument list, before passing it to the system command. - * eshell/esh-mode.el (eshell-find-tag): Added a special version of + * eshell/esh-mode.el (eshell-find-tag): Add a special version of `find-tag' for use at final position in Eshell buffers (which otherwise triggers an error on Emacs 21). (eshell-mode): Bind M-. to `eshell-find-tag' with the Eshell @@ -14030,10 +14030,10 @@ types RET after an open delimiter (like "), display a message indicating that Eshell is waiting for the closing delimiter. - * eshell/esh-var.el (eshell/unset): Added a command for unsetting + * eshell/esh-var.el (eshell/unset): Add a command for unsetting environment variables. - * eshell/em-unix.el (eshell/diff): Added logic to fail more + * eshell/em-unix.el (eshell/diff): Add logic to fail more gracefully if the user enters incorrect arguments. * eshell/esh-mode.el (eshell-mode): Disable auto-fill-function in @@ -14046,7 +14046,7 @@ * eshell/em-ls.el (eshell-ls-decorated-name): Use /= instead of (not (= ...)). - * eshell/em-unix.el (eshell-shuffle-files): Added use of `apply', + * eshell/em-unix.el (eshell-shuffle-files): Add use of `apply', to ensure the `preserve' flag gets propagated when doing recursive directory copies. @@ -14059,15 +14059,15 @@ 2000-08-28 Eli Zaretskii <eliz@is.elta.co.il> - * eshell/esh-util.el (eshell-processp): Added to relieve constant + * eshell/esh-util.el (eshell-processp): Add to relieve constant testing of `fboundp' on `processp'. * eshell/esh-proc.el (eshell/kill): Use eshell-processp. (eshell/jobs): Don't call process-list if it is not bound. (eshell-gather-process-output): Support systems where async subprocesses aren't supported. - (eshell-scratch-buffer, eshell-last-sync-output-start): New - variables. + (eshell-scratch-buffer, eshell-last-sync-output-start): + New variables. * eshell/esh-cmd.el (eshell-resume-eval): Handle the case when eshell-do-eval returns t. @@ -14082,8 +14082,8 @@ * eshell/esh-io.el (eshell-virtual-targets): Doc fix. (eshell-close-target, eshell-get-target): Use eshell-processp. - (eshell-print, eshell-error, eshell-errorn, eshell-printn): Doc - fix. + (eshell-print, eshell-error, eshell-errorn, eshell-printn): + Doc fix. (eshell-get-target, eshell-create-handles): Doc fix. 2000-08-28 Miles Bader <miles@lsi.nec.co.jp> @@ -14173,15 +14173,15 @@ 2000-08-25 Kenichi Handa <handa@etl.go.jp> - * terminal.el (terminal-emulator): Fix args to `concat'. Now - concat doesn't accept integer. + * terminal.el (terminal-emulator): Fix args to `concat'. + Now concat doesn't accept integer. - * international/kkc.el: Remove SKK from Keywords. Require - ja-dic-utl instead of skkdic-utl. + * international/kkc.el: Remove SKK from Keywords. + Require ja-dic-utl instead of skkdic-utl. * international/ja-dic-cnv.el: Renamed from skkdic-cnv.el. Provide ja-dic-cnv instead of skkdic-cnv. - (ja-dic-filename): Renamed from skkdic-filename. Referrers changed. + (ja-dic-filename): Rename from skkdic-filename. Referrers changed. (iso-2022-7bit-short): Add safe-charsets property. (skkdic-convert-postfix): Search Japanese chou-on character in addition to Hiragana character. @@ -14208,8 +14208,8 @@ 2000-08-24 Kenichi Handa <handa@etl.go.jp> - * international/mule-cmds.el (reset-language-environment): Set - default-process-coding-system to '(undecided . iso-latin-1), which + * international/mule-cmds.el (reset-language-environment): + Set default-process-coding-system to '(undecided . iso-latin-1), which makes process I/O almost consistent with file I/O. Call this function when mule-cmds.el[c] is loaded. @@ -14318,8 +14318,8 @@ * comint.el (comint-output-filter): Save the point with a marker, not just a buffer position. - * international/mule.el (set-buffer-process-coding-system): Make - interactive prompt less confusing. + * international/mule.el (set-buffer-process-coding-system): + Make interactive prompt less confusing. 2000-08-19 Gerd Moellmann <gerd@gnu.org> @@ -14358,8 +14358,8 @@ 2000-08-18 Gerd Moellmann <gerd@gnu.org> - * textmodes/ispell.el (ispell-dictionary-alist-6): Add - `portugues'. + * textmodes/ispell.el (ispell-dictionary-alist-6): + Add `portugues'. * bindings.el (esc-map): Bind `C-delete' and `C-backspace' to backward-kill-sexp, analogous to kill-sexp. @@ -14372,18 +14372,18 @@ * ispell.el: Set to standard author/maintainer/keyword fields. Fine tuning to menu map appearance and operation, and added help. Remove `start' and `end' error messages when compiling. - (ispell-choices-win-default-height): Fixed comment string. - (ispell-dictionary-alist-1): Fixed regexp in castellano and + (ispell-choices-win-default-height): Fix comment string. + (ispell-dictionary-alist-1): Fix regexp in castellano and castellano8 dictionaries. - (ispell-dictionary-alist-3): Fixed regexp in francais dictionary. - (ispell-dictionary-alist-4): Fixed regexp in francais-tex + (ispell-dictionary-alist-3): Fix regexp in francais dictionary. + (ispell-dictionary-alist-4): Fix regexp in francais-tex dictionary, added italiano dictionary. - (ispell-skip-region-alist): Removed regexp thrashing when `-' is a + (ispell-skip-region-alist): Remove regexp thrashing when `-' is a word character. - (ispell-tex-skip-alists): Added psfig support. - (ispell-skip-html): Renamed from ispell-skip-sgml. + (ispell-tex-skip-alists): Add psfig support. + (ispell-skip-html): Rename from ispell-skip-sgml. (ispell-begin-skip-region-regexp, ispell-skip-region) - (ispell-minor-check): Improved html skipping support to skip across + (ispell-minor-check): Improve html skipping support to skip across code, and recognize `&' commands without proper `;' syntax. (ispell-process-line): Fix alignment error when manually correcting spelling. @@ -14397,8 +14397,8 @@ shell-command-on-region as in format-decode-run-method because shell-command-on-region can display a buffer with error output. (format-decode): Don't record undo information for the decoding. - (format-annotate-function): Add parameter FORMAT-COUNT. Make - that number part of the temporary buffer name so that more than + (format-annotate-function): Add parameter FORMAT-COUNT. + Make that number part of the temporary buffer name so that more than one decoding using a temporary buffer can happen safely. * enriched.el (enriched-annotation-regexp): Use `A-Z' instead @@ -14571,16 +14571,16 @@ 2000-08-15 Miles Bader <miles@gnu.org> * textmodes/ispell.el (ispell-graphic-p): New constant. - (ispell-choices-win-default-height, ispell-help): Use - `ispell-graphic-p' instead of `xemacsp'. + (ispell-choices-win-default-height, ispell-help): + Use `ispell-graphic-p' instead of `xemacsp'. 2000-08-15 Dave Love <fx@gnu.org> * simple.el: Autoload widget-convert when compiling. (mail-user-agent): Doc fix. - * help.el (function-called-at-point, variable-at-point): Use - with-syntax-table. + * help.el (function-called-at-point, variable-at-point): + Use with-syntax-table. (help-manyarg-func-alist): Add insert-and-inherit. * thingatpt.el (thing-at-point-url-regexp): Prepend `\<'. @@ -14589,7 +14589,7 @@ * find-file.el: Doc fixes. Move provide to end. (ff) <defgroup>: Add :link. - (ff-goto-click): Deleted. + (ff-goto-click): Delete. (ff-mouse-find-other-file, ff-mouse-find-other-file-other-window): Use mouse-set-point. @@ -14615,8 +14615,8 @@ Doze and Dog. (browse-url): Use dolist, not mapcar. (browse-url-at-point): Check for null url. - (browse-url-event-buffer, browse-url-event-point): Functions - deleted. + (browse-url-event-buffer, browse-url-event-point): + Functions deleted. (browse-url-at-mouse, browse-url-netscape): Simplify. * msb.el (msb--few-menus, msb--very-many-menus): Use current Gnus @@ -14724,7 +14724,7 @@ (comint-snapshot-last-prompt): New function. (comint-send-input): Snapshot the last prompt. Use comint-highlight-input-face. - (comint-highlight-input-face): Renamed from `comint-highlight-face'. + (comint-highlight-input-face): Rename from `comint-highlight-face'. Use defface instead of defcustom. (send-invisible, comint-send-eof): Snapshot the last prompt. (comint-delchar-or-maybe-eof): Use comint-send-eof. @@ -14785,8 +14785,8 @@ * emacs-lisp/lisp-mode.el (eval-last-sexp-1): Handle `#N=' labels. - * help.el (print-help-return-message): When - display-buffer-reuse-frames is set, let the help window been quit, + * help.el (print-help-return-message): + When display-buffer-reuse-frames is set, let the help window been quit, instead of deleting it, which might delete a reused frame. 2000-08-08 Eli Zaretskii <eliz@is.elta.co.il> @@ -14807,7 +14807,7 @@ * emacs-lisp/cl-indent.el (toplevel): Indent `defclass', `defconst', `define-condition', `with-slots'. - * font-lock.el (lisp-font-lock-keywords-2): Added `with-' and `do-'. + * font-lock.el (lisp-font-lock-keywords-2): Add `with-' and `do-'. 2000-08-03 Miles Bader <miles@gnu.org> @@ -14826,16 +14826,16 @@ properties if comint-use-prompt-regexp-instead-of-fields is nil. (comint-line-beginning-position): New function. (comint-bol): Use comint-line-beginning-position. Make ARG optional. - (comint-replace-by-expanded-history-before-point): Use - comint-line-beginning-position and line-end-position. + (comint-replace-by-expanded-history-before-point): + Use comint-line-beginning-position and line-end-position. (comint-last-output-overlay): New variable. (comint-mode): Make `comint-last-output-overlay' buffer-local. * shell.el (shell-prompt-pattern): Doc change. (shell-backward-command): Use line-beginning-position. - * gud.el (gud-gdb-complete-command): Use - comint-line-beginning-position. + * gud.el (gud-gdb-complete-command): + Use comint-line-beginning-position. * ielm.el (ielm-indent-line): Detect a "prompt" line by seeing if comint-bol doesn't actually go to the beginning of the line. @@ -14849,13 +14849,13 @@ (sql-copy-column): Use comint-line-beginning-position instead of explicitly matching comint-prompt-regexp. - * progmodes/octave-inf.el (inferior-octave-complete): Use - comint-line-beginning-position. + * progmodes/octave-inf.el (inferior-octave-complete): + Use comint-line-beginning-position. * progmodes/inf-lisp.el (inferior-lisp-prompt): Doc change. - * progmodes/idlw-shell.el (idlwave-shell-send-command): When - looking for a prompt, use `forward-line 0' instead of + * progmodes/idlw-shell.el (idlwave-shell-send-command): + When looking for a prompt, use `forward-line 0' instead of `beginning-of-line', to avoid getting caught by an input field. 2000-08-07 Gerd Moellmann <gerd@gnu.org> @@ -14926,8 +14926,8 @@ 2000-08-03 Eli Zaretskii <eliz@is.elta.co.il> - * international/mule-cmds.el (select-safe-coding-system): Make - the message text about selecting a safe coding system more clear. + * international/mule-cmds.el (select-safe-coding-system): + Make the message text about selecting a safe coding system more clear. 2000-08-02 Gerd Moellmann <gerd@gnu.org> @@ -14951,8 +14951,8 @@ 2000-08-02 Eli Zaretskii <eliz@is.elta.co.il> - * progmodes/ebrowse.el (ebrowse-tree-mode-map): Use - display-mouse-p instead of window-system. + * progmodes/ebrowse.el (ebrowse-tree-mode-map): + Use display-mouse-p instead of window-system. (ebrowse-member-mode-map): Ditto. 2000-08-01 Vinicius Jose Latorre <vinicius@cpqd.com.br> @@ -14968,8 +14968,8 @@ font lock support on window-system. (ftp-font-lock-keywords, smbclient-font-lock-keywords): Likewise. - * textmodes/ispell.el (ispell-highlight-spelling-error): Use - display-color-p, if fboundp, instead of window-system. + * textmodes/ispell.el (ispell-highlight-spelling-error): + Use display-color-p, if fboundp, instead of window-system. 2000-07-31 Eli Zaretskii <eliz@is.elta.co.il> @@ -15060,8 +15060,8 @@ * subr.el (remove, remq): New functions. - * midnight.el (clean-buffer-list-kill-never-regexps): Correctly - escape `*' in regexps. + * midnight.el (clean-buffer-list-kill-never-regexps): + Correctly escape `*' in regexps. (midnight-find): Reverse order of arguments in the funcall of TEST. @@ -15072,12 +15072,12 @@ 2000-07-27 Alex Schroeder <alex@gnu.org> - * sql.el (sql-ms): Added autoload cookie. + * sql.el (sql-ms): Add autoload cookie. (sql-ingres, sql-solid, sql-mysql, sql-informix, sql-sybase) (sql-oracle): Ditto. (sql-help): Doc change. - (sql-mode-oracle-font-lock-keywords): Added PL/SQL keywords, data + (sql-mode-oracle-font-lock-keywords): Add PL/SQL keywords, data types and exceptions. 2000-07-27 Alex Schroeder <alex@gnu.org> @@ -15112,11 +15112,11 @@ (find-coding-systems-region-subset-p): This function deleted. (sort-coding-systems-predicate): New variable. (sort-coding-systems): New function. - (find-coding-systems-region): Use - find-coding-systems-region-internal. + (find-coding-systems-region): + Use find-coding-systems-region-internal. (find-coding-systems-string): Use find-coding-systems-region. - (find-coding-systems-for-charsets): Check - char-coding-system-table. + (find-coding-systems-for-charsets): + Check char-coding-system-table. (select-safe-coding-system-accept-default-p): New variable. (select-safe-coding-system): Mostly rewritten. New argument ACCEPT-DEFAULT-P. @@ -15148,29 +15148,29 @@ * net/ange-ftp.el (ange-ftp-file-newer-than-file-p): New function. (ange-ftp-real-file-newer-than-file-p): New function. (ange-ftp-verify-visited-file-modtime): Use `float-time'. - (ange-ftp-dot-to-slash): Removed (use `subst-char-in-string'). + (ange-ftp-dot-to-slash): Remove (use `subst-char-in-string'). - * tooltip.el (tooltip-float-time): Removed (use `float-time'). + * tooltip.el (tooltip-float-time): Remove (use `float-time'). * midnight.el (midnight-float-time): Ditto. 2000-07-26 Andreas Schwab <schwab@suse.de> - * files.el (normal-backup-enable-predicate): Correct - interpretation of the return value of compare-strings. + * files.el (normal-backup-enable-predicate): + Correct interpretation of the return value of compare-strings. 2000-07-26 Gerd Moellmann <gerd@gnu.org> * isearch.el (isearch-resume): New function. (isearch-done): Add something to command-history to resume the search. - (isearch-yank-line, isearch-yank-word): Use - buffer-substring-no-properties instead of buffer-substring. + (isearch-yank-line, isearch-yank-word): + Use buffer-substring-no-properties instead of buffer-substring. * textmodes/flyspell.el (flyspell-mouse-map): Use `map' instead of flyspell-mouse-map. - * progmodes/make-mode.el (makefile-mode-abbrev-table): Remove - duplicate definition. + * progmodes/make-mode.el (makefile-mode-abbrev-table): + Remove duplicate definition. (makefile-mode): Remove duplicate setting of local-abbrev-table. * progmodes/m4-mode.el (m4-mode-abbrev-table): New variable. @@ -15186,8 +15186,8 @@ (ange-ftp-dot-to-slash): New function. (ange-ftp-fix-name-for-vms): Use it. - * midnight.el (midnight-buffer-display-time): Use - `with-current-buffer'. + * midnight.el (midnight-buffer-display-time): + Use `with-current-buffer'. 2000-07-25 Gerd Moellmann <gerd@gnu.org> @@ -15251,17 +15251,17 @@ 2000-07-24 Francis Wright <fjw@maths.qmw.ac.uk> - * dired.el (dired-sort-R-check): Added to allow recursive listing + * dired.el (dired-sort-R-check): Add to allow recursive listing to be undone. (dired-sort-other): Use it. -2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-07-24 Martin Stjernholm <mast@lysator.liu.se> * Release of cc-mode 5.27 -2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-07-24 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-engine.el (c-looking-at-inexpr-block): Replaced a call to + * progmodes/cc-engine.el (c-looking-at-inexpr-block): Replace a call to c-beginning-of-statement-1 that caused a bad case of recursion which could consume a lot of CPU in large classes in languages that have in-expression classes (i.e. Java and Pike). @@ -15271,7 +15271,7 @@ before case 5 and is now case 4) to catch in-expression classes in top level expressions correctly. -2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-07-24 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-guess-basic-syntax): Less naive handling of objc-method-intro. Case 4 removed and case 5I added. @@ -15285,40 +15285,40 @@ * progmodes/cc-mode.el (java-mode): Use c-append-paragraph-start to initialize paragraph-start for javadoc markup. - * progmodes/cc-vars.el (c-style-variables-are-local-p): Incompatible - change by defaulting this to t. It's motivated by the + * progmodes/cc-vars.el (c-style-variables-are-local-p): + Incompatible change by defaulting this to t. It's motivated by the confusing behavior that otherwise arise from the style system when editing both java and non-java files at the same time (see the comments about style setting in c-common-init). -2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-07-24 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-cmds.el (c-indent-new-comment-line): Added a kludge + * progmodes/cc-cmds.el (c-indent-new-comment-line): Add a kludge similar to the one in c-fill-paragraph to check the fill prefix from the adaptive fill function for sanity. -2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-07-24 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-defs.el (c-end-of-defun-1): Fixed forward scanning into + * progmodes/cc-defs.el (c-end-of-defun-1): Fix forward scanning into defun block. -2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-07-24 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-align.el (c-lineup-multi-inher): Handle lines with leading comma nicely. Extended to handle member initializers too. * progmodes/cc-engine.el (c-beginning-of-inheritance-list) - (c-guess-basic-syntax): Fixed recognition of inheritance lists + (c-guess-basic-syntax): Fix recognition of inheritance lists when the lines begins with a comma. - * progmodes/cc-vars.el (c-offsets-alist): Changed default for + * progmodes/cc-vars.el (c-offsets-alist): Change default for member-init-cont to c-lineup-multi-inher since it now handles member initializers and indents better for leading commas. -2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-07-24 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-cmds.el (c-electric-brace): Fixed some bugs in the state + * progmodes/cc-cmds.el (c-electric-brace): Fix some bugs in the state handling that caused class open lines to be recognized as statement-conts in some cases. @@ -15326,10 +15326,10 @@ guessed by the adaptive fill function unless point is on the first line of a block comment. - * progmodes/cc-engine.el (c-forward-syntactic-ws): Fixed an infloop bug + * progmodes/cc-engine.el (c-forward-syntactic-ws): Fix an infloop bug when the buffer ends with a macro continuation char. - * progmodes/cc-engine.el (c-guess-basic-syntax): Added support for + * progmodes/cc-engine.el (c-guess-basic-syntax): Add support for function definitions as statements in Pike. The first statement in a lambda block is now labeled defun-block-intro instead of statement-block-intro. @@ -15338,61 +15338,61 @@ so that the class surrounding point is selected, not the one innermost in the state. - * progmodes/cc-engine.el (c-guess-basic-syntax): Fixed bug in + * progmodes/cc-engine.el (c-guess-basic-syntax): Fix bug in recognition of switch labels having hanging multiline statements. * progmodes/cc-engine.el (c-beginning-of-member-init-list): Broke out some code in c-guess-basic-syntax to a separate function. - * progmodes/cc-engine.el (c-just-after-func-arglist-p): Fixed - recognition of member inits with multiple line arglists. + * progmodes/cc-engine.el (c-just-after-func-arglist-p): + Fix recognition of member inits with multiple line arglists. * progmodes/cc-engine.el (c-guess-basic-syntax): New case 5B.3 to detect member-init-cont when the commas are in funny places. -2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-07-24 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-defs.el (c-auto-newline): Removed this macro since it's + * progmodes/cc-defs.el (c-auto-newline): Remove this macro since it's not used anymore. * progmodes/cc-engine.el (c-looking-at-bos): New helper function. * progmodes/cc-engine.el (c-looking-at-inexpr-block): More tests to tell inexpr and toplevel classes apart in Pike. - * progmodes/cc-engine.el (c-guess-basic-syntax): Fixed bogus recognition + * progmodes/cc-engine.el (c-guess-basic-syntax): Fix bogus recognition of case 9A. * progmodes/cc-langs.el, progmodes/cc-mode.el (c-Pike-inexpr-class-key): New constant, since "class" can introduce an in-expression class in Pike nowadays. -2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-07-24 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-align.el (c-gnu-impose-minimum): Don't impose minimum indentation on cpp-macro lines. * progmodes/cc-engine.el (c-guess-basic-syntax): Made the cpp-macro a syntax modifier like comment-intro, to make it possible to - get syntactic indentation for preprocessor directives. It's - incompatible wrt to lineup functions on cpp-macro, but it has + get syntactic indentation for preprocessor directives. + It's incompatible wrt to lineup functions on cpp-macro, but it has no observable effect in the 99.9% common case where cpp-macro is set to -1000. -2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-07-24 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-engine.el (c-guess-basic-syntax): Fixed bug with missed + * progmodes/cc-engine.el (c-guess-basic-syntax): Fix bug with missed member-init-cont when the preceding arglist is several lines. -2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-07-24 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-styles.el (c-style-alist): The basic offset for the BSD style corrected to 8. -2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-07-24 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-styles.el (c-style-alist): Adjusted the indentation of + * progmodes/cc-styles.el (c-style-alist): Adjust the indentation of brace list openers in the gnu style. -2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-07-24 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-indent-command): Obey c-syntactic-indentation. @@ -15401,53 +15401,53 @@ (c-electric-lt-gt, c-electric-paren): Don't reindent old lines when c-syntactic-indentation is nil. - * progmodes/cc-engine.el (c-beginning-of-statement-1): Fixed bug where + * progmodes/cc-engine.el (c-beginning-of-statement-1): Fix bug where we were left at comments preceding the first statement when reaching the beginning of the buffer. * progmodes/cc-vars.el (c-syntactic-indentation): New variable to turn off all syntactic indentation. -2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-07-24 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-fill-paragraph): Keep one or two spaces between the text and the block comment ender when it hangs, depending on how many there are before the fill. -2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-07-24 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-engine.el (c-beginning-of-closest-statement): New helper function to go back to the closest preceding statement start, which could be inside a conditional statement. - * progmodes/cc-engine.el (c-guess-basic-syntax): Use - c-beginning-of-closest-statement in cases 10B.2, 17B and 17C. + * progmodes/cc-engine.el (c-guess-basic-syntax): + Use c-beginning-of-closest-statement in cases 10B.2, 17B and 17C. * progmodes/cc-engine.el (c-guess-basic-syntax): Better handling of arglist-intro, arglist-cont-nonempty and arglist-close when the arglist is nested inside parens. Cases 7A, 7C and 7F changed. - * progmodes/cc-langs.el (c-Java-javadoc-paragraph-start): Brought - up-to-date with javadoc 1.2. + * progmodes/cc-langs.el (c-Java-javadoc-paragraph-start): + Brought up-to-date with javadoc 1.2. -2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-07-24 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-engine.el (c-beginning-of-statement-1): Fixed handling of + * progmodes/cc-engine.el (c-beginning-of-statement-1): Fix handling of multiline Pike type decls. -2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-07-24 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-indent-new-comment-line): Always break multiline comments in multiline mode, regardless of comment-multi-line. -2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-07-24 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-engine.el (c-guess-basic-syntax): Fixed bug with + * progmodes/cc-engine.el (c-guess-basic-syntax): Fix bug with fully::qualified::names in C++ member init lists. Preamble in case 5D changed. -2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-07-24 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-langs.el (c-common-init): Handling of obsolete variables moved to c-initialize-cc-mode. More compatible style override @@ -15471,16 +15471,16 @@ that duplicate entries in styles have the same effect regardless of DONT-OVERRIDE. - * progmodes/cc-styles.el (c-set-style-2): Fixed bug where the + * progmodes/cc-styles.el (c-set-style-2): Fix bug where the initialization of inheriting styles failed when the dont-override flag is set. * progmodes/cc-vars.el (c-special-indent-hook): Don't use set-from-style on this. -2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-07-24 Martin Stjernholm <mast@lysator.liu.se> - * progmodes/cc-defs.el (c-forward-comment): Removed the workaround + * progmodes/cc-defs.el (c-forward-comment): Remove the workaround introduced in 5.38 since it had worse side-effects. If a line contains the string "//\"", it regarded the // as a comment start since the \ temporarily doesn't have escape syntax. @@ -15520,9 +15520,9 @@ paragraphs on the first or last line of a file. (ada-format-paramlist): Fix handling of default parameter values. (ada-get-body-name): New function. - (ada-get-current-indent): Optimized by searching directly for an - existing generic part or a statement outside of it. Handle - ada-indent-align-comments when indenting comments Replaced some + (ada-get-current-indent): Optimize by searching directly for an + existing generic part or a statement outside of it. + Handle ada-indent-align-comments when indenting comments Replaced some regexps by testing directly the next character. This results in a huge speedup on some files. New indentation scheme for renames statements. Stop looking for the 'while' or 'for' associated with @@ -15582,7 +15582,7 @@ (ada-add-ada-menu): Remove the map and name parameters. Add the Ada Reference Manual to the menu. (ada-check-current): Rewritten as a call to ada-compile-current. - (ada-compile): Removed. + (ada-compile): Remove. (ada-compile-application, ada-compile-current, ada-check-current): Set the compilation-search-path so that compile.el automatically finds the sources in src_dir. Automatic scrolling of the @@ -15596,7 +15596,7 @@ (ada-find-file-in-dir): New function. (ada-find-references): Set the environment variables for gnatfind. (ada-find-src-file-in-dir): New function. - (ada-first-non-nil): Removed. + (ada-first-non-nil): Remove. (ada-gdb-application): Add support for jdb, the java debugger. (ada-get-ada-file-name): Load the original-file first if not done yet. @@ -15614,20 +15614,20 @@ compilation-search-path,... Add the standard runtime library to the search path for find-file. (ada-prj-default-debugger): Was missing an opening '{'. - (ada-prj-default-bind-opt, ada-prj-default-link-opt): New - variables. + (ada-prj-default-bind-opt, ada-prj-default-link-opt): + New variables. (ada-prj-default-gnatmake-opt): New variable. (ada-prj-find-prj-file): Handles non-file buffers For non-Ada buffers, the project file is the default one Save the windows configuration before displaying the menu. - (ada-prj-src-dir, ada-prj-obj-dir, ada-prj-comp-opt,...): Removed. + (ada-prj-src-dir, ada-prj-obj-dir, ada-prj-comp-opt,...): Remove. (ada-read-identifier): Fix xrefs on operators (for "mod", "and", ...) regexp-quote identifiers names to support operators +, -,... in regexps. (ada-remote): New function. (ada-run-application): Erase the output buffer before starting the - run Support remote execution of the application. Use - call-process, or the arguments are incorrectly parsed. + run Support remote execution of the application. + Use call-process, or the arguments are incorrectly parsed. (ada-set-default-project-file): Reread the content of the active project file, not the one from the current buffer When a project file is set as the default project, all directories are @@ -15807,7 +15807,7 @@ * net/goto-addr.el: Change maintainer to FSF. - * info.el (Info-title-face-alist): Removed. + * info.el (Info-title-face-alist): Remove. 2000-07-18 David Ponce <david@dponce.com> @@ -15876,13 +15876,13 @@ * align.el (align-newline-and-indent): Adding new function, for auto-aligning blocks of code on RET. - (align-region): Fixed badly formatted minibuffer message. + (align-region): Fix badly formatted minibuffer message. 2000-07-17 Kenichi Handa <handa@etl.go.jp> * international/kkc.el (kkc-show-conversion-list-count): Customize it. - (kkc-region): Update kkc-next-count and kkc-prev-count here. Show - the conversion list at first if appropriate. + (kkc-region): Update kkc-next-count and kkc-prev-count here. + Show the conversion list at first if appropriate. (kkc-next): Don't update kkc-next-count here. (kkc-prev): Don't update kkc-prev-count here. (kkc-show-conversion-list-update): Fix setting up of conversion @@ -15897,8 +15897,8 @@ * cus-edit.el (custom-buffer-create-internal): Use a help-echo function to be more specific. - * wid-edit.el (widget-specify-field, widget-specify-button): Allow - non-string help-echo. + * wid-edit.el (widget-specify-field, widget-specify-button): + Allow non-string help-echo. (widget-types-convert-widget): Defsubst it. (widget-echo-help): Try to cope with a help-echo function of two possible sorts. @@ -15973,7 +15973,7 @@ Use fortran-comment-indent, not fortran-comment-indent-function. (fortran-comment-region, fortran-electric-line-number): Simplify. (fortran-auto-fill): New function. - (fortran-do-auto-fill): Deleted. + (fortran-do-auto-fill): Delete. (fortran-find-comment-start-skip): Check for non-null comment-start-skip. (fortran-auto-fill-mode, fortran-fill-statement): @@ -15985,8 +15985,8 @@ 2000-07-11 Eli Zaretskii <eliz@is.elta.co.il> - * eshell/esh-module.el (toplevel): Reference - byte-compile-current-file only if it is bound. + * eshell/esh-module.el (toplevel): + Reference byte-compile-current-file only if it is bound. 2000-07-10 Gerd Moellmann <gerd@gnu.org> @@ -16000,7 +16000,7 @@ 2000-07-10 Kenichi Handa <handa@etl.go.jp> - * international/mule-diag.el (describe-font): Adjusted for the + * international/mule-diag.el (describe-font): Adjust for the change of fontset-info. (print-fontset): Likewise. @@ -16039,7 +16039,7 @@ 2000-07-01 Francesco Potortì <pot@gnu.org> - * rmail.el (mail-unsent-separator): Changed "the" to "\\w+", as + * rmail.el (mail-unsent-separator): Change "the" to "\\w+", as exim can use "your message" instead of "the message". 2000-07-06 Stefan Monnier <monnier@cs.yale.edu> @@ -16054,8 +16054,8 @@ 2000-07-05 Michael Kifer <kifer@cs.sunysb.edu> * ediff-diff.el (ediff-wordify): Use syntax table. - * ediff-init.el (ediff-has-face-support-p): Use - ediff-color-display-p. + * ediff-init.el (ediff-has-face-support-p): + Use ediff-color-display-p. (ediff-color-display-p): Use display-color-p, changed to defun from defsubst. Got rid of special cases for NeXT and OS/2. @@ -16076,7 +16076,7 @@ * Makefile.in (DONTCOMPILE): Add comment that the name may not be changed without changing the make-dist script. - * emacs-lisp/cl-extra.el (cl-old-mapc): Removed; don't defalias mapc. + * emacs-lisp/cl-extra.el (cl-old-mapc): Remove; don't defalias mapc. (cl-mapc): Use mapc instead of cl-old-mapc. 2000-07-05 Andrew Innes <andrewi@gnu.org> @@ -16191,8 +16191,8 @@ * mouse.el (mouse-show-mark, mouse-save-then-kill): Don't use window-system. - * man.el (Man-notify-when-ready): Don't use window-system. If - Man-notify-method is newframe, and the display is not + * man.el (Man-notify-when-ready): Don't use window-system. + If Man-notify-method is newframe, and the display is not multi-frame, select the frame created for the man page. (Man-init-defvars): Doc fix. @@ -16268,7 +16268,7 @@ (sql-find-sqli-buffer): Make sure the default-value of sql-buffer is used. - (sql-informix): Added command line parameter "-" to force + (sql-informix): Add command line parameter "-" to force sql-informix-program to use stdout. 2000-06-25 Eli Zaretskii <eliz@is.elta.co.il> @@ -16282,8 +16282,8 @@ 2000-06-23 Dave Love <fx@gnu.org> * font-lock.el (font-lock-support-mode) <defgroup>: Add :version. - (font-lock-fontify-anchored-keywords): Use - line-beginning-position. + (font-lock-fontify-anchored-keywords): + Use line-beginning-position. (global-font-lock-mode): Use mapc. 2000-06-23 Stefan Monnier <monnier@cs.yale.edu> @@ -16341,14 +16341,14 @@ 2000-06-22 Vinicius Jose Latorre <vinicius@cpqd.com.br> * ps-print.el: Fix bug: if ^L is the very first buffer character, - ps-print crashes. New feature: page selection for printing. Create - raw-text-unix coding system for XEmacs. Doc fix. + ps-print crashes. New feature: page selection for printing. + Create raw-text-unix coding system for XEmacs. Doc fix. (ps-print-version): New version number (5.2.3). (ps-plot-region): Bug fix. (ps-setup, ps-init-output-queue, ps-output, ps-begin-job, ps-end-file) (ps-header-sheet, ps-generate, ps-end-job): Code fix. - (ps-restore-selected-pages, ps-selected-pages, ps-print-page-p): New - funs. + (ps-restore-selected-pages, ps-selected-pages, ps-print-page-p): + New funs. (ps-selected-pages, ps-last-selected-pages, ps-first-page) (ps-last-page): New vars. @@ -16363,8 +16363,8 @@ 2000-06-21 Kenichi Handa <handa@etl.go.jp> - * international/mule-cmds.el (set-language-info-alist): Docstring - fixed. + * international/mule-cmds.el (set-language-info-alist): + Docstring fixed. 2000-06-20 Gerd Moellmann <gerd@gnu.org> @@ -16378,7 +16378,7 @@ 2000-06-20 Stefan Monnier <monnier@cs.yale.edu> * jit-lock.el (with-buffer-prepared-for-jit-lock): - Renamed from with-buffer-prepared-for-font-lock and use + Rename from with-buffer-prepared-for-font-lock and use inhibit-modification-hooks rather than setting *-change-functions. Update all functions to use the new name. (jit-lock-first-unfontify-pos): New semantics (and doc). @@ -16395,20 +16395,20 @@ 2000-06-20 Sam Steingold <sds@gnu.org> - * emacs-lisp/cl-indent.el (toplevel): Indent - `print-unreadable-object' properly. Untabify. + * emacs-lisp/cl-indent.el (toplevel): + Indent `print-unreadable-object' properly. Untabify. 2000-06-14 Carsten Dominik <dominik@strw.leidenuniv.nl> * textmodes/reftex.el (reftex-find-citation-regexp-format): Support for bibentry. - (reftex-compile-variables): Fixed problem with end of section-re. + (reftex-compile-variables): Fix problem with end of section-re. * textmodes/reftex-dcr.el (reftex-view-crossref) (reftex-view-crossref-from-bibtex): Deal with changed `reftex-find-citation-regexp-format'. (reftex-view-regexp-match, reftex-view-crossref-from-bibtex): - Replaced `remprop' with `put'. + Replace `remprop' with `put'. (reftex-view-crossref, reftex-view-crossref-when-idle): Support for bibentry. @@ -16490,8 +16490,8 @@ (isearch-minibuffer-input-method-function): These variables deleted. (isearch-with-input-method): Don't use the above variables. - (isearch-process-search-multibyte-characters): Likewise. Call - read-string with the arg INHERIT-INPUT-METHOD t. + (isearch-process-search-multibyte-characters): Likewise. + Call read-string with the arg INHERIT-INPUT-METHOD t. 2000-06-17 Stefan Monnier <monnier@cs.yale.edu> @@ -16546,8 +16546,8 @@ 2000-06-15 Gerd Moellmann <gerd@gnu.org> * info.el (Info-find-in-tag-table-1, Info-find-in-tag-table) - (Info-find-node-in-buffer-1, Info-find-node-in-buffer): New - functions. + (Info-find-node-in-buffer-1, Info-find-node-in-buffer): + New functions. (Info-find-node-2): Try a case-sensitive search first, then do a case-insensitive search. @@ -16575,8 +16575,8 @@ 2000-06-15 Kenichi Handa <handa@etl.go.jp> - * international/mule.el (set-buffer-file-coding-system): Almost - rewritten to handle `undecided' as no-op. + * international/mule.el (set-buffer-file-coding-system): + Almost rewritten to handle `undecided' as no-op. 2000-06-14 Gerd Moellmann <gerd@gnu.org> @@ -16599,8 +16599,8 @@ (tar-subfile-save-buffer): Likewise. * international/mule.el - (after-insert-file-set-buffer-file-coding-system): Call - set-buffer-file-coding-system with the arg FORCE t. + (after-insert-file-set-buffer-file-coding-system): + Call set-buffer-file-coding-system with the arg FORCE t. 2000-06-13 Gerd Moellmann <gerd@gnu.org> @@ -16620,15 +16620,15 @@ 2000-06-13 Eli Zaretskii <eliz@is.elta.co.il> - * frame.el (display-multi-frame-p, display-multi-font-p): New - defaliases for display-graphic-p. + * frame.el (display-multi-frame-p, display-multi-font-p): + New defaliases for display-graphic-p. * hl-line.el: Fixed a typo in commentary. 2000-06-13 Kenichi Handa <handa@etl.go.jp> - * language/tibet-util.el (tibetan-tibetan-to-transcription): Typo - fixed. + * language/tibet-util.el (tibetan-tibetan-to-transcription): + Typo fixed. 2000-06-12 Dave Love <fx@gnu.org> @@ -16709,8 +16709,8 @@ 2000-06-12 Kenichi Handa <handa@etl.go.jp> - * international/mule.el (set-buffer-file-coding-system): If - CODING-SYSTEM is nil, set buffer-file-coding-system to nil + * international/mule.el (set-buffer-file-coding-system): + If CODING-SYSTEM is nil, set buffer-file-coding-system to nil unconditionally. 2000-06-12 Dave Love <fx@gnu.org> @@ -16769,8 +16769,8 @@ * progmodes/executable.el: Byte compile dynamic. (executable-insert): Change custom type. (executable-find): Add autoload cookie. - (executable-make-buffer-file-executable-if-script-p): New - function. After Noah Friedman. + (executable-make-buffer-file-executable-if-script-p): + New function. After Noah Friedman. * files.el (after-save-hook): Customize, with executable-make-buffer-file-executable-if-script-p as an option. @@ -16792,8 +16792,8 @@ 2000-06-08 Dave Love <fx@gnu.org> - * international/mule-cmds.el (select-safe-coding-system): If - DEFAULT-CODING-SYSTEM is not specified, also check the most + * international/mule-cmds.el (select-safe-coding-system): + If DEFAULT-CODING-SYSTEM is not specified, also check the most preferred coding-system if buffer-file-coding-system is `undecided'. From Handa. @@ -16917,8 +16917,8 @@ (ccl-encode-alternativnyj, ccl-encode-alternativnyj-font): Likewise. - * international/mule-diag.el (non-iso-charset-alist): Specify - translation table symbol instead of translation table itself. + * international/mule-diag.el (non-iso-charset-alist): + Specify translation table symbol instead of translation table itself. (list-block-of-chars): CHARSET may be a translation table symbol. * international/mule.el (make-coding-system): If CODING-SYSTEM @@ -16927,9 +16927,9 @@ * international/fontset.el: Use family `proportional' for Tibetan fonts. - * international/ccl.el (ccl-compile-translate-character): Don't - check if Rrr has property translation-table. - (ccl-compile-map-multiple): Modified to avoid compiler warning. + * international/ccl.el (ccl-compile-translate-character): + Don't check if Rrr has property translation-table. + (ccl-compile-map-multiple): Modify to avoid compiler warning. 2000-06-05 Gerd Moellmann <gerd@gnu.org> @@ -16958,7 +16958,7 @@ (sh-help-string-for-variable, sh-guess-basic-offset): Don't quote lambdas. (sh-electric-rparen, sh-electric-hash, sh-search-word): Docstring typo. - (sh-regexp-for-done, sh-kw-alist, sh-kw): Moved to before their use. + (sh-regexp-for-done, sh-kw-alist, sh-kw): Move to before their use. * mail/mh-comp.el (mh-send-sub): Check mh-etc is bound before using it. (mh-letter-mode): Derive from text-mode. @@ -17017,18 +17017,18 @@ 2000-06-02 Dave Love <fx@gnu.org> * wid-edit.el: byte-compile-dynamic since we typically don't use - all the widgets. Don't require cl or widget. Remove - eval-and-compile. Don't autoload finder-commentary. Doc fixes. - (widget-read-event): Removed. Callers changed to use read-event. - (widget-button-release-event-p): Renamed from + all the widgets. Don't require cl or widget. + Remove eval-and-compile. Don't autoload finder-commentary. Doc fixes. + (widget-read-event): Remove. Callers changed to use read-event. + (widget-button-release-event-p): Rename from button-release-event-p. (widget-field-add-space, widget-field-use-before-change): Uncustomize. (widget-specify-field): Use keymap property, not local-map. (widget-specify-button): Obey :suppress-face. (widget-specify-insert): Use modern backquote syntax. - (widget-image-directory): Renamed from widget-glyph-directory. - (widget-image-enable): Renamed from widget-glyph-enable. + (widget-image-directory): Rename from widget-glyph-directory. + (widget-image-enable): Rename from widget-glyph-enable. (widget-image-find): Replaces widget-glyph-find. (widget-button-pressed-face): Move defvar. (widget-image-insert): Replaces widget-glyph-insert. @@ -17044,8 +17044,8 @@ (widget-sexp-prompt-value, widget-echo-help): Simplify. (widget-default-create): Use widget-image-insert; some rewriting. (widget-visibility-value-create) - (widget-push-button-value-create, widget-toggle-value-create): Use - widget-image-insert. + (widget-push-button-value-create, widget-toggle-value-create): + Use widget-image-insert. (checkbox): Create on and off images dynamically. (documentation-link): Change :help-echo. (widget-documentation-link-echo-help): Remove. @@ -17114,8 +17114,8 @@ (tibetan-composition-function): Fix args to tibetan-compose-string. - * language/tibetan.el (tibetan-composable-pattern): More - characters included. + * language/tibetan.el (tibetan-composable-pattern): + More characters included. (tibetan-consonant-transcription-alist): Rule for "R" added. (tibetan-subjoined-transcription-alist): Rules for "+W", "+Y", and "+R" added. @@ -17154,8 +17154,8 @@ 2000-05-31 Dave Love <fx@gnu.org> - * loadhist.el (loadhist-hook-functions): Remove - before-change-function, after-change-function. + * loadhist.el (loadhist-hook-functions): + Remove before-change-function, after-change-function. (unload-feature): Deal with symbols which are both bound and fbound. @@ -17228,8 +17228,8 @@ * progmodes/antlr-mode.el: New commands: hide/unhide actions, upcase/downcase literals. (antlr-tiny-action-length): New user option. - (antlr-hide-actions): New command. Suggested by - Bjoern Mielenhausen <Bjoern.Mielenhausen@sap.com>. + (antlr-hide-actions): New command. + Suggested by Bjoern Mielenhausen <Bjoern.Mielenhausen@sap.com>. (antlr-mode-map): New binding [C-c C-v]. (antlr-mode-menu): New entries. (antlr-downcase-literals): New command. @@ -17242,8 +17242,8 @@ * progmodes/antlr-mode.el: XEmacs bug workaround, XEmacs hint. (antlr-font-lock-additional-keywords): Workaround for intentional bug in XEmacs version of font-lock. - (antlr-mode): Set symbol property `mode-name' to "Antlr". Could - be used by a smarter version of `buffers-menu-grouping-function'. + (antlr-mode): Set symbol property `mode-name' to "Antlr". + Could be used by a smarter version of `buffers-menu-grouping-function'. 2000-05-29 Gerd Moellmann <gerd@gnu.org> @@ -17265,8 +17265,8 @@ 2000-05-28 Eli Zaretskii <eliz@is.elta.co.il> - * international/codepage.el (cp-coding-system-for-codepage-1): Add - eight-bit-graphic and eight-bit-control to safe charsets for cpNNN + * international/codepage.el (cp-coding-system-for-codepage-1): + Add eight-bit-graphic and eight-bit-control to safe charsets for cpNNN coding systems. 2000-05-26 Dave Love <fx@gnu.org> @@ -17275,10 +17275,10 @@ internal-find-face. * mail/reporter.el: Maintainer change. Doc fixes. - (reporter-version): Deleted. + (reporter-version): Delete. * emacs-lisp/elp.el: Maintainer change. - (elp-help-address, elp-submit-bug-report, elp-version): Deleted. + (elp-help-address, elp-submit-bug-report, elp-version): Delete. 2000-05-26 Stefan Monnier <monnier@cs.yale.edu> @@ -17290,8 +17290,8 @@ * loadhist.el (unload-feature): Fix interactive spec [from lijnzaad@ebi.ac.uk]. - * emacs-lisp/bytecomp.el (byte-compile-callargs-warn): Use - subr-arity to check primitives. + * emacs-lisp/bytecomp.el (byte-compile-callargs-warn): + Use subr-arity to check primitives. (byte-compile-flush-pending, byte-compile-file-form-progn) (byte-compile-normal-call, byte-compile-list, byte-compile-concat) (byte-compile-insert, byte-compile-funcall): Use mapc instead of @@ -17354,8 +17354,8 @@ window-system. (ffap-highlight): Always default to t. - * emacs-lisp/edebug.el (edebug-emacs-19-specific): Call - display-popup-menus-p instead of looking at window-system. + * emacs-lisp/edebug.el (edebug-emacs-19-specific): + Call display-popup-menus-p instead of looking at window-system. * disp-table.el (standard-display-g1, standard-display-graphic): Only refuse to use string glyphs on X and MS-Windows. @@ -17374,8 +17374,8 @@ 2000-05-25 Eli Zaretskii <eliz@is.elta.co.il> - * international/mule-diag.el (describe-char-after): Use - display-graphic-p instead of window-system, so that this function + * international/mule-diag.el (describe-char-after): + Use display-graphic-p instead of window-system, so that this function works on MS-DOS. 2000-05-25 Eli Zaretskii <eliz@is.elta.co.il> @@ -17402,7 +17402,7 @@ 2000-05-24 Eric M. Ludlam <zappo@ultranet.com> - * rmailout.el (rmail-output-to-rmail-file): Added optional param + * rmailout.el (rmail-output-to-rmail-file): Add optional param STAY. * rmail.el (rmail-automatic-folder-directives): New user variable. @@ -17421,8 +17421,8 @@ * ediff-init.el (ediff-merge-filename-prefix): New customizable variable. - * ediff-mult.el (ediff-filegroup-action): Use - ediff-merge-filename-prefix. + * ediff-mult.el (ediff-filegroup-action): + Use ediff-merge-filename-prefix. 2000-05-24 Michael Kifer <kifer@cs.sunysb.edu> @@ -17460,14 +17460,14 @@ * speedbar.el (speedbar-easymenu-definition-base): Image toggle fix. (speedbar-insert-button): Invisible text property fix. - (speedbar-directory-plus): Renamed from speedbar-directory-+. - (speedbar-directory-minus): Renamed from speedbar-directory--. - (speedbar-page-plus): Renamed from speedbar-file-+. - (speedbar-page-minus): Renamed from speedbar-file--. - (speedbar-page): Renamed from speedbar-file-. - (speedbar-tag): Renamed from speedbar-tag-. - (speedbar-tag-plus): Renamed from speedbar-tag-+. - (speedbar-tag-minus): Renamed from speedbar-tag--. + (speedbar-directory-plus): Rename from speedbar-directory-+. + (speedbar-directory-minus): Rename from speedbar-directory--. + (speedbar-page-plus): Rename from speedbar-file-+. + (speedbar-page-minus): Rename from speedbar-file--. + (speedbar-page): Rename from speedbar-file-. + (speedbar-tag): Rename from speedbar-tag-. + (speedbar-tag-plus): Rename from speedbar-tag-+. + (speedbar-tag-minus): Rename from speedbar-tag--. (speedbar-expand-image-button-alist): Use above renames. * sb-dir-plus.xpm: Renamed from sb-dir+.xpm @@ -17480,8 +17480,8 @@ 2000-05-24 Kenichi Handa <handa@etl.go.jp> - * international/quail.el (quail-show-guidance-buf): Set - current-input-method of the guidance buffer to the name of the + * international/quail.el (quail-show-guidance-buf): + Set current-input-method of the guidance buffer to the name of the current input method. 2000-05-23 Stefan Monnier <monnier@cs.yale.edu> @@ -17520,8 +17520,8 @@ 2000-05-22 Dave Love <fx@gnu.org> - * loadhist.el (feature-symbols, file-provides, file-requires): Use - mapc. + * loadhist.el (feature-symbols, file-provides, file-requires): + Use mapc. (feature-file): Avoid calling symbol-name. Doc fix. (file-set-intersect, file-dependents): Use dolist, not mapcar. (loadhist-hook-functions): Add mouse-position-function. @@ -17537,7 +17537,7 @@ 2000-05-22 Sam Steingold <sds@gnu.org> - * info.el (Info-fontify-node): Fixed the call to + * info.el (Info-fontify-node): Fix the call to `add-text-properties' (bug introduced on 2000-05-18). 2000-05-22 Dave Love <fx@gnu.org> @@ -17547,11 +17547,11 @@ * progmodes/etags.el: Add to debug-ignored-errors. (visit-tags-table-buffer): Clear out buffers holding old tables when making a new list. - (etags-recognize-tags-table, tags-recognize-empty-tags-table): Use - mapc. + (etags-recognize-tags-table, tags-recognize-empty-tags-table): + Use mapc. - * completion.el: Doc fixes. Add to debug-ignored-errors. Don't - quote keywords. + * completion.el: Doc fixes. Add to debug-ignored-errors. + Don't quote keywords. (cmpl-string-case-type): Use character classes. * comint.el: @@ -17582,8 +17582,8 @@ 2000-05-22 Kenichi Handa <handa@etl.go.jp> - * international/quail.el (quail-simple-translation-keymap): Map - 128..255 to quail-self-insert-command. + * international/quail.el (quail-simple-translation-keymap): + Map 128..255 to quail-self-insert-command. (quail-keyboard-layout-alist): Add definition for "pc102-de". 2000-05-22 Stefan Monnier <monnier@cs.yale.edu> @@ -17603,8 +17603,8 @@ * edmacro.el (edmacro-parse-keys): Return vector if any elements are invalid characters. - * international/mule-util.el (detect-coding-with-priority): Use - mapc. Remove redundant lambda. + * international/mule-util.el (detect-coding-with-priority): + Use mapc. Remove redundant lambda. * international/mule-diag.el (list-non-iso-charset-chars) (describe-fontset): Remove redundant lambda. @@ -17665,14 +17665,14 @@ * mail/rmail.el (rmail-decode-quoted-printable): Use delete-region and insert, not subst-char-in-region. - * international/mule-diag.el (list-character-sets-1): Handle - charsets eight-bit-control and eight-bit-graphic. + * international/mule-diag.el (list-character-sets-1): + Handle charsets eight-bit-control and eight-bit-graphic. (list-iso-charset-chars): Likewise. (list-block-of-chars): If CHARSET is not char-table, insert 8-bit characters as is. Use indent-to to align characters. - * international/mule-cmds.el (find-multibyte-characters): Never - exclude charsets eight-bit-control and eight-bit-graphic. + * international/mule-cmds.el (find-multibyte-characters): + Never exclude charsets eight-bit-control and eight-bit-graphic. 2000-05-19 Stefan Monnier <monnier@cs.yale.edu> @@ -17707,18 +17707,18 @@ * ps-print.el: Compatibility, customization and doc fix. (ps-printer-name-option): Replace defconst by defvar. (ps-postscript-code-directory): XEmacs compatibility. - (ps-header-sheet, ps-setup, ps-begin-file, ps-begin-job): Code - fix. + (ps-header-sheet, ps-setup, ps-begin-file, ps-begin-job): + Code fix. (ps-user-defined-prologue, ps-print-prologue-header) - (ps-xemacs-face-kind-p, ps-face-bold-p, ps-face-italic-p): XEmacs - compatibility and code fix. + (ps-xemacs-face-kind-p, ps-face-bold-p, ps-face-italic-p): + XEmacs compatibility and code fix. (ps-print-background-image, ps-print-background-text): Customization fix. (ps-line-number-start, ps-n-up-on): New vars. 2000-05-18 Espen Skoglund <esk@ira.uka.de> - * pascal.el (pascal-indent-alist, pascal-indent-comment): Changed + * pascal.el (pascal-indent-alist, pascal-indent-comment): Change the indent-comment function to just return the appropriate indent. 2000-05-18 Eric M. Ludlam <zappo@ultranet.com> @@ -17737,8 +17737,8 @@ 2000-05-18 Kenichi Handa <handa@etl.go.jp> - * international/mule-diag.el (describe-char-after): Call - internal-char-font, not char-font. If internal-char-font returns + * international/mule-diag.el (describe-char-after): + Call internal-char-font, not char-font. If internal-char-font returns nil, display "-- none --". 2000-05-17 Eli Zaretskii <eliz@is.elta.co.il> @@ -17784,8 +17784,8 @@ * help.el (view-emacs-FAQ): Change `emacs-faq' to `efaq'. - * progmodes/compile.el (compilation-parse-errors): Collect - `nomessage' regexps last. + * progmodes/compile.el (compilation-parse-errors): + Collect `nomessage' regexps last. * dired.el (dired-mode-map): Use dired-do-query-replace-regexp. @@ -17829,8 +17829,8 @@ (help-xref-following): New variable. (help-make-xrefs): Use it. (help-xref-go-back): Use position information from stack element. - (help-follow): Make position in stack element a pair. Use - help-xref-following. + (help-follow): Make position in stack element a pair. + Use help-xref-following. * autoarg.el: New file. @@ -17853,16 +17853,16 @@ (speedbar-easymenu-definition-special): Add flush cache & expand. (speedbar-visiting-tag-hook): Set new defaults. Added options. (speedbar-reconfigure-keymaps-hook): New variable. - (speedbar-frame-parameters): Updated documentation. - (speedbar-use-imenu-flag): Updated custom tag. + (speedbar-frame-parameters): Update documentation. + (speedbar-use-imenu-flag): Update custom tag. (speedbar-dynamic-tags-function-list): New variable. - (speedbar-tag-hierarchy-method): Updated doc & custom. + (speedbar-tag-hierarchy-method): Update doc & custom. (speedbar-indentation-width, speedbar-indentation-width) New variables. (speedbar-hide-button-brackets-flag): Customizable. (speedbar-vc-indicator): Doc update. - (speedbar-ignored-path-expressions): Updated default value. - (speedbar-supported-extension-expressions): Updated default value. + (speedbar-ignored-path-expressions): Update default value. + (speedbar-supported-extension-expressions): Update default value. (speedbar-syntax-table): Remove {} paren status. (speedbar-file-key-map, speedbar-buffers-key-map): Add "=" to act as "+". Added overlay aliases. @@ -17874,24 +17874,24 @@ (speedbar-reconfigure-keymaps): Run configure keymap hooks. (speedbar-item-info-tag-helper): Revamped to handle a wider range of arbitrary text, and new helper functions. - (speedbar-item-copy, speedbar-item-rename): Fixed trailing \ in + (speedbar-item-copy, speedbar-item-rename): Fix trailing \ in filename finder. (speedbar-make-button): Call `speedbar-insert-image-button-maybe'. (speedbar-directory-buttons): Update path search/expansion. (speedbar-make-tag-line): Pay attention to `speedbar-indentation-width'. Use more care w/ invisible properties. - (speedbar-change-expand-button-char): Call - `speedbar-insert-image-button-maybe'. - (speedbar-apply-one-tag-hierarchy-method): Deleted (and replaced). + (speedbar-change-expand-button-char): + Call `speedbar-insert-image-button-maybe'. + (speedbar-apply-one-tag-hierarchy-method): Delete (and replaced). (speedbar-sort-tag-hierarchy, speedbar-prefix-group-tag-hierarchy) (speedbar-trim-words-tag-hierarchy) (speedbar-simple-group-tag-hierarchy): New functions. (speedbar-create-tag-hierarchy): Update doc, use new tag hooks. - (speedbar-insert-imenu-list, speedbar-insert-etags-list): New - functions. + (speedbar-insert-imenu-list, speedbar-insert-etags-list): + New functions. (speedbar-mouse-set-point): New function. - (speedbar-power-click): Updated documentation. + (speedbar-power-click): Update documentation. (speedbar-line-token, speedbar-goto-this-file): Handle more types of tag prefix text. (speedbar-expand-line, speedbar-contract-line): Make more robust @@ -17902,10 +17902,10 @@ (speedbar-tag-file): Use new `speedbar-fetch-dynamic-tags' fn. Use new generator insertion method. (speedbar-fetch-dynamic-tags): New function. - (speedbar-fetch-dynamic-imenu): Removed code now handled in + (speedbar-fetch-dynamic-imenu): Remove code now handled in `speedbar-fetch-dynamic-imenu'. (speedbar-fetch-dynamic-etags): Fix current buffer problem. - (speedbar-buffer-easymenu-definition): Added "Kill Buffer", and + (speedbar-buffer-easymenu-definition): Add "Kill Buffer", and "Revert Buffer" menu items. (speedbar-buffer-buttons-engine): Be smarter when creating a filename tag (for expansion purposes.). @@ -17930,17 +17930,17 @@ of character sets. * international/mule-diag.el (describe-char-after): New function. - (describe-font-internal): Adjusted for the change of font-info. + (describe-font-internal): Adjust for the change of font-info. (describe-font): Likewise. (print-fontset): Rewritten for the new fontset implementation. (describe-fontset): Include fontset alias names in completion. - (list-fontsets): Adjusted for the change of print-fontset. + (list-fontsets): Adjust for the change of print-fontset. * simple.el (what-cursor-position): If DETAIL is non-nil, call describe-char-after instead of displaying the detail in the echo area. (syntax-code-table): Format changed. - (string-to-syntax): Adjusted for the above change. + (string-to-syntax): Adjust for the above change. 2000-05-12 Stefan Monnier <monnier@cs.yale.edu> @@ -18030,8 +18030,8 @@ (help-xref-symbol-regexp): Add `face'. (help-make-xrefs): Check for quoted face names and adapt regexp submatch numbers to cope. - (help-xref-interned): Maybe insert face doc too. Separate - sections with a line of hyphens. + (help-xref-interned): Maybe insert face doc too. + Separate sections with a line of hyphens. * faces.el: Some doc fixes. Declare some functions obsolete. (describe-face): Add customize button. Return the help @@ -18052,8 +18052,8 @@ simulations for greek-iso8859-7, add latin-iso8859-14 and latin-iso8859-15. - * international/mule-cmds.el (set-language-info-alist): Call - define-prefix-command with 3 arguments, to make the map suitable + * international/mule-cmds.el (set-language-info-alist): + Call define-prefix-command with 3 arguments, to make the map suitable for a menu. 2000-05-07 Dave Love <fx@gnu.org> @@ -18081,8 +18081,8 @@ 2000-05-04 Milan Zamazal <pdm@freesoft.cz> - * progmodes/glasses.el (glasses-convert-to-unreadable): Use - `glasses-separator' instead of the hard-wired "_". + * progmodes/glasses.el (glasses-convert-to-unreadable): + Use `glasses-separator' instead of the hard-wired "_". (glasses-mode): Call `glasses-make-unreadable' only in a single place. @@ -18112,7 +18112,7 @@ * subr.el (add-minor-mode): Handle AFTER for keymaps. Don't set TOGGLE's value. - * mailabbrev.el (mail-abbrev-insert-alias): Renamed from + * mailabbrev.el (mail-abbrev-insert-alias): Rename from mail-interactive-insert-alias. (mail-abbrev-complete-alias): New command. (mail-mode-map): Bind it to `M-TAB'. @@ -18146,8 +18146,8 @@ 2000-05-02 Eli Zaretskii <eliz@is.elta.co.il> - * international/mule-cmds.el (set-language-environment): Don't - concat an integer (dos-codepage), use format instead. + * international/mule-cmds.el (set-language-environment): + Don't concat an integer (dos-codepage), use format instead. 2000-05-02 Dave Love <fx@gnu.org> @@ -18188,8 +18188,8 @@ 2000-04-28 Kenichi Handa <handa@etl.go.jp> - * mail/sendmail.el (sendmail-send-it): Set - buffer-file-coding-system to the selected coding system for MIME + * mail/sendmail.el (sendmail-send-it): + Set buffer-file-coding-system to the selected coding system for MIME header. 2000-04-27 Gerd Moellmann <gerd@gnu.org> @@ -18235,8 +18235,8 @@ * image.el (find-image): New function. (defimage): Rewritten to find image at load time. - * startup.el (normal-top-level-add-to-load-path): Handle - case that the default directory is not in load-path. + * startup.el (normal-top-level-add-to-load-path): + Handle case that the default directory is not in load-path. * help.el: Old patch from Stefan Monnier. (help-xref-on-pp): New function. @@ -18259,13 +18259,13 @@ 2000-04-25 Gerd Moellmann <gerd@gnu.org> - * replace.el (perform-replace): Add parameters START and END. Use - them instead of the check for a region in Transient Mark mode. + * replace.el (perform-replace): Add parameters START and END. + Use them instead of the check for a region in Transient Mark mode. (query-replace-read-args): Return two more list elements for the start and end of the region in Transient Mark mode. (query-replace, query-replace-regexp, query-replace-regexp-eval) - (map-query-replace-regexp, replace-string, replace-regexp): Add - optional last arguments START and END and pass them to + (map-query-replace-regexp, replace-string, replace-regexp): + Add optional last arguments START and END and pass them to perform-replace. * progmodes/ebrowse.el (ebrowse-tags-query-replace): Construct a @@ -18330,7 +18330,7 @@ * progmodes/inf-lisp.el (inferior-lisp-mode): Don't set non-existing variable comint-input-sentinel. - (inferior-lisp-args-to-list): Removed. + (inferior-lisp-args-to-list): Remove. (inferior-lisp): Use split-string instead of inferior-lisp-args-to-list. @@ -18482,8 +18482,8 @@ accept-process-output with ispell-accept-output. (ispell-init-process): Call ispell-process-status instead of process-status with. - (ispell-init-process): Call ispell-start-process. Call - ispell-accept-output and ispell-send-string. Don't call + (ispell-init-process): Call ispell-start-process. + Call ispell-accept-output and ispell-send-string. Don't call process-kill-without-query and kill-process if they are unbound. (ispell-async-processp): New function. @@ -18495,22 +18495,22 @@ * menu-bar.el (menu-bar-options-menu): Make `mule' always visible. Modify `truncate-lines'. Make `describe-language-environment' - always visible and add help. Modify `describe-key' help. Invoke - Info-directory from `info'. New entry `emacs-manual'. + always visible and add help. Modify `describe-key' help. + Invoke Info-directory from `info'. New entry `emacs-manual'. 2000-04-10 Gerd Moellmann <gerd@gnu.org> * progmodes/ebrowse.el (ebrowse-tree-mode): Use propertized-buffer-identification. (ebrowse-update-member-buffer-mode-line): Likewise. - (ebrowse--mode-strings): Removed. - (ebrowse--mode-line-props): Removed. + (ebrowse--mode-strings): Remove. + (ebrowse--mode-line-props): Remove. * files.el (auto-mode-alist): Add `EBROWSE'. * progmodes/ebrowse.el (ebrowse-read): Skip forward over white space before testing for end of buffer. - (ebrowse-load): Removed. + (ebrowse-load): Remove. (ebrowse-revert-tree-buffer-from-file): Rewritten. (ebrowse-create-tree-buffer): Rewritten. (ebrowse-tree-mode): Read tree from buffer. @@ -18541,7 +18541,7 @@ * progmodes/ebrowse-ffh.el: New file. * progmodes/ebrowse.el (ebrowse-find-file-hook-fn): - Moved to ebrowse-ffh.el. + Move to ebrowse-ffh.el. (ebrowse-load): Add autoload. * finder.el (finder-commentary): Add autoload cookie. @@ -18746,7 +18746,7 @@ (network-connection-mode-setup): New function, saves host and service information in local variables. - * locate.el (locate-word-at-point): Added this function. + * locate.el (locate-word-at-point): Add this function. (locate): Default to using locate-word-at-point as input Run dired-mode-hook @@ -18884,9 +18884,9 @@ text of the URL was passed. Now the whole URL structure is passed and the function is responsible for extracting the parts it requires. Changed the default of `quickurl-format-function' accordingly. - (quickurl-insert): Changed the `funcall' of + (quickurl-insert): Change the `funcall' of `quickurl-format-function' to match the above change. - (quickurl-list-insert): Changed the `url' case so that it makes + (quickurl-list-insert): Change the `url' case so that it makes use of `quickurl-format-function', previous to this the format was hard wired. @@ -19016,7 +19016,7 @@ * international/mule-diag.el (describe-font): Don't refer to global-fontset-alist, instead call font-list. (describe-fontset, list-fontsets, mule-diag): Likewise. - (print-fontset): Adjusted for the change of fontset implementation. + (print-fontset): Adjust for the change of fontset implementation. * international/fontset.el (x-charset-registries): Variable removed, instead the corresponding data is stored in the default fontset. @@ -19134,7 +19134,7 @@ 2000-03-14 Dave Love <fx@gnu.org> - * subr.el (replace-regexp-in-string): Renamed from + * subr.el (replace-regexp-in-string): Rename from replace-regexps-in-string. Doc fix. 2000-03-12 Dave Love <fx@gnu.org> @@ -19248,8 +19248,8 @@ builtin operators, use `font-lock-builtin-face' for Emacs and `font-lock-preprocessor-face' otherwise. - * font-lock.el (lisp-font-lock-keywords-1): Highlight - `(defun (setf foo)' differently. + * font-lock.el (lisp-font-lock-keywords-1): + Highlight `(defun (setf foo)' differently. 2000-03-08 Stefan Monnier <monnier@cs.yale.edu> @@ -19265,7 +19265,7 @@ both cases close together. Also apply a more generic algorithm for suffixes (the mirror image of the algorithm used for prefixes). Use shy-groups. Use nreverse rather than reverse. - (regexp-opt-try-suffix): Removed. + (regexp-opt-try-suffix): Remove. * cmuscheme.el (inferior-scheme-mode-map): Define it independently from comint-mode-map, so we can just inherit from it. Also, move @@ -19397,20 +19397,20 @@ 2000-03-01 David Ponce <david.ponce@wanadoo.fr> - * recentf.el (recentf): Added version tag to the defgroup of recentf. + * recentf.el (recentf): Add version tag to the defgroup of recentf. 2000-03-01 David Ponce <david.ponce@wanadoo.fr> - * recentf.el (recentf-cleanup): Changed to remove excluded file too. + * recentf.el (recentf-cleanup): Change to remove excluded file too. (recentf-edit-list-action): `recentf-edit-list' checkbox widget action to select/unselect a file. (recentf-edit-list): Code cleanup and improvement. (recentf-open-more-files-action): `recentf-open-more-files' button widget action to open a file. (recentf-open-more-files): No more use standard completion but widgets. - (recentf-more-collection): Deleted. - (recentf-more-history): Deleted. - (recentf-setup-more-completion): Deleted. + (recentf-more-collection): Delete. + (recentf-more-history): Delete. + (recentf-setup-more-completion): Delete. 2000-03-01 David Ponce <david.ponce@wanadoo.fr> @@ -19424,7 +19424,7 @@ (recentf-edit-selected-items): New global variable, used by `recentf-edit-list' to hold the list of files to be removed from the recent list. - (recentf-make-menu-items): Updated to display a "Edit list..." + (recentf-make-menu-items): Update to display a "Edit list..." menu item. Minor code cleanup. 2000-03-01 David Ponce <david.ponce@wanadoo.fr> @@ -19437,7 +19437,7 @@ used by `recentf-open-more-files' completion. (recentf-setup-more-completion): New function to setup completion for `recentf-open-more-files'. - (recentf-make-menu-items): Updated to display a "More..." menu item. + (recentf-make-menu-items): Update to display a "More..." menu item. 2000-03-01 David Ponce <david.ponce@wanadoo.fr> @@ -19450,8 +19450,8 @@ (recentf-make-menu-items): New menu filter handling. (recentf-make-menu-item): New helper function. (recentf-menu-elements): New menu handling function. - (recentf-sort-ascending): Updated to new menu filter handling. - (recentf-sort-descending): Updated to new menu filter handling. + (recentf-sort-ascending): Update to new menu filter handling. + (recentf-sort-descending): Update to new menu filter handling. (recentf-sort-basenames-ascending): New menu filter function. (recentf-sort-basenames-descending): New menu filter function. (recentf-show-basenames): New menu filter function. @@ -19490,20 +19490,20 @@ instead of assoc-delete-all. (frame-notice-user-settings): Ditto. - * subr.el (assq-delete-all): Renamed from assoc-delete-all. + * subr.el (assq-delete-all): Rename from assoc-delete-all. Don't copy alist. 2000-02-28 Eli Barzilay <eli@cs.cornell.edu> * calculator.el (calculator-use-menu): New option. - (calculator-initial-bindings): Changed some bindings to work as macros. - (calculator-forced-input): Removed. + (calculator-initial-bindings): Change some bindings to work as macros. + (calculator-forced-input): Remove. (calculator-restart-other-mode): New variable. (calculator-mode-map): Set up menu. 2000-02-28 Jari Aalto <jari.aalto@poboxes.com> - * font-lock.el (java-keywords): Added missing java 1.2.2 Javadoc tags. + * font-lock.el (java-keywords): Add missing java 1.2.2 Javadoc tags. 2000-02-28 Michael Kifer <kifer@cs.sunysb.edu> @@ -19582,7 +19582,7 @@ (footnote-latin-regexp): New variable. (Footnote-latin): New function. (footnote-style-alist): Add element for latin style. - (footnote-style): Moved. + (footnote-style): Move. (Footnote-goto-footnote): Use eq to test arg. * mouse.el (mouse-drag-mode-line-1): Remove `growth =' message. @@ -19752,7 +19752,7 @@ 2000-02-15 Dirk Herrmann <D.Herrmann@tu-bs.de> - * textmodes/bibtex.el (bibtex-mode): Replaced manual splitting of path + * textmodes/bibtex.el (bibtex-mode): Replace manual splitting of path at ':' characters by call to split-string. 2000-02-15 Dirk Herrmann <D.Herrmann@tu-bs.de> @@ -19764,21 +19764,21 @@ * textmodes/bibtex.el: Some temporary comments removed. (bibtex-field-name, bibtex-entry-type): Made the relationship explicit. (bibtex-field-const): Allow capital letters. - (bibtex-start-of-string): Deleted because unused. + (bibtex-start-of-string): Delete because unused. * textmodes/bibtex.el: Unified some nomenclature. We no longer use the term 'reference' to describe a bibtex entry as a whole. Further, reference keys are no longer called 'labels'. - (bibtex-keys): Renamed to bibtex-reference-keys. - (bibtex-reformat-previous-labels): Renamed to + (bibtex-keys): Rename to bibtex-reference-keys. + (bibtex-reformat-previous-labels): Rename to bibtex-reformat-previous-reference-keys. - (bibtex-reference-type): Renamed to bibtex-entry-type. - (bibtex-reference-head): Renamed to bibtex-entry-head. - (bibtex-reference-maybe-empty-head): Renamed to + (bibtex-reference-type): Rename to bibtex-entry-type. + (bibtex-reference-head): Rename to bibtex-entry-head. + (bibtex-reference-maybe-empty-head): Rename to bibtex-entry-maybe-empty-head. - (bibtex-key-in-reference): Renamed to bibtex-key-in-entry. - (bibtex-search-reference): Renamed to bibtex-search-entry. - (bibtex-enclosing-reference-maybe-empty-head): Renamed to + (bibtex-key-in-reference): Rename to bibtex-key-in-entry. + (bibtex-search-reference): Rename to bibtex-search-entry. + (bibtex-enclosing-reference-maybe-empty-head): Rename to bibtex-enclosing-entry-maybe-empty-head. (bibtex-entry-field-alist, bibtex-entry-head) (bibtex-font-lock-keywords, bibtex-skip-to-valid-entry) @@ -19793,7 +19793,7 @@ 2000-02-15 Dirk Herrmann <D.Herrmann@tu-bs.de> - * textmodes/bibtex.el (bibtex-strings, bibtex-keys): Removed redundant + * textmodes/bibtex.el (bibtex-strings, bibtex-keys): Remove redundant comment. (bibtex-format-field-delimiters): New function, functionality extracted from bibtex-format-entry. @@ -19813,7 +19813,7 @@ (bibtex-field-string-or-const, bibtex-field-text, bibtex-field) (bibtex-name-in-field, bibtex-text-in-field, bibtex-reference-infix) (bibtex-string, bibtex-key-in-string, bibtex-text-in-string): - Deleted as parsing is now performed by the following functions. + Delete as parsing is now performed by the following functions. (bibtex-parse-nested-braces, bibtex-parse-field-string-braced) (bibtex-parse-quoted-string, bibtex-parse-field-string-quoted) (bibtex-parse-field-string, bibtex-search-forward-field-string) @@ -19832,7 +19832,7 @@ entries. Instead of reporting the results of the parsing by match-beginning or match-end, these functions return data structures that hold the corresponding positions. - (bibtex-enclosing-field): Changed to also report field boundaries by + (bibtex-enclosing-field): Change to also report field boundaries by return values rather than by match-beginning or match-end. The following functions have been adapted to use the new parsing functions. @@ -19878,11 +19878,11 @@ * bibtex.el: Hiding of entry bodies is not longer provided by bibtex.el directly. Instead the hideshow package can be used. Added a special bibtex entry to hs-special-modes-alist. - (bibtex-hs-forward-sexp): Added for hideshow.el. + (bibtex-hs-forward-sexp): Add for hideshow.el. 2000-02-15 Dirk Herrmann <D.Herrmann@tu-bs.de> - * bibtex.el (bibtex-entry-field-alist): Added booktitle field to + * bibtex.el (bibtex-entry-field-alist): Add booktitle field to proceedings entry type (for cross referencing). Thanks to Wagner Toledo Correa for the suggestion. @@ -19895,11 +19895,11 @@ 2000-02-12 Gerd Moellmann <gerd@gnu.org> * uniquify.el (toplevel): Require CL at compile time. - (uniquify-push): Removed. + (uniquify-push): Remove. - * shadowfile.el (shadow-when): Removed. + * shadowfile.el (shadow-when): Remove. - * tempo.el (tempo-dolist, tempo-mapc): Removed. + * tempo.el (tempo-dolist, tempo-mapc): Remove. (tempo-process-and-insert-string): Use dolist instead of tempo-dolist. * textmodes/sgml-mode.el (sgml-mode-common): Remove `$' from @@ -19912,7 +19912,7 @@ * wid-edit.el (widgets) [defgroup]: Remove url link. (widget-color-choice-list, widget-color-history, widget-mouse-help): - Deleted. + Delete. (widget-specify-field, widget-specify-button): Don't use widget-mouse-help as help-echo property. (default): Use #'ignore for :validate and :mouse-down-action. @@ -19922,8 +19922,8 @@ (widget-color-complete): Use facemenu-color-alist. (widget-color-action): Use facemenu-read-color. - * emacs-lisp/cl-macs.el: Don't bother testing for defalias. Don't - set up `caar' &c that we now have. + * emacs-lisp/cl-macs.el: Don't bother testing for defalias. + Don't set up `caar' &c that we now have. 2000-02-09 Ray Blaak <blaak@gnu.org> @@ -19935,9 +19935,9 @@ * bindings.el (mode-line-input-method-map): New variable. (mode-line-mule-info): Use it; fix last change. (mode-line-mode-menu): Move definition. - (mode-line-mouse-sensitive-p): Deleted. + (mode-line-mouse-sensitive-p): Delete. (mode-line-mode-name): Don't use mode-line-mouse-sensitive-p. - (make-mode-line-mouse-sensitive): Deleted. Body moved to top level. + (make-mode-line-mouse-sensitive): Delete. Body moved to top level. * startup.el (command-line-1): Don't call make-mode-line-mouse-sensitive. @@ -19960,7 +19960,7 @@ (font-lock-add-keywords): Make it work even if font-lock-mode is nil, so that it can be used more easily in <foo>-mode-hook. Also make sure to avoid duplicate entries. - (font-lock-update-removed-keyword-alist): Renamed `major-mode'->`mode'. + (font-lock-update-removed-keyword-alist): Rename `major-mode'->`mode'. (font-lock-remove-keywords): Just as was done for `add', allow it to work even if font-lock-mode is nil. Also make sure we don't modify any pre-existing list by forcing a copy-sequence. Finally rename @@ -20005,12 +20005,12 @@ (idlwave-if, idlwave-procedure, idlwave-function, idlwave-repeat) (idlwave-while): Respect `idlwave-reserved-word-upcase'. (idlwave-rw-case): New function. - (idlwave-statement-match): Fixed problem with assignment regexp. - (idlwave-font-lock-keywords): Improved regexp for keyword parameters. + (idlwave-statement-match): Fix problem with assignment regexp. + (idlwave-font-lock-keywords): Improve regexp for keyword parameters. (idlwave-surround): New argument LENGTH to support padding of operators longer than 1 char. - * progmodes/idlw-shell.el (idlwave-shell-print): Fixed bug with + * progmodes/idlw-shell.el (idlwave-shell-print): Fix bug with idlwave-shell-expression-overlay. Implemented printing of expressions on higher levels of the calling stack. (idlwave-shell-display-level-in-calling-stack): Restore stack level. @@ -20023,7 +20023,7 @@ negative level numbers. (idlwave-shell-mode): Set `modeline-format'. (idlwave-shell-display-line): Set `idlwave-shell-mode-line-info'. - (idlwave-shell-make-new-bp-overlay): Fixed glyph display for Emacs 21. + (idlwave-shell-make-new-bp-overlay): Fix glyph display for Emacs 21. (idlwave-shell-print-expression-function): New option. * progmodes/idlw-toolbar.el (idlwave-toolbar-add-everywhere) @@ -20104,7 +20104,7 @@ end position. (jit-lock-stealth-chunk-start): Rewritten. - * info.el (Info-title-face-alist): Removed. + * info.el (Info-title-face-alist): Remove. (Info-title-1-face, Info-title-2-face, Info-title-3-face): New faces. (Info-fontify-node): Use these faces. @@ -20175,8 +20175,8 @@ 2000-01-28 Gerd Moellmann <gerd@gnu.org> - * emacs-lisp/cl-macs.el (cl-parse-loop-clause): Recognize - `collecting' as synonym for `collect'. + * emacs-lisp/cl-macs.el (cl-parse-loop-clause): + Recognize `collecting' as synonym for `collect'. * ange-ftp.el (ange-ftp-copy-file-internal): Quote new name for the case it contains spaces. @@ -20252,7 +20252,7 @@ Do not call make-variable-buffer-local. (end-of-defun): Use new variable name; doc fix. - * subr.el (dolist, dotimes): Copied from cl-macs.el + * subr.el (dolist, dotimes): Copy from cl-macs.el and made to work. * mail/undigest.el (rmail-digest-end-regexps): @@ -20281,7 +20281,7 @@ 2000-01-14 Gerd Moellmann <gerd@gnu.org> - * emacs-lisp/copyright.el (copyright-update): Removed the + * emacs-lisp/copyright.el (copyright-update): Remove the requirement for a trailing space from `copyright-regexp', to support copyrights with owner specified on a separate line.. @@ -20330,7 +20330,7 @@ * net: New directory. - * emacs-lisp/lisp-mode.el (eval-last-sexp-1): Renamed from + * emacs-lisp/lisp-mode.el (eval-last-sexp-1): Rename from eval-last-sexp. Don't bind debug-on-error here. (eval-last-sexp): New function. Bind debug-on-error if eval-expression-debug-on-error is non-nil. @@ -20349,9 +20349,9 @@ * emacs-lisp/lisp-mode.el (with-syntax-table): Set up lisp-indent-function property. - * subr.el (with-syntax-table): Moved from simple.el. + * subr.el (with-syntax-table): Move from simple.el. - * simple.el (with-syntax-table): Moved to subr.el. + * simple.el (with-syntax-table): Move to subr.el. 2000-01-11 Gerd Moellmann <gerd@gnu.org> @@ -20381,7 +20381,7 @@ 2000-01-10 John Wiegley <johnw@gnu.org> - * allout.el (isearch-done/outline-provisions): Added `edit' + * allout.el (isearch-done/outline-provisions): Add `edit' argument to correspond with the current definition of `isearch-done'. 2000-01-10 Dave Love <fx@gnu.org> @@ -20403,17 +20403,17 @@ (version20p): New variable. (xemacsp): New variable. (ispell-choices-win-default-height): Fix for XEmacs visibility. - (ispell-dictionary-alist1): Added Brasileiro dictionary. + (ispell-dictionary-alist1): Add Brasileiro dictionary. (ispell-dictionary-alist6): Russian command lines no longer accept run-together words. (ispell-local-dictionary-alist): Add koi8-r to customize definition. (ispell-dictionary-alist): Add koi8-r to customize definition. - (check-ispell-version): Added documentation string. Return library + (check-ispell-version): Add documentation string. Return library path when called non-interactively. (ispell-menu-map-needed): Uses new variables. (ispell-library-path): New variable. (ispell-decode-string): XEmacs fix for bogus variable bindings. - (ispell-word): Improved documentation string. Test for valid + (ispell-word): Improve documentation string. Test for valid character mappings. Correctly check typed in word changes that can result in single words split into multiple words. Return replacement word. @@ -20477,7 +20477,7 @@ 2000-01-07 Dave Love <fx@gnu.org> - * add-log.el (add-log-debugging): Deleted. + * add-log.el (add-log-debugging): Delete. (add-change-log-entry): Treat a backup FILE-NAME as its parent file. Remove debugging code. (change-log-get-method-definition, change-log-name): Add doc. @@ -20518,7 +20518,7 @@ M-C-e, M-C-h, C-j, C-xnd, TAB. (fortran-mode): Set beginning-of-defun, end-of-defun. (fortran-column-ruler): Simplify. - (fortran-mark-subprogram, fortran-narrow-to-subprogram): Deleted. + (fortran-mark-subprogram, fortran-narrow-to-subprogram): Delete. (fortran-with-subprogram-narrowing): Likewise. (fortran-indent-subprogram): Call mark-defun. (fortran-check-for-matching-do): Change narrowing. @@ -20631,7 +20631,7 @@ * faces.el (face-read-integer, read-face-attribute) (color-defined-p, color-values): Unspecified-{f,b}g are now strings. -2000-01-03 Martin Stjernholm <bug-cc-mode@gnu.org> +2000-01-03 Martin Stjernholm <mast@lysator.liu.se> * progmodes/cc-cmds.el (c-fill-paragraph): Count number of spaces at comment end, and re-insert them after filling. @@ -20661,7 +20661,7 @@ (display-color-p, frame-set-background-mode): Pass the frame to tty-display-color-p. - * term/tty-colors.el (tty-defined-color-alist): Renamed from + * term/tty-colors.el (tty-defined-color-alist): Rename from tty-color-alist. (tty-color-alist, tty-modify-color-alist): New functions. (tty-color-define, tty-color-clear, tty-color-approximate) diff --git a/lisp/Makefile.in b/lisp/Makefile.in index d193c8d7ea5..7bf53861e71 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -28,6 +28,19 @@ VPATH = $(srcdir) # limitation. XARGS_LIMIT = @XARGS_LIMIT@ +# 'make' verbosity. +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ + +AM_V_ELC = $(am__v_ELC_@AM_V@) +am__v_ELC_ = $(am__v_ELC_@AM_DEFAULT_V@) +am__v_ELC_0 = @echo " ELC " $@; +am__v_ELC_1 = + +AM_V_GEN = $(am__v_GEN_@AM_V@) +am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = + # You can specify a different executable on the make command line, # e.g. "make EMACS=../src/emacs ...". @@ -70,16 +83,6 @@ AUTOGENEL = loaddefs.el \ cedet/srecode/loaddefs.el \ org/org-loaddefs.el -# Versioned files that are the value of someone's `generated-autoload-file'. -# Note that update_loaddefs parses this. -AUTOGEN_VCS = \ - ps-print.el \ - mail/rmail.el \ - dired.el \ - ibuffer.el \ - htmlfontify.el \ - emacs-lisp/eieio.el - # Value of max-lisp-eval-depth when compiling initially. # During bootstrapping the byte-compiler is run interpreted when compiling # itself, and uses more stack than usual. @@ -105,6 +108,9 @@ COMPILE_FIRST = \ $(lisp)/emacs-lisp/bytecomp.elc \ $(lisp)/emacs-lisp/autoload.elc +# Prevent any settings in the user environment causing problems. +unexport EMACSDATA EMACSDOC EMACSPATH + # The actual Emacs command run in the targets below. # Prevent any setting of EMACSLOADPATH in user environment causing problems. emacs = EMACSLOADPATH= '$(EMACS)' $(EMACSOPT) @@ -144,9 +150,8 @@ setwins_for_subdirs=for file in `find ${srcdir} -type d -print`; do \ # we add them here to make sure they get built. all: compile-main $(lisp)/cus-load.el $(lisp)/finder-inf.el -doit: - -.PHONY: all doit custom-deps finder-data autoloads update-subdirs +PHONY_EXTRAS = +.PHONY: all custom-deps finder-data autoloads update-subdirs $(PHONY_EXTRAS) # custom-deps and finder-data both used to scan _all_ the *.el files. # This could lead to problems in parallel builds if automatically @@ -162,46 +167,47 @@ doit: # Nowadays these commands don't scan automatically generated files, # since they will never contain any useful information # (see finder-no-scan-regexp and custom-dependencies-no-scan-regexp). +custom-deps: + $(AM_V_at)$(MAKE) PHONY_EXTRAS=$(lisp)/cus-load.el $(lisp)/cus-load.el $(lisp)/cus-load.el: - $(MAKE) $(MFLAGS) custom-deps -custom-deps: doit - $(setwins_almost); \ + $(AM_V_GEN)$(setwins_almost); \ echo Directories: $$wins; \ $(emacs) -l cus-dep \ --eval '(setq generated-custom-dependencies-file (unmsys--file-name "$(srcdir)/cus-load.el"))' \ -f custom-make-dependencies $$wins +finder-data: + $(AM_V_at)$(MAKE) PHONY_EXTRAS=$(lisp)/finder-inf.el \ + $(lisp)/finder-inf.el $(lisp)/finder-inf.el: - $(MAKE) $(MFLAGS) finder-data -finder-data: doit - $(setwins_finder); \ + $(AM_V_GEN)$(setwins_finder); \ echo Directories: $$wins; \ $(emacs) -l finder \ --eval '(setq generated-finder-keywords-file (unmsys--file-name "$(srcdir)/finder-inf.el"))' \ -f finder-compile-keywords-make-dist $$wins -# The chmod +w is to handle env var CVSREAD=1. # Use expand-file-name rather than $abs_scrdir so that Emacs does not # get confused when it compares file-names for equality. # # Note that we set no-update-autoloads in _generated_ leim files. # If you want to allow autoloads in such files, remove that, # and make this depend on leim. -autoloads: $(LOADDEFS) doit - cd $(lisp) && chmod +w $(AUTOGEN_VCS) - $(setwins_almost); \ +autoloads .PHONY: $(lisp)/loaddefs.el +$(lisp)/loaddefs.el: $(LOADDEFS) + $(AM_V_GEN)$(setwins_almost); \ echo Directories: $$wins; \ $(emacs) -l autoload \ + --eval '(setq autoload-ensure-writable t)' \ --eval '(setq autoload-builtin-package-versions t)' \ - --eval '(setq generated-autoload-file (expand-file-name (unmsys--file-name "$(srcdir)/loaddefs.el")))' \ + --eval '(setq generated-autoload-file (expand-file-name (unmsys--file-name "$@")))' \ -f batch-update-autoloads $$wins # This is required by the bootstrap-emacs target in ../src/Makefile, so # we know that if we have an emacs executable, we also have a subdirs.el. $(lisp)/subdirs.el: - $(MAKE) $(MFLAGS) update-subdirs -update-subdirs: doit - $(setwins_for_subdirs); \ + $(AM_V_GEN)$(MAKE) update-subdirs +update-subdirs: + $(AM_V_at)$(setwins_for_subdirs); \ for file in $$wins; do \ $(srcdir)/../build-aux/update-subdirs $$file; \ done; @@ -222,7 +228,8 @@ repo-update: compile finder-data custom-deps # Update the AUTHORS file. update-authors: - $(emacs) -l authors -f batch-update-authors $(top_srcdir)/etc/AUTHORS $(top_srcdir) + $(emacs) -L "$(top_srcdir)/admin" -l authors \ + -f batch-update-authors "$(top_srcdir)/etc/AUTHORS" "$(top_srcdir)" ETAGS = ../lib-src/etags @@ -258,12 +265,10 @@ TAGS: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4) # src/Makefile.in to rebuild a particular Lisp file, no questions asked. # Use byte-compile-refresh-preloaded to try and work around some of # the most common problems of not bootstrapping from a clean state. -.PHONY: compile-onefile -compile-onefile: - @echo Compiling $(THEFILE) - @# Use byte-compile-refresh-preloaded to try and work around some of - @# the most common bootstrapping problems. - @$(emacs) $(BYTE_COMPILE_FLAGS) \ +THEFILE = no-such-file +.PHONY: $(THEFILE)c +$(THEFILE)c: + $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \ -l bytecomp -f byte-compile-refresh-preloaded \ -f batch-byte-compile $(THEFILE) @@ -279,19 +284,14 @@ compile-onefile: # An old-fashioned suffix rule, which, according to the GNU Make manual, # cannot have prerequisites. .el.elc: - @echo Compiling $< - @# The BIG_STACK_OPTS are only needed to byte-compile the byte-compiler - @# files, which is normally done in compile-first, but may also be - @# recompiled via this rule. - @$(emacs) $(BYTE_COMPILE_FLAGS) \ - -f batch-byte-compile $< + $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $< .PHONY: compile-first compile-main compile compile-always compile-first: $(COMPILE_FIRST) # In `compile-main' we could directly do -# ... | xargs $(MAKE) $(MFLAGS) EMACS="$(EMACS)" +# ... | xargs $(MAKE) # 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 @@ -315,7 +315,7 @@ compile-main: leim semantic compile-clean echo "$${el}c"; \ done | xargs $(XARGS_LIMIT) echo) | \ while read chunk; do \ - $(MAKE) $(MFLAGS) compile-targets EMACS="$(EMACS)" TARGETS="$$chunk"; \ + $(MAKE) compile-targets TARGETS="$$chunk"; \ done .PHONY: compile-clean @@ -332,31 +332,24 @@ compile-clean: .PHONY: leim semantic leim: - cd ../leim && $(MAKE) $(MFLAGS) all EMACS="$(EMACS)" + $(MAKE) -C ../leim all EMACS="$(EMACS)" -# FIXME. Yuck. semantic: - case ${EMACS} in \ - .*) EMACS="../${EMACS}" ;; \ - *) EMACS="${EMACS}" ;; \ - esac; \ - cd ../admin/grammars && $(MAKE) $(MFLAGS) all EMACS="$${EMACS}" + $(MAKE) -C ../admin/grammars all EMACS="$(EMACS:.%=../.%)" # 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)" + $(MAKE) compile-main # 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 +compile-always: cd $(lisp) && rm -f *.elc */*.elc */*/*.elc */*/*/*.elc - $(MAKE) $(MFLAGS) compile EMACS="$(EMACS)" + $(MAKE) compile .PHONY: backup-compiled-files compile-after-backup @@ -387,7 +380,7 @@ compile-after-backup: backup-compiled-files compile-always # There is no reason to use this rule unless you only have a single # core and CPU time is an issue. .PHONY: compile-one-process -compile-one-process: doit $(LOADDEFS) compile-first $(lisp)/progmodes/cc-mode.elc +compile-one-process: $(LOADDEFS) compile-first $(emacs) $(BYTE_COMPILE_FLAGS) \ --eval "(batch-byte-recompile-directory 0)" $(lisp) @@ -412,10 +405,9 @@ MH_E_SRC = $(MH_E_DIR)/mh-acros.el $(MH_E_DIR)/mh-alias.el \ .PHONY: mh-autoloads mh-autoloads: $(MH_E_DIR)/mh-loaddefs.el $(MH_E_DIR)/mh-loaddefs.el: $(MH_E_SRC) - $(emacs) -l autoload \ + $(AM_V_GEN)$(emacs) -l autoload \ --eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \ --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \ - --eval "(setq make-backup-files nil)" \ -f batch-update-autoloads $(MH_E_DIR) # Update TRAMP internal autoloads. Maybe we could move tramp*.el into @@ -430,10 +422,9 @@ TRAMP_SRC = $(TRAMP_DIR)/tramp.el $(TRAMP_DIR)/tramp-adb.el \ $(TRAMP_DIR)/tramp-uu.el $(TRAMP_DIR)/trampver.el $(TRAMP_DIR)/tramp-loaddefs.el: $(TRAMP_SRC) - $(emacs) -l autoload \ + $(AM_V_GEN)$(emacs) -l autoload \ --eval "(setq generate-autoload-cookie \";;;###tramp-autoload\")" \ --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \ - --eval "(setq make-backup-files nil)" \ -f batch-update-autoloads $(TRAMP_DIR) CAL_DIR = $(lisp)/calendar @@ -452,24 +443,21 @@ CAL_SRC = $(CAL_DIR)/cal-bahai.el $(CAL_DIR)/cal-china.el \ $(CAL_DIR)/solar.el $(CAL_DIR)/cal-loaddefs.el: $(CAL_SRC) - $(emacs) -l autoload \ + $(AM_V_GEN)$(emacs) -l autoload \ --eval "(setq generate-autoload-cookie \";;;###cal-autoload\")" \ --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \ - --eval "(setq make-backup-files nil)" \ -f batch-update-autoloads $(CAL_DIR) -$(CAL_DIR)/diary-loaddefs.el: $(CAL_SRC) - $(emacs) -l autoload \ +$(CAL_DIR)/diary-loaddefs.el: $(CAL_SRC) $(CAL_DIR)/cal-loaddefs.el + $(AM_V_GEN)$(emacs) -l autoload \ --eval "(setq generate-autoload-cookie \";;;###diary-autoload\")" \ --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \ - --eval "(setq make-backup-files nil)" \ -f batch-update-autoloads $(CAL_DIR) -$(CAL_DIR)/hol-loaddefs.el: $(CAL_SRC) - $(emacs) -l autoload \ +$(CAL_DIR)/hol-loaddefs.el: $(CAL_SRC) $(CAL_DIR)/diary-loaddefs.el + $(AM_V_GEN)$(emacs) -l autoload \ --eval "(setq generate-autoload-cookie \";;;###holiday-autoload\")" \ --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \ - --eval "(setq make-backup-files nil)" \ -f batch-update-autoloads $(CAL_DIR) .PHONY: bootstrap-clean distclean maintainer-clean @@ -488,6 +476,11 @@ maintainer-clean: distclean bootstrap-clean check-declare: $(emacs) -l check-declare --eval '(check-declare-directory "$(lisp)")' +check-defun-dups: + sed -n -e '/^(defun /s/\(.\)(.*/\1/p' \ + $$(find . -name '*.el' -print | grep -v 'loaddefs\.el') \ + | sort | uniq -d + # Dependencies ## None of the following matters for bootstrap, which is the only way @@ -500,7 +493,7 @@ check-declare: # CC Mode uses a compile time macro system which causes a compile time # dependency in cc-*.elc files on the macros in other cc-*.el and the # version string in cc-defs.el. -$(lisp)/progmodes/cc-align.elc $(lisp)/progmodes/cc-awk.elc\ +$(lisp)/progmodes/cc-align.elc\ $(lisp)/progmodes/cc-cmds.elc $(lisp)/progmodes/cc-compat.elc\ $(lisp)/progmodes/cc-engine.elc $(lisp)/progmodes/cc-fonts.elc\ $(lisp)/progmodes/cc-langs.elc $(lisp)/progmodes/cc-menus.elc\ @@ -508,28 +501,22 @@ $(lisp)/progmodes/cc-align.elc $(lisp)/progmodes/cc-awk.elc\ $(lisp)/progmodes/cc-vars.elc: \ $(lisp)/progmodes/cc-bytecomp.elc $(lisp)/progmodes/cc-defs.elc -$(lisp)/progmodes/cc-align.elc: \ - $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc - -$(lisp)/progmodes/cc-cmds.elc: \ +$(lisp)/progmodes/cc-align.elc $(lisp)/progmodes/cc-cmds.elc: \ $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc $(lisp)/progmodes/cc-compat.elc: \ $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-styles.elc \ $(lisp)/progmodes/cc-engine.elc -$(lisp)/progmodes/cc-defs.elc: $(lisp)/progmodes/cc-bytecomp.elc \ - $(lisp)/emacs-lisp/cl.elc $(lisp)/emacs-lisp/regexp-opt.elc +$(lisp)/progmodes/cc-defs.elc: $(lisp)/progmodes/cc-bytecomp.elc $(lisp)/progmodes/cc-engine.elc: $(lisp)/progmodes/cc-langs.elc \ $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-fonts.elc: $(lisp)/progmodes/cc-langs.elc \ - $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc \ - $(lisp)/font-lock.elc + $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc -$(lisp)/progmodes/cc-langs.elc: $(lisp)/progmodes/cc-vars.elc \ - $(lisp)/emacs-lisp/cl.elc +$(lisp)/progmodes/cc-langs.elc: $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-mode.elc: $(lisp)/progmodes/cc-langs.elc \ $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc \ @@ -539,6 +526,4 @@ $(lisp)/progmodes/cc-mode.elc: $(lisp)/progmodes/cc-langs.elc \ $(lisp)/progmodes/cc-styles.elc: $(lisp)/progmodes/cc-vars.elc \ $(lisp)/progmodes/cc-align.elc -$(lisp)/progmodes/cc-vars.elc: $(lisp)/custom.elc $(lisp)/widget.elc - # Makefile ends here. diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index be8f0dd8d23..164cd3192ac 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -902,7 +902,7 @@ encompassing condition-case." (header (format "allout-widgets-last-hook-error stored, %s/%s %s %s" this mode args - (format-time-string "%e-%b-%Y %r" (current-time))))) + (format-time-string "%e-%b-%Y %r")))) ;; post to *Messages* then immediately replace with more compact notice: (message "%s" (setq allout-widgets-last-hook-error (format "%s:\n%s" header bt))) @@ -2342,9 +2342,9 @@ We use a caching strategy, so the caller doesn't need to do so." got))) ;;;_ : Miscellaneous -;;;_ > allout-elapsed-time-seconds (triple) +;;;_ > allout-elapsed-time-seconds (time-value time-value) (defun allout-elapsed-time-seconds (end start) - "Return seconds between `current-time' style time START/END triples." + "Return seconds between START/END time values." (let ((elapsed (time-subtract end start))) (float-time elapsed))) ;;;_ > allout-frame-property (frame property) diff --git a/lisp/apropos.el b/lisp/apropos.el index e8d827b71cc..023ba4bb202 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -718,7 +718,7 @@ the output includes key-bindings of commands." (setq doc (list (car properties))) (while (setq properties (cdr (cdr properties))) (setq doc (cons (car properties) doc))) - (mapconcat #'symbol-name (nreverse doc) " ")) + (mapconcat (lambda (p) (format "%s" p)) (nreverse doc) " ")) (when (get symbol 'widget-type) (apropos-documentation-property symbol 'widget-documentation t)) diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 6744b210ab7..063e4ba9dcb 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -4,7 +4,7 @@ ;; Inc. ;; Author: Morten Welinder <terra@gnu.org> -;; Keywords: files archives msdog editing major-mode +;; Keywords: files archives ms-dos editing major-mode ;; Favorite-brand-of-beer: None, I hate beer. ;; This file is part of GNU Emacs. @@ -31,7 +31,7 @@ ;; understand the directory level of the archives. For this reason, ;; you should expect this code to need more fiddling than tar-mode.el ;; (although it at present has fewer bugs :-) In particular, I have -;; not tested this under Ms-Dog myself. +;; not tested this under MS-DOS myself. ;; ------------------------------------- ;; INTERACTION: arc-mode.el should play together with ;; @@ -147,6 +147,14 @@ A local copy of the archive will be used when updating." "Hook run when an archive member has been extracted." :type 'hook :group 'archive) + +(defcustom archive-visit-single-files nil + "If non-nil, opening an archive with a single file visits that file. +If nil, visiting such an archive displays the archive summary." + :version "25.1" + :type '(choice (const :tag "Visit the single file" t) + (const :tag "Show the archive summary" nil)) + :group 'archive) ;; ------------------------------ ;; Arc archive configuration @@ -742,7 +750,12 @@ archive. (if (default-value 'enable-multibyte-characters) (set-buffer-multibyte 'to)) (archive-summarize nil) - (setq buffer-read-only t)))) + (setq buffer-read-only t) + (when (and archive-visit-single-files + auto-compression-mode + (= (length archive-files) 1)) + (rename-buffer (concat " " (buffer-name))) + (archive-extract))))) ;; Archive mode is suitable only for specially formatted data. (put 'archive-mode 'mode-class 'special) @@ -2181,11 +2194,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (size (string-to-number (match-string 6)))) ;; Move to the beginning of the data. (goto-char (match-end 0)) - (setq time - (format-time-string - "%Y-%m-%d %H:%M" - (let ((high (truncate (/ time 65536)))) - (list high (truncate (- time (* 65536.0 high))))))) + (setq time (format-time-string "%Y-%m-%d %H:%M" time)) (setq extname (cond ((equal name "// ") (propertize ".<ExtNamesTable>." 'face 'italic)) diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el index 2f36e37b21c..985ae242453 100644 --- a/lisp/autoinsert.el +++ b/lisp/autoinsert.el @@ -91,23 +91,24 @@ If this contains a %s, that will be replaced by the matching rule." (defcustom auto-insert-alist - '((("\\.\\([Hh]\\|hh\\|hpp\\)\\'" . "C / C++ header") - (upcase (concat (file-name-nondirectory - (file-name-sans-extension buffer-file-name)) - "_" - (file-name-extension buffer-file-name))) + '((("\\.\\([Hh]\\|hh\\|hpp\\|hxx\\|h\\+\\+\\)\\'" . "C / C++ header") + (replace-regexp-in-string + "[^A-Z0-9]" "_" + (replace-regexp-in-string + "\\+" "P" + (upcase (file-name-nondirectory buffer-file-name)))) "#ifndef " str \n "#define " str "\n\n" _ "\n\n#endif") - (("\\.\\([Cc]\\|cc\\|cpp\\)\\'" . "C / C++ program") + (("\\.\\([Cc]\\|cc\\|cpp\\|cxx\\|c\\+\\+\\)\\'" . "C / C++ program") nil "#include \"" - (let ((stem (file-name-sans-extension buffer-file-name))) - (cond ((file-exists-p (concat stem ".h")) - (file-name-nondirectory (concat stem ".h"))) - ((file-exists-p (concat stem ".hh")) - (file-name-nondirectory (concat stem ".hh"))))) + (let ((stem (file-name-sans-extension buffer-file-name)) + ret) + (dolist (ext '("H" "h" "hh" "hpp" "hxx" "h++") ret) + (when (file-exists-p (concat stem "." ext)) + (setq ret (file-name-nondirectory (concat stem "." ext)))))) & ?\" | -10) (("[Mm]akefile\\'" . "Makefile") . "makefile.inc") @@ -305,6 +306,7 @@ file-name or one relative to `auto-insert-directory' or a function to call. ACTION may also be a vector containing several successive single actions as described above, e.g. [\"header.insert\" date-and-author-update]." :type 'sexp + :version "25.1" :group 'auto-insert) diff --git a/lisp/bindings.el b/lisp/bindings.el index da3f357a7e7..883914ecdc2 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -839,11 +839,11 @@ if `inhibit-field-text-motion' is non-nil." (let ((map minibuffer-local-map)) (define-key map "\en" 'next-history-element) (define-key map [next] 'next-history-element) - (define-key map [down] 'next-history-element) + (define-key map [down] 'next-line-or-history-element) (define-key map [XF86Forward] 'next-history-element) (define-key map "\ep" 'previous-history-element) (define-key map [prior] 'previous-history-element) - (define-key map [up] 'previous-history-element) + (define-key map [up] 'previous-line-or-history-element) (define-key map [XF86Back] 'previous-history-element) (define-key map "\es" 'next-matching-history-element) (define-key map "\er" 'previous-matching-history-element) @@ -925,14 +925,15 @@ if `inhibit-field-text-motion' is non-nil." "Keymap for search related commands.") (define-key esc-map "s" search-map) -(define-key search-map "o" 'occur) -(define-key search-map "hr" 'highlight-regexp) -(define-key search-map "hp" 'highlight-phrase) -(define-key search-map "hl" 'highlight-lines-matching-regexp) -(define-key search-map "h." 'highlight-symbol-at-point) -(define-key search-map "hu" 'unhighlight-regexp) -(define-key search-map "hf" 'hi-lock-find-patterns) -(define-key search-map "hw" 'hi-lock-write-interactive-patterns) +(define-key search-map "o" 'occur) +(define-key search-map "\M-w" 'eww-search-words) +(define-key search-map "hr" 'highlight-regexp) +(define-key search-map "hp" 'highlight-phrase) +(define-key search-map "hl" 'highlight-lines-matching-regexp) +(define-key search-map "h." 'highlight-symbol-at-point) +(define-key search-map "hu" 'unhighlight-regexp) +(define-key search-map "hf" 'hi-lock-find-patterns) +(define-key search-map "hw" 'hi-lock-write-interactive-patterns) ;;(defun function-key-error () ;; (interactive) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 8fbc92a7553..a49ee7ec8b3 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1298,8 +1298,8 @@ is greater than `bookmark-alist-modification-count'." ;;;###autoload (defun bookmark-write () - "Write bookmarks to a file (reading the file name with the minibuffer). -Don't use this in Lisp programs; use `bookmark-save' instead." + "Write bookmarks to a file (reading the file name with the minibuffer)." + (declare (interactive-only bookmark-save)) (interactive) (bookmark-maybe-load-default-file) (bookmark-save t)) diff --git a/lisp/bs.el b/lisp/bs.el index 88248f26899..c7a20b40489 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -1143,7 +1143,7 @@ and move point to current buffer." (delete-char -1) (bs--set-window-height) (bs--goto-current-buffer) - (font-lock-fontify-buffer) + (font-lock-ensure) (bs-apply-sort-faces) (set-buffer-modified-p nil))) diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index ddaae6454f1..23de53e0f0c 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el @@ -52,7 +52,7 @@ "The history list for quick-calc.") ;;;###autoload -(defun calc-do-quick-calc () +(defun calc-do-quick-calc (&optional insert) (require 'calc-ext) (calc-check-defines) (if (eq major-mode 'calc-mode) @@ -108,7 +108,8 @@ (setq buf long)))) (calc-handle-whys) (message "Result: %s" buf))) - (if (eq last-command-event 10) + (if (or insert + (eq last-command-event 10)) (insert shortbuf) (kill-new shortbuf))))) diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el index d6639608e8e..ebc5ba66ec6 100644 --- a/lisp/calc/calc-alg.el +++ b/lisp/calc/calc-alg.el @@ -293,7 +293,7 @@ (Math-objectp a)) ((eq (car a) 'var) (if (eq (car b) 'var) - (string-lessp (symbol-name (nth 1 a)) (symbol-name (nth 1 b))) + (string-lessp (nth 1 a) (nth 1 b)) (not (Math-numberp b)))) ((eq (car b) 'var) (Math-numberp a)) ((eq (car a) (car b)) @@ -302,7 +302,7 @@ (and b (or (null a) (math-beforep (car a) (car b))))) - (t (string-lessp (symbol-name (car a)) (symbol-name (car b)))))) + (t (string-lessp (car a) (car b))))) (defsubst math-simplify-extended (a) diff --git a/lisp/calc/calc-arith.el b/lisp/calc/calc-arith.el index 3e2d9d86665..de27c5684e6 100644 --- a/lisp/calc/calc-arith.el +++ b/lisp/calc/calc-arith.el @@ -2249,7 +2249,7 @@ (defun math-min-list (a b) (if b - (if (or (Math-anglep (car b)) (eq (car b) 'date) + (if (or (Math-anglep (car b)) (eq (caar b) 'date) (and (eq (car (car b)) 'intv) (math-intv-constp (car b))) (math-infinitep (car b))) (math-min-list (math-min a (car b)) (cdr b)) @@ -2279,7 +2279,7 @@ (defun math-max-list (a b) (if b - (if (or (Math-anglep (car b)) (eq (car b) 'date) + (if (or (Math-anglep (car b)) (eq (caar b) 'date) (and (eq (car (car b)) 'intv) (math-intv-constp (car b))) (math-infinitep (car b))) (math-max-list (math-max a (car b)) (cdr b)) diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index 4b975b13b6d..ca6d021cef2 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el @@ -273,7 +273,10 @@ (m (math-normalize (nth 2 a))) (s (let ((calc-internal-prec (max (- calc-internal-prec 4) 3))) (math-normalize (nth 3 a))))) - (if (math-negp h) + (if (or + (math-negp h) + (and (= h 0) (math-negp m)) + (and (= h 0) (= m 0) (math-negp s))) (progn (if (math-posp s) (setq s (math-add s -60) diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el index d407a55b1d2..511e208ddea 100644 --- a/lisp/calc/calc-help.el +++ b/lisp/calc/calc-help.el @@ -366,9 +366,9 @@ C-w Describe how there is no warranty for Calc." (Info-goto-node (buffer-substring (match-beginning 1) (match-end 1)))) (or (let ((case-fold-search nil)) (or (re-search-forward (format "\\[`%s'\\]\\|(`%s')\\|\\<The[ \n]`%s'" - (or target thing) - (or target thing) - (or target thing)) nil t) + (or target (regexp-quote thing)) + (or target (regexp-quote thing)) + (or target (regexp-quote thing))) nil t) (and not-quoted (let ((case-fold-search t)) (search-forward (or target thing) nil t))) @@ -376,9 +376,9 @@ C-w Describe how there is no warranty for Calc." (search-forward (or target thing) nil t))) (let ((case-fold-search t)) (or (re-search-forward (format "\\[`%s'\\]\\|(`%s')\\|\\<The[ \n]`%s'" - (or target thing) - (or target thing) - (or target thing)) nil t) + (or target (regexp-quote thing)) + (or target (regexp-quote thing)) + (or target (regexp-quote thing))) nil t) (search-forward (format "`%s'" (or target thing)) nil t) (search-forward (or target thing) nil t)))) (beginning-of-line) diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index 0d6fb863fd4..27114077d15 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -139,6 +139,7 @@ "calc-")))) (let* ((kmap (calc-user-key-map)) (old (assq key kmap))) + ;; FIXME: Why not (define-key kmap (vector key) func)? (if old (setcdr old func) (setcdr kmap (cons (cons key func) (cdr kmap)))))))) @@ -322,6 +323,7 @@ (if key (let* ((kmap (calc-user-key-map)) (old (assq key kmap))) + ;; FIXME: Why not (define-key kmap (vector key) cmd)? (if old (setcdr old cmd) (setcdr kmap (cons (cons key cmd) (cdr kmap))))))) @@ -467,6 +469,7 @@ (format "z%c" key))))) (let* ((kmap (calc-user-key-map)) (old (assq key kmap))) + ;; FIXME: Why not (define-key kmap (vector key) func)? (if old (setcdr old cmd) (setcdr kmap (cons (cons key cmd) (cdr kmap)))))))) diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index 7bbf48c5aa9..726a7202a8a 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el @@ -143,10 +143,7 @@ TEXT and CALCVAL are the TEXT and internal structure of stack entries.") "Set the contents of the Calc register REGISTER to (TEXT . CALCVAL), as well as set the contents of the Emacs register REGISTER to TEXT." (set-register register text) - (let ((aelt (assq register calc-register-alist))) - (if aelt - (setcdr aelt (cons text calcval)) - (push (cons register (cons text calcval)) calc-register-alist)))) + (setf (alist-get register calc-register-alist) (cons text calcval))) (defun calc-get-register (reg) "Return the CALCVAL portion of the contents of the Calc register REG, diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index b080fc5276e..58bbdb81289 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -147,7 +147,7 @@ (declare-function calc-edit-finish "calc-yank" (&optional keep)) (declare-function calc-edit-cancel "calc-yank" ()) (declare-function calc-locate-cursor-element "calc-yank" (pt)) -(declare-function calc-do-quick-calc "calc-aent" ()) +(declare-function calc-do-quick-calc "calc-aent" (&optional insert)) (declare-function calc-do-calc-eval "calc-aent" (str separator args)) (declare-function calc-do-keypad "calc-keypd" (&optional full-display interactive)) (declare-function calcFunc-unixtime "calc-forms" (date &optional zone)) @@ -1549,10 +1549,12 @@ commands given here will actually operate on the *Calculator* stack." (and kbuf (bury-buffer kbuf)))))) ;;;###autoload -(defun quick-calc () - "Do a quick calculation in the minibuffer without invoking full Calculator." - (interactive) - (calc-do-quick-calc)) +(defun quick-calc (&optional insert) + "Do a quick calculation in the minibuffer without invoking full Calculator. +With prefix argument INSERT, insert the result in the current +buffer. Otherwise, the result is copied into the kill ring." + (interactive "P") + (calc-do-quick-calc insert)) ;;;###autoload (defun calc-eval (str &optional separator &rest args) diff --git a/lisp/calculator.el b/lisp/calculator.el index 117b8bde313..0aef07b1750 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el @@ -1,4 +1,4 @@ -;;; calculator.el --- a [not so] simple calculator for Emacs -*- lexical-binding: t -*- +;;; calculator.el --- a calculator for Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1998, 2000-2015 Free Software Foundation, Inc. @@ -33,15 +33,8 @@ ;; "Run the Emacs calculator." t) ;; (global-set-key [(control return)] 'calculator) ;; -;; Written by Eli Barzilay: Maze is Life! eli@barzilay.org -;; http://www.barzilay.org/ +;; Written by Eli Barzilay, eli@barzilay.org ;; -;; For latest version, check -;; http://www.barzilay.org/misc/calculator.el -;; - -;;; History: -;; I hate history. ;;;===================================================================== ;;; Customization: @@ -79,7 +72,7 @@ This determines the default behavior of unary operators." (defcustom calculator-prompt "Calc=%s> " "The prompt used by the Emacs calculator. -It should contain a \"%s\" somewhere that will indicate the i/o radices; +It should contain a \"%s\" somewhere that will indicate the i/o radixes; this will be a two-character string as described in the documentation for `calculator-mode'." :type 'string @@ -115,8 +108,8 @@ See `calculator-radix-grouping-mode'." (defcustom calculator-remove-zeros t "Non-nil value means delete all redundant zero decimal digits. -If this value is not t, and not nil, redundant zeros are removed except -for one and if it is nil, nothing is removed. +If this value is not t and not nil, redundant zeros are removed except +for one. Used by the `calculator-remove-zeros' function." :type '(choice (const t) (const leave-decimal) (const nil)) :group 'calculator) @@ -136,23 +129,27 @@ should be able to handle special symbol arguments, currently `left' and associated with the displayer function (for example to change the number of digits displayed). -An exception to the above is the case of the list (std C) where C is a -character, in this case the `calculator-standard-displayer' function -will be used with this character for a format string." - :type '(choice (function) (string) (list (const std) character) (sexp)) +An exception to the above is the case of the list (std C [G]) where C is +a character and G is an optional boolean, in this case the +`calculator-standard-displayer' function will be used with these as +arguments." + :type '(choice (function) (string) (sexp) + (list (const std) character) + (list (const std) character boolean)) :group 'calculator) (defcustom calculator-displayers '(((std ?n) "Standard display, decimal point or scientific") (calculator-eng-display "Eng display") - ((std ?f) "Standard display, decimal point") + ((std ?f t) "Standard display, decimal point with grouping") ((std ?e) "Standard display, scientific") ("%S" "Emacs printer")) "A list of displayers. Each element is a list of a displayer and a description string. The -first element is the one which is currently used, this is for the display -of result values not values in expressions. A displayer specification -is the same as the values that can be stored in `calculator-displayer'. +first element is the one which is currently used, this is for the +display of result values not values in expressions. A displayer +specification is the same as the values that can be stored in +`calculator-displayer'. `calculator-rotate-displayer' rotates this list." :type 'sexp @@ -182,7 +179,7 @@ Otherwise show as a negative number." (defcustom calculator-mode-hook nil "List of hook functions for `calculator-mode' to run. Note: if `calculator-electric-mode' is on, then this hook will get -activated in the minibuffer - in that case it should not do much more +activated in the minibuffer -- in that case it should not do much more than local key settings and other effects that will change things outside the scope of calculator related code." :type 'hook @@ -224,15 +221,14 @@ Examples: (\"tF\" mt-to-ft (/ X 0.3048) 1) (\"tM\" ft-to-mt (* X 0.3048) 1))) -* Using a function-like form is very simple, X for an argument (Y the - second in case of a binary operator), TX is a truncated version of X - and F does a recursive call, Here is a [very inefficient] Fibonacci - number calculation: +* Using a function-like form is very simple: use `X' for the argument + (`Y' for the second in case of a binary operator), `TX' is a truncated + version of `X' and `F' for a recursive call. Here is a [very + inefficient] Fibonacci number calculation: (add-to-list 'calculator-user-operators - '(\"F\" fib (if (<= TX 1) - 1 - (+ (F (- TX 1)) (F (- TX 2)))) 0)) + '(\"F\" fib + (if (<= TX 1) 1 (+ (F (- TX 1)) (F (- TX 2)))))) Note that this will be either postfix or prefix, according to `calculator-unary-style'." @@ -248,7 +244,7 @@ Examples: ;;; Variables (defvar calculator-initial-operators - '(;; "+"/"-" have keybindings of themselves, not calculator-ops + '(;; "+"/"-" have keybindings of their own, not calculator-ops ("=" = identity 1 -1) (nobind "+" + + 2 4) (nobind "-" - - 2 4) @@ -303,26 +299,27 @@ user-defined operators, use `calculator-user-operators' instead.") versions), `DX' (converted to radians if degrees mode is on), `D' (function for converting radians to degrees if deg mode is on), `L' (list of saved values), `F' (function for recursive iteration calls) - and evaluates to the function value - these variables are capital; + and evaluates to the function value -- these variables are capital; 4. The function's arity, optional, one of: 2 => binary, -1 => prefix - unary, +1 => postfix unary, 0 => a 0-arg operator func, non-number => - postfix/prefix as determined by `calculator-unary-style' (the - default); + unary, +1 => postfix unary, 0 => a 0-arg operator func (note that + using such a function replaces the currently entered number, if any), + non-number (the default) => postfix or prefix as determined by + `calculator-unary-style'; -5. The function's precedence - should be in the range of 1 (lowest) to +5. The function's precedence -- should be in the range of 1 (lowest) to 9 (highest) (optional, defaults to 1); It it possible have a unary prefix version of a binary operator if it comes later in this list. If the list begins with the symbol 'nobind, -then no key binding will take place - this is only useful for predefined -keys. +then no key binding will take place -- this is only useful for +predefined keys. Use `calculator-user-operators' to add operators to this list, see its documentation for an example.") (defvar calculator-stack nil - "Stack contents - operations and operands.") + "Stack contents -- operations and operands.") (defvar calculator-curnum nil "Current number being entered (as a string).") @@ -427,9 +424,9 @@ Used for repeating operations in calculator-repR/L.") (calculator-backspace [backspace]) ))) (while p - ;; reverse the keys so first defs come last - makes the more - ;; sensible bindings visible in the menu - (let ((func (car (car p))) (keys (reverse (cdr (car p))))) + ;; reverse the keys so earlier definitions come last -- makes + ;; the more sensible bindings visible in the menu + (let ((func (caar p)) (keys (reverse (cdar p)))) (while keys (define-key map (car keys) func) (setq keys (cdr keys)))) @@ -441,7 +438,7 @@ Used for repeating operations in calculator-repR/L.") ;; make C-h work in text-mode (or window-system (define-key map [?\C-h] 'calculator-backspace)) ;; set up a menu - (if (and calculator-use-menu (not (boundp 'calculator-menu))) + (when (and calculator-use-menu (not (boundp 'calculator-menu))) (let ((radix-selectors (mapcar (lambda (x) `([,(nth 0 x) @@ -580,7 +577,7 @@ Used for repeating operations in calculator-repR/L.") "A [not so] simple calculator for Emacs. This calculator is used in the same way as other popular calculators -like xcalc or calc.exe - but using an Emacs interface. +like xcalc or calc.exe -- but using an Emacs interface. Expressions are entered using normal infix notation, parens are used as normal. Unary functions are usually postfix, but some depends on the @@ -589,8 +586,7 @@ specified, then it is fixed, otherwise it depends on this variable). `+' and `-' can be used as either binary operators or prefix unary operators. Numbers can be entered with exponential notation using `e', except when using a non-decimal radix mode for input (in this case `e' -will be the hexadecimal digit). If the result of a calculation is too -large (out of range for Emacs), the value of \"inf\" is returned. +will be the hexadecimal digit). Here are the editing keys: * `RET' `=' evaluate the current expression @@ -609,8 +605,8 @@ These operators are pre-defined: * `_' `;' postfix unary negation and reciprocal * `^' `L' binary operators for x^y and log(x) in base y * `Q' `!' unary square root and factorial -* `S' `C' `T' unary trigonometric operators - sin, cos and tan -* `|' `#' `&' `~' bitwise operators - or, xor, and, not +* `S' `C' `T' unary trigonometric operators: sin, cos and tan +* `|' `#' `&' `~' bitwise operators: or, xor, and, not The trigonometric functions can be inverted if prefixed with an `I', see below for the way to use degrees instead of the default radians. @@ -636,9 +632,9 @@ The prompt indicates the current modes: Also, the quote key can be used to switch display modes for decimal numbers (double-quote rotates back), and the two brace characters -\(\"{\" and \"}\" change display parameters that these displayers use (if -they handle such). If output is using any radix mode, then these keys -toggle digit grouping mode and the chunk size. +\(\"{\" and \"}\" change display parameters that these displayers use, +if they handle such). If output is using any radix mode, then these +keys toggle digit grouping mode and the chunk size. Values can be saved for future reference in either a list of saved values, or in registers. @@ -680,19 +676,21 @@ more information. "Run the Emacs calculator. See the documentation for `calculator-mode' for more information." (interactive) - (if calculator-restart-other-mode + (when calculator-restart-other-mode (setq calculator-electric-mode (not calculator-electric-mode))) - (if calculator-initial-operators - (progn (calculator-add-operators calculator-initial-operators) - (setq calculator-initial-operators nil) - ;; don't change this since it is a customization variable, - ;; its set function will add any new operators - (calculator-add-operators calculator-user-operators))) + (when calculator-initial-operators + (calculator-add-operators calculator-initial-operators) + (setq calculator-initial-operators nil) + ;; don't change this since it is a customization variable, + ;; its set function will add any new operators + (calculator-add-operators calculator-user-operators)) (setq calculator-buffer (get-buffer-create "*calculator*")) (if calculator-electric-mode (save-window-excursion - (progn (require 'electric) (message nil)) ; hide load message - (let (old-g-map old-l-map (echo-keystrokes 0) + (require 'electric) (message nil) ; hide load message + (let (old-g-map old-l-map + (old-buf (window-buffer (minibuffer-window))) + (echo-keystrokes 0) (garbage-collection-messages nil)) ; no gc msg when electric (set-window-buffer (minibuffer-window) calculator-buffer) (select-window (minibuffer-window)) @@ -712,8 +710,8 @@ See the documentation for `calculator-mode' for more information." (lambda () 'noprompt) nil (lambda (_x _y) (calculator-update-display)))) - (and calculator-buffer - (catch 'calculator-done (calculator-quit))) + (set-window-buffer (minibuffer-window) old-buf) + (kill-buffer calculator-buffer) (use-local-map old-l-map) (use-global-map old-g-map)))) (progn @@ -722,45 +720,8 @@ See the documentation for `calculator-mode' for more information." (let ((window-min-height 2)) ;; maybe leave two lines for our window because of the ;; normal `raised' mode line - (select-window - (split-window-below - ;; If the mode line might interfere with the calculator - ;; buffer, use 3 lines instead. - (if (and (fboundp 'face-attr-construct) - (let* ((dh (plist-get (face-attr-construct 'default) :height)) - (mf (face-attr-construct 'mode-line)) - (mh (plist-get mf :height))) - ;; If the mode line is shorter than the default, - ;; stick with 2 lines. (It may be necessary to - ;; check how much shorter.) - (and - (not - (or (and (integerp dh) - (integerp mh) - (< mh dh)) - (and (numberp mh) - (not (integerp mh)) - (< mh 1)))) - (or - ;; If the mode line is taller than the default, - ;; use 3 lines. - (and (integerp dh) - (integerp mh) - (> mh dh)) - (and (numberp mh) - (not (integerp mh)) - (> mh 1)) - ;; If the mode line has a box with non-negative line-width, - ;; use 3 lines. - (let* ((bx (plist-get mf :box)) - (lh (plist-get bx :line-width))) - (and bx - (or - (not lh) - (> lh 0)))) - ;; If the mode line has an overline, use 3 lines. - (plist-get (face-attr-construct 'mode-line) :overline))))) - -3 -2))) + (select-window (split-window-below + (if (calculator-need-3-lines) -3 -2))) (switch-to-buffer calculator-buffer))) ((not (eq (current-buffer) calculator-buffer)) (select-window (get-buffer-window calculator-buffer)))) @@ -768,24 +729,46 @@ See the documentation for `calculator-mode' for more information." (setq buffer-read-only t) (calculator-reset) (message "Hit `?' For a quick help screen."))) - (if (and calculator-restart-other-mode calculator-electric-mode) + (when (and calculator-restart-other-mode calculator-electric-mode) (calculator))) +(defun calculator-need-3-lines () + ;; If the mode line might interfere with the calculator buffer, use 3 + ;; lines instead. + (let* ((dh (face-attribute 'default :height)) + (mh (face-attribute 'mode-line :height))) + ;; if the mode line is shorter than the default, stick with 2 lines + ;; (it may be necessary to check how much shorter) + (and (not (or (and (integerp dh) (integerp mh) (< mh dh)) + (and (numberp mh) (not (integerp mh)) (< mh 1)))) + (or ;; if the mode line is taller than the default, use 3 lines + (and (integerp dh) (integerp mh) (> mh dh)) + (and (numberp mh) (not (integerp mh)) (> mh 1)) + ;; if the mode line has a box with non-negative line-width, + ;; use 3 lines + (let* ((bx (face-attribute 'mode-line :box)) + (lh (plist-get bx :line-width))) + (and bx (or (not lh) (> lh 0)))) + ;; if the mode line has an overline, use 3 lines + (not (memq (face-attribute 'mode-line :overline) + '(nil unspecified))))))) + (defun calculator-message (string &rest arguments) - "Same as `message', but special handle of electric mode." + "Same as `message', but also handle electric mode." (apply 'message string arguments) - (if calculator-electric-mode - (progn (sit-for 1) (message nil)))) + (when calculator-electric-mode (sit-for 1) (message nil))) ;;;--------------------------------------------------------------------- ;;; Operators (defun calculator-op-arity (op) - "Return OP's arity, 2, +1 or -1." - (let ((arity (or (nth 3 op) 'x))) - (if (numberp arity) - arity - (if (eq calculator-unary-style 'postfix) +1 -1)))) + "Return OP's arity. +Current results are one of 2 (binary), +1 (postfix), -1 (prefix), or +0 (nullary)." + (let ((arity (nth 3 op))) + (cond ((numberp arity) arity) + ((eq calculator-unary-style 'postfix) +1) + (t -1)))) (defun calculator-op-prec (op) "Return OP's precedence for reducing when inserting into the stack. @@ -798,8 +781,8 @@ Adds MORE-OPS to `calculator-operator', called initially to handle `calculator-initial-operators' and `calculator-user-operators'." (let ((added-ops nil)) (while more-ops - (or (eq (car (car more-ops)) 'nobind) - (let ((i -1) (key (car (car more-ops)))) + (or (eq (caar more-ops) 'nobind) + (let ((i -1) (key (caar more-ops))) ;; make sure the key is undefined, so it's easy to define ;; prefix keys (while (< (setq i (1+ i)) (length key)) @@ -811,8 +794,8 @@ Adds MORE-OPS to `calculator-operator', called initially to handle calculator-mode-map (substring key 0 (1+ i)) nil) (setq i (length key))))) (define-key calculator-mode-map key 'calculator-op))) - (setq added-ops (cons (if (eq (car (car more-ops)) 'nobind) - (cdr (car more-ops)) + (setq added-ops (cons (if (eq (caar more-ops) 'nobind) + (cdar more-ops) (car more-ops)) added-ops)) (setq more-ops (cdr more-ops))) @@ -833,50 +816,37 @@ Adds MORE-OPS to `calculator-operator', called initially to handle (setq calculator-restart-other-mode nil) (calculator-update-display)) -(defun calculator-get-prompt () +(defun calculator-get-display () "Return a string to display. -The string is set not to exceed the screen width." - (let* ((calculator-prompt - (format calculator-prompt +The result should not exceed the screen width." + (let* ((in-r (and calculator-input-radix + (char-to-string + (car (rassq calculator-input-radix + calculator-char-radix))))) + (out-r (and calculator-output-radix + (char-to-string + (car (rassq calculator-output-radix + calculator-char-radix))))) + (prompt (format calculator-prompt + (cond ((or in-r out-r) + (concat (or in-r "=") + (if (equal in-r out-r) "=" + (or out-r "=")))) + (calculator-deg "D=") + (t "==")))) + (expr + (concat (cdr calculator-stack-display) (cond - ((or calculator-output-radix calculator-input-radix) - (if (eq calculator-output-radix - calculator-input-radix) - (concat - (char-to-string - (car (rassq calculator-output-radix - calculator-char-radix))) - "=") - (concat - (if calculator-input-radix - (char-to-string - (car (rassq calculator-input-radix - calculator-char-radix))) - "=") - (char-to-string - (car (rassq calculator-output-radix - calculator-char-radix)))))) - (calculator-deg "D=") - (t "==")))) - (prompt - (concat calculator-prompt - (cdr calculator-stack-display) - (cond (calculator-curnum - ;; number being typed - (concat calculator-curnum "_")) - ((and (= 1 (length calculator-stack)) - calculator-display-fragile) - ;; only the result is shown, next number will - ;; restart - nil) - (t - ;; waiting for a number or an operator - "?")))) - (trim (- (length prompt) (1- (window-width))))) - (if (<= trim 0) - prompt - (concat calculator-prompt - (substring prompt (+ trim (length calculator-prompt))))))) + ;; entering a number + (calculator-curnum (concat calculator-curnum "_")) + ;; showing a result + ((and (= 1 (length calculator-stack)) + calculator-display-fragile) + nil) + ;; waiting for a number or an operator + (t "?")))) + (trim (+ (length expr) (length prompt) 1 (- (window-width))))) + (concat prompt (if (<= trim 0) expr (substring expr trim))))) (defun calculator-string-to-number (str) "Convert the given STR to a number, according to the value of @@ -902,7 +872,7 @@ The string is set not to exceed the screen width." "Warning: Ignoring bad input character `%c'." ch) (sit-for 1) value)))) - (if (if (< new-value 0) (> value 0) (< value 0)) + (when (if (< new-value 0) (> value 0) (< value 0)) (calculator-message "Warning: Overflow in input.")) (setq value new-value)) value) @@ -916,9 +886,12 @@ The string is set not to exceed the screen width." ((stringp str) (concat str ".0")) (t "0.0")))))) -(defun calculator-curnum-value () - "Get the numeric value of the displayed number string as a float." - (calculator-string-to-number calculator-curnum)) +(defun calculator-push-curnum () + "Push the numeric value of the displayed number to the stack." + (when calculator-curnum + (push (calculator-string-to-number calculator-curnum) + calculator-stack) + (setq calculator-curnum nil))) (defun calculator-rotate-displayer (&optional new-disp) "Switch to the next displayer on the `calculator-displayers' list. @@ -956,7 +929,7 @@ If radix output mode is active, toggle digit grouping." (calculator-rotate-displayer (car (last calculator-displayers)))) (defun calculator-displayer-prev () - "Send the current displayer function a 'left argument. + "Send the current displayer function a `left' argument. This is used to modify display arguments (if the current displayer function supports this). If radix output mode is active, increase the grouping size." @@ -967,13 +940,12 @@ If radix output mode is active, increase the grouping size." (calculator-enter)) (and (car calculator-displayers) (let ((disp (caar calculator-displayers))) - (cond - ((symbolp disp) (funcall disp 'left)) - ((and (consp disp) (eq 'std (car disp))) - (calculator-standard-displayer 'left (cadr disp)))))))) + (cond ((symbolp disp) (funcall disp 'left)) + ((and (consp disp) (eq 'std (car disp))) + (calculator-standard-displayer 'left))))))) (defun calculator-displayer-next () - "Send the current displayer function a 'right argument. + "Send the current displayer function a `right' argument. This is used to modify display arguments (if the current displayer function supports this). If radix output mode is active, decrease the grouping size." @@ -984,44 +956,51 @@ If radix output mode is active, decrease the grouping size." (calculator-enter)) (and (car calculator-displayers) (let ((disp (caar calculator-displayers))) - (cond - ((symbolp disp) (funcall disp 'right)) - ((and (consp disp) (eq 'std (car disp))) - (calculator-standard-displayer 'right (cadr disp)))))))) + (cond ((symbolp disp) (funcall disp 'right)) + ((and (consp disp) (eq 'std (car disp))) + (calculator-standard-displayer 'right))))))) (defun calculator-remove-zeros (numstr) "Get a number string NUMSTR and remove unnecessary zeros. The behavior of this function is controlled by `calculator-remove-zeros'." - (cond ((and (eq calculator-remove-zeros t) - (string-match "\\.0+\\([eE][+-]?[0-9]*\\)?$" numstr)) - ;; remove all redundant zeros leaving an integer - (if (match-beginning 1) - (concat (substring numstr 0 (match-beginning 0)) - (match-string 1 numstr)) - (substring numstr 0 (match-beginning 0)))) - ((and calculator-remove-zeros - (string-match - "\\..\\([0-9]*[1-9]\\)?\\(0+\\)\\([eE][+-]?[0-9]*\\)?$" - numstr)) - ;; remove zeros, except for first after the "." - (if (match-beginning 3) - (concat (substring numstr 0 (match-beginning 2)) - (match-string 3 numstr)) - (substring numstr 0 (match-beginning 2)))) - (t numstr))) - -(defun calculator-standard-displayer (num char) + (let* ((s (if (not (eq calculator-remove-zeros t)) numstr + ;; remove all redundant zeros leaving an integer + (replace-regexp-in-string + "\\.0+\\([eE].*\\)?$" "\\1" numstr))) + (s (if (not calculator-remove-zeros) s + ;; remove zeros, except for first after the "." + (replace-regexp-in-string + "\\(\\..[0-9]*?\\)0+\\([eE].*\\)?$" "\\1\\2" s)))) + s)) + +(defun calculator-groupize-number (str n sep &optional fromleft) + "Return the input string STR with occurrences of SEP that separate +every N characters starting from the right, or from the left if +FROMLEFT is true." + (let* ((len (length str)) (i (/ len n)) (j (% len n)) + (r (if (or (not fromleft) (= j 0)) '() + (list (substring str (- len j)))))) + (while (> i 0) + (let* ((e (* i n)) (e (if fromleft e (+ e j)))) + (push (substring str (- e n) e) r)) + (setq i (1- i))) + (when (and (not fromleft) (> j 0)) + (push (substring str 0 j) r)) + (mapconcat 'identity r sep))) + +(defun calculator-standard-displayer (num &optional char group-p) "Standard display function, used to display NUM. Its behavior is determined by `calculator-number-digits' and the given CHAR argument (both will be used to compose a format string). If the char is \"n\" then this function will choose one between %f or %e, this is a work around %g jumping to exponential notation too fast. -The special 'left and 'right symbols will make it change the current -number of digits displayed (`calculator-number-digits'). +It will also split digit sequences into comma-separated groups +and/or remove redundant zeros. -It will also remove redundant zeros from the result." +The special `left' and `right' symbols will make it change the current +number of digits displayed (`calculator-number-digits')." (if (symbolp num) (cond ((eq num 'left) (and (> calculator-number-digits 0) @@ -1032,56 +1011,51 @@ It will also remove redundant zeros from the result." (setq calculator-number-digits (1+ calculator-number-digits)) (calculator-enter))) - (let ((str (if (zerop num) - "0" - (format - (concat "%." - (number-to-string calculator-number-digits) - (if (eq char ?n) - (let ((n (abs num))) - (if (or (< n 0.001) (> n 1e8)) "e" "f")) - (string char))) - num)))) - (calculator-remove-zeros str)))) + (let* ((s (if (eq char ?n) + (let ((n (abs num))) + (if (or (and (< 0 n) (< n 0.001)) (< 1e8 n)) ?e ?f)) + char)) + (s (format "%%.%s%c" calculator-number-digits s)) + (s (calculator-remove-zeros (format s num))) + (s (if (or (not group-p) (string-match-p "[eE]" s)) s + (replace-regexp-in-string + "\\([0-9]+\\)\\(?:\\..*\\|$\\)" + (lambda (_) (calculator-groupize-number + (match-string 1 s) 3 ",")) + s nil nil 1)))) + s))) (defun calculator-eng-display (num) "Display NUM in engineering notation. The number of decimal digits used is controlled by `calculator-number-digits', so to change it at runtime you have to use -the 'left or 'right when one of the standard modes is used." +the `left' or `right' when one of the standard modes is used." (if (symbolp num) (cond ((eq num 'left) (setq calculator-eng-extra - (if calculator-eng-extra - (1+ calculator-eng-extra) - 1)) + (if calculator-eng-extra (1+ calculator-eng-extra) 1)) (let ((calculator-eng-tmp-show t)) (calculator-enter))) ((eq num 'right) (setq calculator-eng-extra - (if calculator-eng-extra - (1- calculator-eng-extra) - -1)) + (if calculator-eng-extra (1- calculator-eng-extra) -1)) (let ((calculator-eng-tmp-show t)) (calculator-enter)))) (let ((exp 0)) - (and (not (= 0 num)) - (progn - (while (< (abs num) 1.0) - (setq num (* num 1000.0)) (setq exp (- exp 3))) - (while (> (abs num) 999.0) - (setq num (/ num 1000.0)) (setq exp (+ exp 3))) - (and calculator-eng-tmp-show - (not (= 0 calculator-eng-extra)) - (let ((i calculator-eng-extra)) - (while (> i 0) - (setq num (* num 1000.0)) (setq exp (- exp 3)) - (setq i (1- i))) - (while (< i 0) - (setq num (/ num 1000.0)) (setq exp (+ exp 3)) - (setq i (1+ i))))))) + (unless (= 0 num) + (while (< (abs num) 1.0) + (setq num (* num 1000.0)) (setq exp (- exp 3))) + (while (> (abs num) 999.0) + (setq num (/ num 1000.0)) (setq exp (+ exp 3))) + (when (and calculator-eng-tmp-show + (not (= 0 calculator-eng-extra))) + (let ((i calculator-eng-extra)) + (while (> i 0) + (setq num (* num 1000.0)) (setq exp (- exp 3)) + (setq i (1- i))) + (while (< i 0) + (setq num (/ num 1000.0)) (setq exp (+ exp 3)) + (setq i (1+ i)))))) (or calculator-eng-tmp-show (setq calculator-eng-extra nil)) - (let ((str (format (concat "%." (number-to-string - calculator-number-digits) - "f") + (let ((str (format (format "%%.%sf" calculator-number-digits) num))) (concat (let ((calculator-remove-zeros ;; make sure we don't leave integers @@ -1092,56 +1066,48 @@ the 'left or 'right when one of the standard modes is used." (defun calculator-number-to-string (num) "Convert NUM to a displayable string." (cond - ((and (numberp num) calculator-output-radix) - ;; print with radix - for binary I convert the octal number - (let ((str (format (if (eq calculator-output-radix 'hex) "%x" "%o") - (calculator-truncate - (if calculator-2s-complement num (abs num)))))) - (if (eq calculator-output-radix 'bin) - (let ((i -1) (s "")) - (while (< (setq i (1+ i)) (length str)) - (setq s - (concat s - (cdr (assq (aref str i) - '((?0 . "000") (?1 . "001") - (?2 . "010") (?3 . "011") - (?4 . "100") (?5 . "101") - (?6 . "110") (?7 . "111"))))))) - (string-match "^0*\\(.+\\)" s) - (setq str (match-string 1 s)))) - (if calculator-radix-grouping-mode - (let ((d (/ (length str) calculator-radix-grouping-digits)) - (r (% (length str) calculator-radix-grouping-digits))) - (while (>= (setq d (1- d)) (if (zerop r) 1 0)) - (let ((i (+ r (* d calculator-radix-grouping-digits)))) - (setq str (concat (substring str 0 i) - calculator-radix-grouping-separator - (substring str i))))))) - (upcase - (if (and (not calculator-2s-complement) (< num 0)) - (concat "-" str) - str)))) - ((and (numberp num) calculator-displayer) - (cond - ((stringp calculator-displayer) - (format calculator-displayer num)) - ((symbolp calculator-displayer) - (funcall calculator-displayer num)) - ((eq 'std (car-safe calculator-displayer)) - (calculator-standard-displayer num (cadr calculator-displayer))) - ((listp calculator-displayer) - (eval calculator-displayer `((num. ,num)))) - (t (prin1-to-string num t)))) - ;; operators are printed here - (t (prin1-to-string (nth 1 num) t)))) + ;; operators are printed here, the rest is for numbers + ((not (numberp num)) (prin1-to-string (nth 1 num) t)) + ;; %f/%e handle these, but avoid them in radix or in user displayers + ((and (floatp num) (isnan num)) "NaN") + ((<= 1.0e+INF num) "Inf") + ((<= num -1.0e+INF) "-Inf") + (calculator-output-radix + ;; print with radix -- for binary, convert the octal number + (let* ((fmt (if (eq calculator-output-radix 'hex) "%x" "%o")) + (str (if calculator-2s-complement num (abs num))) + (str (format fmt (calculator-truncate str))) + (bins '((?0 "000") (?1 "001") (?2 "010") (?3 "011") + (?4 "100") (?5 "101") (?6 "110") (?7 "111"))) + (str (if (not (eq calculator-output-radix 'bin)) str + (replace-regexp-in-string + "^0+\\(.\\)" "\\1" + (apply 'concat (mapcar (lambda (c) + (cadr (assq c bins))) + str))))) + (str (if (not calculator-radix-grouping-mode) str + (calculator-groupize-number + str calculator-radix-grouping-digits + calculator-radix-grouping-separator)))) + (upcase (if (or calculator-2s-complement (>= num 0)) str + (concat "-" str))))) + ((stringp calculator-displayer) (format calculator-displayer num)) + ((symbolp calculator-displayer) (funcall calculator-displayer num)) + ((eq 'std (car-safe calculator-displayer)) + (apply 'calculator-standard-displayer + num (cdr calculator-displayer))) + ((listp calculator-displayer) + (eval `(let ((num ',num)) ,calculator-displayer) t)) + ;; nil (or bad) displayer + (t (prin1-to-string num t)))) (defun calculator-update-display (&optional force) "Update the display. If optional argument FORCE is non-nil, don't use the cached string." (set-buffer calculator-buffer) ;; update calculator-stack-display - (if (or force - (not (eq (car calculator-stack-display) calculator-stack))) + (when (or force (not (eq (car calculator-stack-display) + calculator-stack))) (setq calculator-stack-display (cons calculator-stack (if calculator-stack @@ -1158,9 +1124,15 @@ If optional argument FORCE is non-nil, don't use the cached string." " " (and calculator-display-fragile calculator-saved-list - (= (car calculator-stack) - (nth calculator-saved-ptr - calculator-saved-list)) + ;; Hack: use `eq' to compare the number: it's a + ;; flonum, so `eq' means that its the actual + ;; number rather than a computation that had an + ;; equal result (eg, enter 1,3,2, use "v" to see + ;; the average -- it now shows "2" instead of + ;; "2 [3]"). + (eq (car calculator-stack) + (nth calculator-saved-ptr + calculator-saved-list)) (if (= 0 calculator-saved-ptr) (format "[%s]" (length calculator-saved-list)) (format "[%s/%s]" @@ -1170,165 +1142,99 @@ If optional argument FORCE is non-nil, don't use the cached string." "")))) (let ((inhibit-read-only t)) (erase-buffer) - (insert (calculator-get-prompt))) + (insert (calculator-get-display))) (set-buffer-modified-p nil) - (if calculator-display-fragile - (goto-char (1+ (length calculator-prompt))) - (goto-char (1- (point))))) + (goto-char (if calculator-display-fragile + (1+ (length calculator-prompt)) + (1- (point))))) ;;;--------------------------------------------------------------------- ;;; Stack computations +(defun calculator-reduce-stack-once (prec) + "Worker for `calculator-reduce-stack'." + (cl-flet ((check (ar op) (and (listp op) + (<= prec (calculator-op-prec op)) + (= ar (calculator-op-arity op)))) + (call (op &rest args) (apply 'calculator-funcall + (nth 2 op) args))) + (pcase calculator-stack + ;; reduce "... ( x )" --> "... x" + (`((,_ \) . ,_) ,(and X (pred numberp)) (,_ \( . ,_) . ,rest) + (cons X rest)) + ;; reduce "... x op y" --> "... r", r is the result + (`(,(and Y (pred numberp)) + ,(and O (pred (check 2))) + ,(and X (pred numberp)) + . ,rest) + (cons (call O X Y) rest)) + ;; reduce "... op x" --> "... r" for prefix op + (`(,(and X (pred numberp)) ,(and O (pred (check -1))) . ,rest) + (cons (call O X) rest)) + ;; reduce "... x op" --> "... r" for postfix op + (`(,(and O (pred (check +1))) ,(and X (pred numberp)) . ,rest) + (cons (call O X) rest)) + ;; reduce "... op" --> "... r" for 0-ary op + (`(,(and O (pred (check 0))) . ,rest) + (cons (call O) rest)) + ;; reduce "... y x" --> "... x" + ;; (needed for 0-ary ops: replace current number with result) + (`(,(and X (pred numberp)) ,(and _Y (pred numberp)) . ,rest) + (cons X rest)) + (_ nil)))) ; nil = done + (defun calculator-reduce-stack (prec) - "Reduce the stack using top operator. -PREC is a precedence - reduce everything with higher precedence." - (while - (cond - ((and (cdr (cdr calculator-stack)) ; have three values - (consp (nth 0 calculator-stack)) ; two operators & num - (numberp (nth 1 calculator-stack)) - (consp (nth 2 calculator-stack)) - (eq '\) (nth 1 (nth 0 calculator-stack))) - (eq '\( (nth 1 (nth 2 calculator-stack)))) - ;; reduce "... ( x )" --> "... x" - (setq calculator-stack - (cons (nth 1 calculator-stack) - (nthcdr 3 calculator-stack))) - ;; another iteration - t) - ((and (cdr (cdr calculator-stack)) ; have three values - (numberp (nth 0 calculator-stack)) ; two nums & operator - (consp (nth 1 calculator-stack)) - (numberp (nth 2 calculator-stack)) - (= 2 (calculator-op-arity ; binary operator - (nth 1 calculator-stack))) - (<= prec ; with higher prec. - (calculator-op-prec (nth 1 calculator-stack)))) - ;; reduce "... x op y" --> "... r", r is the result - (setq calculator-stack - (cons (calculator-funcall - (nth 2 (nth 1 calculator-stack)) - (nth 2 calculator-stack) - (nth 0 calculator-stack)) - (nthcdr 3 calculator-stack))) - ;; another iteration - t) - ((and (>= (length calculator-stack) 2) ; have two values - (numberp (nth 0 calculator-stack)) ; number & operator - (consp (nth 1 calculator-stack)) - (= -1 (calculator-op-arity ; prefix-unary op - (nth 1 calculator-stack))) - (<= prec ; with higher prec. - (calculator-op-prec (nth 1 calculator-stack)))) - ;; reduce "... op x" --> "... r" for prefix op - (setq calculator-stack - (cons (calculator-funcall - (nth 2 (nth 1 calculator-stack)) - (nth 0 calculator-stack)) - (nthcdr 2 calculator-stack))) - ;; another iteration - t) - ((and (cdr calculator-stack) ; have two values - (consp (nth 0 calculator-stack)) ; operator & number - (numberp (nth 1 calculator-stack)) - (= +1 (calculator-op-arity ; postfix-unary op - (nth 0 calculator-stack))) - (<= prec ; with higher prec. - (calculator-op-prec (nth 0 calculator-stack)))) - ;; reduce "... x op" --> "... r" for postfix op - (setq calculator-stack - (cons (calculator-funcall - (nth 2 (nth 0 calculator-stack)) - (nth 1 calculator-stack)) - (nthcdr 2 calculator-stack))) - ;; another iteration - t) - ((and calculator-stack ; have one value - (consp (nth 0 calculator-stack)) ; an operator - (= 0 (calculator-op-arity ; 0-ary op - (nth 0 calculator-stack)))) - ;; reduce "... op" --> "... r" for 0-ary op - (setq calculator-stack - (cons (calculator-funcall - (nth 2 (nth 0 calculator-stack))) - (nthcdr 1 calculator-stack))) - ;; another iteration - t) - ((and (cdr calculator-stack) ; have two values - (numberp (nth 0 calculator-stack)) ; both numbers - (numberp (nth 1 calculator-stack))) - ;; get rid of redundant numbers: - ;; reduce "... y x" --> "... x" - ;; needed for 0-ary ops that puts more values - (setcdr calculator-stack (cdr (cdr calculator-stack)))) - (t ;; no more iterations - nil)))) + "Reduce the stack using top operators as long as possible. +PREC is a precedence -- reduce everything with higher precedence." + (let ((new nil)) + (while (setq new (calculator-reduce-stack-once prec)) + (setq calculator-stack new)))) (defun calculator-funcall (f &optional X Y) "If F is a symbol, evaluate (F X Y). Otherwise, it should be a list, evaluate it with X, Y bound to the arguments." ;; remember binary ops for calculator-repR/L - (if Y (setq calculator-last-opXY (list f X Y))) - (condition-case nil - ;; there used to be code here that returns 0 if the result was - ;; smaller than calculator-epsilon (1e-15). I don't think this is - ;; necessary now. - (if (symbolp f) - (cond ((and X Y) (funcall f X Y)) - (X (funcall f X)) - (t (funcall f))) - ;; f is an expression - (let* ((TX (calculator-truncate X)) - (TY (and Y (calculator-truncate Y))) - (DX (if calculator-deg (/ (* X pi) 180) X)) - (L calculator-saved-list)) - (cl-letf (((symbol-function 'F) - (lambda (&optional x y) (calculator-funcall f x y))) - ((symbol-function 'D) - (lambda (x) (if calculator-deg (/ (* x 180) float-pi) x)))) - (eval f `((X . ,X) - (Y . ,Y) - (TX . ,TX) - (TY . ,TY) - (DX . ,DX) - (L . ,L)))))) - (error 0))) + (when Y (setq calculator-last-opXY (list f X Y))) + (if (symbolp f) + (cond ((and X Y) (funcall f X Y)) + (X (funcall f X)) + (t (funcall f))) + ;; f is an expression + (let ((TX (and X (calculator-truncate X))) + (TY (and Y (calculator-truncate Y))) + (DX (if (and X calculator-deg) (/ (* X pi) 180) X)) + (L calculator-saved-list) + (fF `(calculator-funcall ',f x y)) + (fD `(if calculator-deg (/ (* x 180) float-pi) x))) + (eval `(cl-flet ((F (&optional x y) ,fF) (D (x) ,fD)) + (let ((X ,X) (Y ,Y) (DX ,DX) (TX ,TX) (TY ,TY) (L ',L)) + ,f)) + t)))) ;;;--------------------------------------------------------------------- ;;; Input interaction (defun calculator-last-input (&optional keys) "Last char (or event or event sequence) that was read. -Optional string argument KEYS will force using it as the keys entered." +Use KEYS if given, otherwise use `this-command-keys'." (let ((inp (or keys (this-command-keys)))) (if (or (stringp inp) (not (arrayp inp))) inp - ;; this translates kp-x to x and [tries to] create a string to - ;; lookup operators - (let* ((i -1) (converted-str (make-string (length inp) ? )) k) - ;; converts an array to a string the ops lookup with keypad - ;; input - (while (< (setq i (1+ i)) (length inp)) - (setq k (aref inp i)) - ;; if Emacs will someday have a event-key, then this would - ;; probably be modified anyway - (and (if (fboundp 'key-press-event-p) (key-press-event-p k)) - (if (fboundp 'event-key) - (and (event-key k) (setq k (event-key k))))) - ;; assume all symbols are translatable with an ascii-character - (and (symbolp k) - (setq k (or (get k 'ascii-character) ? ))) - (aset converted-str i k)) - converted-str)))) + ;; Translates kp-x to x and [tries to] create a string to lookup + ;; operators; assume all symbols are translatable via + ;; `function-key-map'. This is needed because we have key + ;; bindings for kp-* (which might be the wrong thing to do) so + ;; they don't get translated in `this-command-keys'. + (concat (mapcar (lambda (k) + (if (numberp k) k (error "??bad key?? (%S)" k))) + (or (lookup-key function-key-map inp) inp)))))) (defun calculator-clear-fragile (&optional op) "Clear the fragile flag if it was set, then maybe reset all. OP is the operator (if any) that caused this call." - (if (and calculator-display-fragile - (or (not op) - (= -1 (calculator-op-arity op)) - (= 0 (calculator-op-arity op)))) + (when (and calculator-display-fragile + (or (not op) (memq (calculator-op-arity op) '(-1 0)))) ;; reset if last calc finished, and now get a num or prefix or 0-ary ;; op (calculator-reset)) @@ -1338,53 +1244,44 @@ OP is the operator (if any) that caused this call." "Enter a single digit." (interactive) (let ((inp (aref (calculator-last-input) 0))) - (if (and (or calculator-display-fragile - (not (numberp (car calculator-stack)))) - (cond - ((not calculator-input-radix) (<= inp ?9)) - ((eq calculator-input-radix 'bin) (<= inp ?1)) - ((eq calculator-input-radix 'oct) (<= inp ?7)) - (t t))) - ;; enter digit if starting a new computation or have an op on the - ;; stack - (progn - (calculator-clear-fragile) - (let ((digit (upcase (char-to-string inp)))) - (if (equal calculator-curnum "0") - (setq calculator-curnum nil)) - (setq calculator-curnum - (concat (or calculator-curnum "") digit))) - (calculator-update-display))))) + (when (and (or calculator-display-fragile + (not (numberp (car calculator-stack)))) + (<= inp (pcase calculator-input-radix + (`nil ?9) (`bin ?1) (`oct ?7) (_ 999)))) + (calculator-clear-fragile) + (setq calculator-curnum + (concat (if (equal calculator-curnum "0") "" + calculator-curnum) + (list (upcase inp)))) + (calculator-update-display)))) (defun calculator-decimal () "Enter a decimal period." (interactive) - (if (and (not calculator-input-radix) - (or calculator-display-fragile - (not (numberp (car calculator-stack)))) - (not (and calculator-curnum - (string-match-p "[.eE]" calculator-curnum)))) + (when (and (not calculator-input-radix) + (or calculator-display-fragile + (not (numberp (car calculator-stack)))) + (not (and calculator-curnum + (string-match-p "[.eE]" calculator-curnum)))) ;; enter the period on the same condition as a digit, only if no ;; period or exponent entered yet - (progn - (calculator-clear-fragile) - (setq calculator-curnum (concat (or calculator-curnum "0") ".")) - (calculator-update-display)))) + (calculator-clear-fragile) + (setq calculator-curnum (concat (or calculator-curnum "0") ".")) + (calculator-update-display))) (defun calculator-exp () "Enter an `E' exponent character, or a digit in hex input mode." (interactive) - (if calculator-input-radix - (calculator-digit) - (if (and (or calculator-display-fragile - (not (numberp (car calculator-stack)))) - (not (and calculator-curnum - (string-match-p "[eE]" calculator-curnum)))) - ;; same condition as above, also no E so far - (progn - (calculator-clear-fragile) - (setq calculator-curnum (concat (or calculator-curnum "1") "e")) - (calculator-update-display))))) + (cond + (calculator-input-radix (calculator-digit)) + ((and (or calculator-display-fragile + (not (numberp (car calculator-stack)))) + (not (and calculator-curnum + (string-match-p "[eE]" calculator-curnum)))) + ;; same condition as above, also no E so far + (calculator-clear-fragile) + (setq calculator-curnum (concat (or calculator-curnum "1") "e")) + (calculator-update-display)))) (defun calculator-op (&optional keys) "Enter an operator on the stack, doing all necessary reductions. @@ -1394,42 +1291,29 @@ Optional string argument KEYS will force using it as the keys entered." (let* ((last-inp (calculator-last-input keys)) (op (assoc last-inp calculator-operators))) (calculator-clear-fragile op) - (if (and calculator-curnum (/= (calculator-op-arity op) 0)) - (setq calculator-stack - (cons (calculator-curnum-value) calculator-stack))) - (setq calculator-curnum nil) - (if (and (= 2 (calculator-op-arity op)) - (not (and calculator-stack - (numberp (nth 0 calculator-stack))))) - ;; we have a binary operator but no number - search for a prefix - ;; version - (let ((rest-ops calculator-operators)) - (while (not (equal last-inp (car (car rest-ops)))) - (setq rest-ops (cdr rest-ops))) - (setq op (assoc last-inp (cdr rest-ops))) - (if (not (and op (= -1 (calculator-op-arity op)))) - ;;(error "Binary operator without a first operand") - (progn - (calculator-message - "Binary operator without a first operand") - (throw 'op-error nil))))) + (calculator-push-curnum) + (when (and (= 2 (calculator-op-arity op)) + (not (numberp (car calculator-stack)))) + ;; we have a binary operator but no number -- search for a + ;; prefix version + (setq op (assoc last-inp (cdr (memq op calculator-operators)))) + (unless (and op (= -1 (calculator-op-arity op))) + (calculator-message "Binary operator without a first operand") + (throw 'op-error nil))) (calculator-reduce-stack (cond ((eq (nth 1 op) '\() 10) ((eq (nth 1 op) '\)) 0) (t (calculator-op-prec op)))) - (if (or (and (= -1 (calculator-op-arity op)) - (numberp (car calculator-stack))) - (and (/= (calculator-op-arity op) -1) - (/= (calculator-op-arity op) 0) - (not (numberp (car calculator-stack))))) - ;;(error "Unterminated expression") - (progn - (calculator-message "Unterminated expression") - (throw 'op-error nil))) - (setq calculator-stack (cons op calculator-stack)) + (when (let ((hasnum (numberp (car calculator-stack)))) + (pcase (calculator-op-arity op) + (-1 hasnum) + ((or 1 2) (not hasnum)))) + (calculator-message "Incomplete expression") + (throw 'op-error nil)) + (push op calculator-stack) (calculator-reduce-stack (calculator-op-prec op)) (and (= (length calculator-stack) 1) - (numberp (nth 0 calculator-stack)) + (numberp (car calculator-stack)) ;; the display is fragile if it contains only one number (setq calculator-display-fragile t) ;; add number to the saved-list @@ -1445,7 +1329,8 @@ Optional string argument KEYS will force using it as the keys entered." (defun calculator-op-or-exp () "Either enter an operator or a digit. Used with +/- for entering them as digits in numbers like 1e-3 (there is -no need for negative numbers since these are handled by unary operators)." +no need for negative numbers since these are handled by unary +operators)." (interactive) (if (and (not calculator-display-fragile) calculator-curnum @@ -1459,14 +1344,11 @@ no need for negative numbers since these are handled by unary operators)." (defun calculator-dec/deg-mode () "Set decimal mode for display & input, if decimal, toggle deg mode." (interactive) - (if calculator-curnum - (setq calculator-stack - (cons (calculator-curnum-value) calculator-stack))) - (setq calculator-curnum nil) + (calculator-push-curnum) (if (or calculator-input-radix calculator-output-radix) (progn (setq calculator-input-radix nil) (setq calculator-output-radix nil)) - ;; already decimal - toggle degrees mode + ;; already decimal -- toggle degrees mode (setq calculator-deg (not calculator-deg))) (calculator-update-display t)) @@ -1481,10 +1363,7 @@ Optional string argument KEYS will force using it as the keys entered." "Set input radix modes. Optional string argument KEYS will force using it as the keys entered." (interactive) - (if calculator-curnum - (setq calculator-stack - (cons (calculator-curnum-value) calculator-stack))) - (setq calculator-curnum nil) + (calculator-push-curnum) (setq calculator-input-radix (let ((inp (calculator-last-input keys))) (cdr (assq (upcase (aref inp (1- (length inp)))) @@ -1495,10 +1374,7 @@ Optional string argument KEYS will force using it as the keys entered." "Set display radix modes. Optional string argument KEYS will force using it as the keys entered." (interactive) - (if calculator-curnum - (setq calculator-stack - (cons (calculator-curnum-value) calculator-stack))) - (setq calculator-curnum nil) + (calculator-push-curnum) (setq calculator-output-radix (let ((inp (calculator-last-input keys))) (cdr (assq (upcase (aref inp (1- (length inp)))) @@ -1524,19 +1400,18 @@ Optional string argument KEYS will force using it as the keys entered." (defun calculator-saved-move (n) "Go N elements up the list of saved values." (interactive) - (and calculator-saved-list - (or (null calculator-stack) calculator-display-fragile) - (progn - (setq calculator-saved-ptr - (max (min (+ n calculator-saved-ptr) - (length calculator-saved-list)) - 0)) - (if (nth calculator-saved-ptr calculator-saved-list) - (setq calculator-stack - (list (nth calculator-saved-ptr calculator-saved-list)) - calculator-display-fragile t) - (calculator-reset)) - (calculator-update-display)))) + (when (and calculator-saved-list + (or (null calculator-stack) calculator-display-fragile)) + (setq calculator-saved-ptr + (max (min (+ n calculator-saved-ptr) + (length calculator-saved-list)) + 0)) + (if (nth calculator-saved-ptr calculator-saved-list) + (setq calculator-stack (list (nth calculator-saved-ptr + calculator-saved-list)) + calculator-display-fragile t) + (calculator-reset)) + (calculator-update-display))) (defun calculator-saved-up () "Go up the list of saved values." @@ -1583,7 +1458,7 @@ Optional string argument KEYS will force using it as the keys entered." (interactive) (setq calculator-curnum nil) (cond - ;; if the current number is from the saved-list - remove it + ;; if the current number is from the saved-list remove it ((and calculator-display-fragile calculator-saved-list (= (car calculator-stack) @@ -1592,7 +1467,7 @@ Optional string argument KEYS will force using it as the keys entered." (setq calculator-saved-list (cdr calculator-saved-list)) (let ((p (nthcdr (1- calculator-saved-ptr) calculator-saved-list))) - (setcdr p (cdr (cdr p))) + (setcdr p (cddr p)) (setq calculator-saved-ptr (1- calculator-saved-ptr)))) (if calculator-saved-list (setq calculator-stack @@ -1613,15 +1488,16 @@ Optional string argument KEYS will force using it as the keys entered." (calculator-enter) ;; remove trailing spaces and an index (let ((s (cdr calculator-stack-display))) - (and s - (if (string-match "^\\([^ ]+\\) *\\(\\[[0-9/]+\\]\\)? *$" s) - (setq s (match-string 1 s))) - (kill-new s))))) + (when s + (kill-new (replace-regexp-in-string + "^\\([^ ]+\\) *\\(\\[[0-9/]+\\]\\)? *$" "\\1" s)))))) -;; FIXME this should use register-read-with-preview, but it -;; uses calculator-registers rather than register-alist. (defun calculator-set-register (reg) "Set a register value for REG." + ;; FIXME: this should use `register-read-with-preview', but it uses + ;; calculator-registers rather than `register-alist'. (Maybe + ;; dynamically rebinding it will get blessed?) Also in to + ;; `calculator-get-register'. (interactive "cRegister to store into: ") (let* ((as (assq reg calculator-registers)) (val (progn (calculator-enter) (car calculator-stack)))) @@ -1634,15 +1510,14 @@ Optional string argument KEYS will force using it as the keys entered." (defun calculator-put-value (val) "Paste VAL as if entered. Used by `calculator-paste' and `get-register'." - (if (and (numberp val) - ;; (not calculator-curnum) - (or calculator-display-fragile - (not (numberp (car calculator-stack))))) - (progn - (calculator-clear-fragile) - (setq calculator-curnum (let ((calculator-displayer "%S")) - (calculator-number-to-string val))) - (calculator-update-display)))) + (when (and (numberp val) + ;; (not calculator-curnum) + (or calculator-display-fragile + (not (numberp (car calculator-stack))))) + (calculator-clear-fragile) + (setq calculator-curnum (let ((calculator-displayer "%S")) + (calculator-number-to-string val))) + (calculator-update-display))) (defun calculator-paste () "Paste a value from the `kill-ring'." @@ -1662,8 +1537,6 @@ Used by `calculator-paste' and `get-register'." (or (match-string 3 str) "")))) (ignore-errors (calculator-string-to-number str))))) -;; FIXME this should use register-read-with-preview, but it -;; uses calculator-registers rather than register-alist. (defun calculator-get-register (reg) "Get a value from a register REG." (interactive "cRegister to get value from: ") @@ -1696,16 +1569,13 @@ Used by `calculator-paste' and `get-register'." (g-map (current-global-map)) (win (selected-window))) (require 'ehelp) - (if calculator-electric-mode + (when calculator-electric-mode (use-global-map calculator-saved-global-map)) - (if (or (not calculator-electric-mode) - ;; XEmacs has a problem with electric-describe-mode - (featurep 'xemacs)) - (describe-mode) - (electric-describe-mode)) (if calculator-electric-mode - (use-global-map g-map)) - (select-window win) ; these are for XEmacs (also below) + (electric-describe-mode) + (describe-mode)) + (when calculator-electric-mode (use-global-map g-map)) + (select-window win) (message nil)) (let ((one (one-window-p t)) (win (selected-window)) @@ -1713,12 +1583,11 @@ Used by `calculator-paste' and `get-register'." (save-window-excursion (with-output-to-temp-buffer "*Help*" (princ (documentation 'calculator-help))) - (if one - (shrink-window-if-larger-than-buffer - (get-buffer-window help-buf))) - (message - "`%s' again for more help, any other key continues normally." - (calculator-last-input)) + (when one (shrink-window-if-larger-than-buffer + (get-buffer-window help-buf))) + (message "`%s' again for more help, %s." + (calculator-last-input) + "any other key continues normally") (select-window win) (sit-for 360)) (select-window win)))) @@ -1731,11 +1600,12 @@ Used by `calculator-paste' and `get-register'." (unless calculator-electric-mode (ignore-errors (while (get-buffer-window calculator-buffer) - (delete-window (get-buffer-window calculator-buffer)))) - (kill-buffer calculator-buffer)) - (setq calculator-buffer nil) + (delete-window (get-buffer-window calculator-buffer))))) + (kill-buffer calculator-buffer) (message "Calculator done.") - (if calculator-electric-mode (throw 'calculator-done nil))) + (if calculator-electric-mode + (throw 'calculator-done nil) ; will kill the buffer + (setq calculator-buffer nil))) (defun calculator-save-and-quit () "Quit the calculator, saving the result on the `kill-ring'." @@ -1764,58 +1634,47 @@ To use this, apply a binary operator (evaluate it), then call this." (car calculator-last-opXY) (nth 1 calculator-last-opXY) x)) x)) -(defun calculator-integer-p (x) - "Non-nil if X is equal to an integer." - (ignore-errors (= x (ftruncate x)))) - (defun calculator-expt (x y) "Compute X^Y, dealing with errors appropriately." (condition-case nil (expt x y) (domain-error 0.0e+NaN) (range-error - (cond - ((and (< x 1.0) (> x -1.0)) - ;; For small x, the range error comes from large y. - 0.0) - ((and (> x 0.0) (< y 0.0)) - ;; For large positive x and negative y, the range error - ;; comes from large negative y. - 0.0) - ((and (> x 0.0) (> y 0.0)) - ;; For large positive x and positive y, the range error - ;; comes from large y. - 1.0e+INF) - ;; For the rest, x must be large and negative. - ;; The range errors come from large integer y. - ((< y 0.0) - 0.0) - ((eq (logand (truncate y) 1) 1) ; expansion of cl `oddp' - ;; If y is odd - -1.0e+INF) - (t - ;; - 1.0e+INF))) + (cond ((and (< x 1.0) (> x -1.0)) + ;; For small x, the range error comes from large y. + 0.0) + ((and (> x 0.0) (< y 0.0)) + ;; For large positive x and negative y, the range error + ;; comes from large negative y. + 0.0) + ((and (> x 0.0) (> y 0.0)) + ;; For large positive x and positive y, the range error + ;; comes from large y. + 1.0e+INF) + ;; For the rest, x must be large and negative. + ;; The range errors come from large integer y. + ((< y 0.0) + 0.0) + ((eq (logand (truncate y) 1) 1) ; expansion of cl `oddp' + ;; If y is odd + -1.0e+INF) + (t + ;; + 1.0e+INF))) (error 0.0e+NaN))) (defun calculator-fact (x) "Simple factorial of X." - (if (and (>= x 0) - (calculator-integer-p x)) - (if (= (calculator-expt (/ x 3.0) x) 1.0e+INF) - 1.0e+INF - (let ((r (if (<= x 10) 1 1.0))) - (while (> x 0) - (setq r (* r (truncate x))) - (setq x (1- x))) - (+ 0.0 r))) - (if (= x 1.0e+INF) - x - 0.0e+NaN))) + (cond ((>= x 1.0e+INF) x) + ((or (and (floatp x) (isnan x)) (< x 0)) 0.0e+NaN) + ((>= (calculator-expt (/ x 3.0) x) 1.0e+INF) 1.0e+INF) + (t (let ((x (truncate x)) (r 1.0)) + (while (> x 0) (setq r (* r x) x (1- x))) + r)))) (defun calculator-truncate (n) "Truncate N, return 0 in case of overflow." - (condition-case nil (truncate n) (error 0))) + (condition-case nil (truncate n) (range-error 0))) (provide 'calculator) diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el index 29e669b203b..f143b2dfcb7 100644 --- a/lisp/calendar/appt.el +++ b/lisp/calendar/appt.el @@ -228,7 +228,7 @@ also calls `beep' for an audible reminder." string (car string))) (cond ((eq appt-display-format 'window) ;; TODO use calendar-month-abbrev-array rather than %b? - (let ((time (format-time-string "%a %b %e " (current-time))) + (let ((time (format-time-string "%a %b %e ")) err) (condition-case err (funcall appt-disp-window-function diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el index 33acd7fbf2a..180e5f927ee 100644 --- a/lisp/calendar/cal-bahai.el +++ b/lisp/calendar/cal-bahai.el @@ -94,9 +94,6 @@ Gregorian date Sunday, December 31, 1 BC." 0) day))) ; days so far this month -(define-obsolete-function-alias 'calendar-absolute-from-bahai - 'calendar-bahai-to-absolute "23.1") - (defun calendar-bahai-from-absolute (date) "Bahá'í date (month day year) corresponding to the absolute DATE." (if (< date calendar-bahai-epoch) @@ -152,9 +149,6 @@ Defaults to today's date if DATE is not given." (message "Date is pre-Bahá'í") (message "Bahá'í date: %s" s)))) -(define-obsolete-function-alias - 'calendar-print-bahai-date 'calendar-bahai-print-date "23.1") - (defun calendar-bahai-read-date () "Interactively read the arguments for a Bahá'í date command. Reads a year, month and day." @@ -179,9 +173,6 @@ Reads a year, month and day." (lambda (x) (and (< 0 x) (<= x 19)))))) (list (list month day year)))) -(define-obsolete-function-alias - 'calendar-bahai-prompt-for-date 'calendar-bahai-read-date "23.1") - ;;;###cal-autoload (defun calendar-bahai-goto-date (date &optional noecho) "Move cursor to Bahá'í date DATE; echo Bahá'í date unless NOECHO is non-nil." @@ -190,9 +181,6 @@ Reads a year, month and day." (calendar-bahai-to-absolute date))) (or noecho (calendar-bahai-print-date))) -(define-obsolete-function-alias - 'calendar-goto-bahai-date 'calendar-bahai-goto-date "23.1") - (defvar displayed-month) (defvar displayed-year) @@ -270,9 +258,6 @@ will not be marked in the calendar. This function is provided for use with (diary-list-entries-1 calendar-bahai-month-name-array diary-bahai-entry-symbol 'calendar-bahai-from-absolute)) -(define-obsolete-function-alias - 'list-bahai-diary-entries 'diary-bahai-list-entries "23.1") - (autoload 'calendar-mark-1 "diary-lib") @@ -284,10 +269,6 @@ passed to `calendar-mark-visible-date' as MARK." (calendar-mark-1 month day year 'calendar-bahai-from-absolute 'calendar-bahai-to-absolute color)) -(define-obsolete-function-alias - 'mark-bahai-calendar-date-pattern 'calendar-bahai-mark-date-pattern "23.1") - - (autoload 'diary-mark-entries-1 "diary-lib") ;;;###diary-autoload @@ -300,10 +281,6 @@ window. See `diary-bahai-list-entries' for more information." diary-bahai-entry-symbol 'calendar-bahai-from-absolute)) -(define-obsolete-function-alias - 'mark-bahai-diary-entries 'diary-bahai-mark-entries "23.1") - - (autoload 'diary-insert-entry-1 "diary-lib") ;;;###cal-autoload @@ -316,9 +293,6 @@ Prefix argument ARG makes the entry nonmarking." diary-bahai-entry-symbol 'calendar-bahai-from-absolute)) -(define-obsolete-function-alias - 'insert-bahai-diary-entry 'diary-bahai-insert-entry "23.1") - ;;;###cal-autoload (defun diary-bahai-insert-monthly-entry (arg) "Insert a monthly diary entry. @@ -329,9 +303,6 @@ Prefix argument ARG makes the entry nonmarking." diary-bahai-entry-symbol 'calendar-bahai-from-absolute)) -(define-obsolete-function-alias - 'insert-monthly-bahai-diary-entry 'diary-bahai-insert-monthly-entry "23.1") - ;;;###cal-autoload (defun diary-bahai-insert-yearly-entry (arg) "Insert an annual diary entry. @@ -342,9 +313,6 @@ Prefix argument ARG will make the entry nonmarking." diary-bahai-entry-symbol 'calendar-bahai-from-absolute)) -(define-obsolete-function-alias - 'insert-yearly-bahai-diary-entry 'diary-bahai-insert-yearly-entry "23.1") - (defvar date) ;; To be called from diary-list-sexp-entries, where DATE is bound. diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el index 3a231ead1dc..b635eb60aba 100644 --- a/lisp/calendar/cal-china.el +++ b/lisp/calendar/cal-china.el @@ -58,9 +58,6 @@ :prefix "calendar-chinese-" :group 'calendar) -(define-obsolete-variable-alias 'chinese-calendar-time-zone - 'calendar-chinese-time-zone "23.1") - (defcustom calendar-chinese-time-zone '(if (< year 1928) (+ 465 (/ 40.0 60.0)) @@ -78,18 +75,12 @@ Default is for Beijing. This is an expression in `year' since it changed at (put 'chinese-calendar-time-zone 'risky-local-variable t) -(define-obsolete-variable-alias 'chinese-calendar-location-name - 'calendar-chinese-location-name "23.1") - ;; FIXME unused. (defcustom calendar-chinese-location-name "Beijing" "Name of location used for calculation of Chinese calendar." :type 'string :group 'calendar-chinese) -(define-obsolete-variable-alias 'chinese-calendar-daylight-time-offset - 'calendar-chinese-daylight-time-offset "23.1") - (defcustom calendar-chinese-daylight-time-offset 0 ;; The correct value is as follows, but the Chinese calendrical ;; authorities do NOT use DST in determining astronomical events: @@ -99,9 +90,6 @@ Default is for no daylight saving time." :type 'integer :group 'calendar-chinese) -(define-obsolete-variable-alias 'chinese-calendar-standard-time-zone-name - 'calendar-chinese-standard-time-zone-name "23.1") - (defcustom calendar-chinese-standard-time-zone-name '(if (< year 1928) "PMT" @@ -112,17 +100,11 @@ at 1928-01-01 00:00:00 from `PMT' to `CST'." :type 'sexp :group 'calendar-chinese) -(define-obsolete-variable-alias 'chinese-calendar-daylight-time-zone-name - 'calendar-chinese-daylight-time-zone-name "23.1") - (defcustom calendar-chinese-daylight-time-zone-name "CDT" "Abbreviated name of daylight saving time zone used for Chinese calendar." :type 'string :group 'calendar-chinese) -(define-obsolete-variable-alias 'chinese-calendar-daylight-savings-starts - 'calendar-chinese-daylight-saving-start "23.1") - (defcustom calendar-chinese-daylight-saving-start nil ;; The correct value is as follows, but the Chinese calendrical ;; authorities do NOT use DST in determining astronomical events: @@ -135,9 +117,6 @@ Default is for no daylight saving time. See documentation of :type 'sexp :group 'calendar-chinese) -(define-obsolete-variable-alias 'chinese-calendar-daylight-savings-ends - 'calendar-chinese-daylight-saving-end "23.1") - (defcustom calendar-chinese-daylight-saving-end nil ;; The correct value is as follows, but the Chinese calendrical ;; authorities do NOT use DST in determining astronomical events: @@ -148,27 +127,18 @@ Default is for no daylight saving time. See documentation of :type 'sexp :group 'calendar-chinese) -(define-obsolete-variable-alias 'chinese-calendar-daylight-savings-starts-time - 'calendar-chinese-daylight-saving-start-time "23.1") - (defcustom calendar-chinese-daylight-saving-start-time 0 "Number of minutes after midnight that daylight saving time starts. Default is for no daylight saving time." :type 'integer :group 'calendar-chinese) -(define-obsolete-variable-alias 'chinese-calendar-daylight-savings-ends-time - 'calendar-chinese-daylight-saving-end-time "23.1") - (defcustom calendar-chinese-daylight-saving-end-time 0 "Number of minutes after midnight that daylight saving time ends. Default is for no daylight saving time." :type 'integer :group 'calendar-chinese) -(define-obsolete-variable-alias 'chinese-calendar-celestial-stem - 'calendar-chinese-celestial-stem "23.1") - (defcustom calendar-chinese-celestial-stem ["Jia" "Yi" "Bing" "Ding" "Wu" "Ji" "Geng" "Xin" "Ren" "Gui"] "Prefixes used by `calendar-chinese-sexagesimal-name'." @@ -184,9 +154,6 @@ Default is for no daylight saving time." (string :tag "Ren") (string :tag "Gui"))) -(define-obsolete-variable-alias 'chinese-calendar-terrestrial-branch - 'calendar-chinese-terrestrial-branch "23.1") - (defcustom calendar-chinese-terrestrial-branch ["Zi" "Chou" "Yin" "Mao" "Chen" "Si" "Wu" "Wei" "Shen" "You" "Xu" "Hai"] "Suffixes used by `calendar-chinese-sexagesimal-name'." @@ -432,9 +399,6 @@ Sunday, December 31, 1 BC is imaginary." (calendar-chinese-year g-year)) (calendar-chinese-year (1+ g-year)))))))) -(define-obsolete-function-alias 'calendar-absolute-from-chinese - 'calendar-chinese-to-absolute "23.1") - (defun calendar-chinese-from-absolute (date) "Compute Chinese date (cycle year month day) corresponding to absolute DATE. The absolute date is the number of days elapsed since the (imaginary) @@ -599,9 +563,6 @@ Defaults to today's date if DATE is not given." (message "Chinese date: %s" (calendar-chinese-date-string (calendar-cursor-to-date t)))) -(define-obsolete-function-alias 'calendar-print-chinese-date - 'calendar-chinese-print-date "23.1") - (defun calendar-chinese-months-to-alist (l) "Make list of months L into an assoc list." (and l (car l) @@ -671,9 +632,6 @@ Echo Chinese date unless NOECHO is non-nil." (calendar-chinese-to-absolute date))) (or noecho (calendar-chinese-print-date))) -(define-obsolete-function-alias 'calendar-goto-chinese-date - 'calendar-chinese-goto-date "23.1") - (defvar date) ;; To be called from diary-list-sexp-entries, where DATE is bound. @@ -682,6 +640,139 @@ Echo Chinese date unless NOECHO is non-nil." "Chinese calendar equivalent of date diary entry." (format "Chinese date: %s" (calendar-chinese-date-string date))) +;;;; diary support + +(autoload 'calendar-mark-1 "diary-lib") +(autoload 'diary-mark-entries-1 "diary-lib") +(autoload 'diary-list-entries-1 "diary-lib") +(autoload 'diary-insert-entry-1 "diary-lib") +(autoload 'diary-date-display-form "diary-lib") +(autoload 'diary-make-date "diary-lib") +(autoload 'diary-ordinal-suffix "diary-lib") +(defvar diary-sexp-entry-symbol) +(defvar entry) ;used by `diary-chinese-anniversary' + +(defvar calendar-chinese-month-name-array + ["正月" "二月" "三月" "四月" "五月" "六月" + "七月" "八月" "九月" "十月" "冬月" "臘月"]) + +;;; NOTE: In the diary the cycle and year of a Chinese date is +;;; combined using this formula: (+ (* cycle 100) year). +;;; +;;; These two functions convert to and back from this representation. +(defun calendar-chinese-from-absolute-for-diary (date) + (pcase-let ((`(,c ,y ,m ,d) (calendar-chinese-from-absolute date))) + ;; Note: For leap months M is a float. + (list (floor m) d (+ (* c 100) y)))) + +(defun calendar-chinese-to-absolute-for-diary (date &optional prefer-leap) + (pcase-let* ((`(,m ,d ,y) date) + (cycle (floor y 100)) + (year (mod y 100)) + (months (calendar-chinese-months cycle year)) + (lm (+ (floor m) 0.5))) + (calendar-chinese-to-absolute + (if (and prefer-leap (memql lm months)) + (list cycle year lm d) + (list cycle year m d))))) + +(defun calendar-chinese-mark-date-pattern (month day year &optional color) + (calendar-mark-1 month day year + #'calendar-chinese-from-absolute-for-diary + #'calendar-chinese-to-absolute-for-diary + color) + (unless (zerop month) + (calendar-mark-1 month day year + #'calendar-chinese-from-absolute-for-diary + (lambda (date) (calendar-chinese-to-absolute-for-diary date t)) + color))) + +;;;###cal-autoload +(defun diary-chinese-mark-entries () + "Mark days in the calendar window that have Chinese date diary entries. +Marks each entry in `diary-file' (or included files) visible in the calendar +window. See `diary-chinese-list-entries' for more information. + +This function is provided for use with `diary-nongregorian-marking-hook'." + (diary-mark-entries-1 #'calendar-chinese-mark-date-pattern + calendar-chinese-month-name-array + diary-chinese-entry-symbol + #'calendar-chinese-from-absolute-for-diary)) + +;;;###cal-autoload +(defun diary-chinese-list-entries () + "Add any Chinese date entries from the diary file to `diary-entries-list'. +Chinese date diary entries must be prefixed by `diary-chinese-entry-symbol' +\(normally a `C'). The same `diary-date-forms' govern the style +of the Chinese calendar entries. If a Chinese date diary entry begins with +`diary-nonmarking-symbol', the entry will appear in the diary listing, +but will not be marked in the calendar. + +This function is provided for use with `diary-nongregorian-listing-hook'." + (diary-list-entries-1 calendar-chinese-month-name-array + diary-chinese-entry-symbol + #'calendar-chinese-from-absolute-for-diary)) + +;;;###cal-autoload +(defun diary-chinese-anniversary (month day &optional year mark) + "Like `diary-anniversary' (which see) but accepts Chinese date." + (pcase-let* ((ddate (diary-make-date month day year)) + (`(,dc ,dy ,dm ,dd) ;diary chinese date + (if year + (calendar-chinese-from-absolute + (calendar-chinese-to-absolute-for-diary ddate)) + (list nil nil (calendar-extract-month ddate) + (calendar-extract-day ddate)))) + (`(,cc ,cy ,cm ,cd) ;current chinese date + (calendar-chinese-from-absolute + (calendar-absolute-from-gregorian date))) + (diff (if (and dc dy) + (+ (* 60 (- cc dc)) (- cy dy)) + 100))) + (and (> diff 0) + ;; The Chinese month can differ by 0.5 in a leap month. + (or (= dm cm) (= (+ 0.5 dm) cm)) + (= dd cd) + (cons mark (format entry diff (diary-ordinal-suffix diff)))))) + +;;;###cal-autoload +(defun diary-chinese-insert-anniversary-entry (&optional arg) + "Insert an anniversary diary entry for the Chinese date at point. +Prefix argument ARG makes the entry nonmarking." + (interactive "P") + (let ((calendar-date-display-form (diary-date-display-form))) + (diary-make-entry + (format "%s(diary-chinese-anniversary %s)" + diary-sexp-entry-symbol + (calendar-date-string + (calendar-chinese-from-absolute-for-diary + (calendar-absolute-from-gregorian (calendar-cursor-to-date t))))) + arg))) + +;;;###cal-autoload +(defun diary-chinese-insert-entry (&optional arg) + "Insert a diary entry for the Chinese date at point." + (interactive "P") + (diary-insert-entry-1 nil arg calendar-chinese-month-name-array + diary-chinese-entry-symbol + #'calendar-chinese-from-absolute-for-diary)) + +;;;###cal-autoload +(defun diary-chinese-insert-monthly-entry (&optional arg) + "Insert a monthly diary entry for the Chinese date at point." + (interactive "P") + (diary-insert-entry-1 'monthly arg calendar-chinese-month-name-array + diary-chinese-entry-symbol + #'calendar-chinese-from-absolute-for-diary)) + +;;;###cal-autoload +(defun diary-chinese-insert-yearly-entry (&optional arg) + "Insert a yearly diary entry for the Chinese date at point." + (interactive "P") + (diary-insert-entry-1 'yearly arg calendar-chinese-month-name-array + diary-chinese-entry-symbol + #'calendar-chinese-from-absolute-for-diary)) + (provide 'cal-china) ;;; cal-china.el ends here diff --git a/lisp/calendar/cal-coptic.el b/lisp/calendar/cal-coptic.el index f342c6f6eac..0152dcb318d 100644 --- a/lisp/calendar/cal-coptic.el +++ b/lisp/calendar/cal-coptic.el @@ -75,9 +75,6 @@ Gregorian date Sunday, December 31, 1 BC." (* 30 (1- month)) ; days in prior months this year day))) ; days so far this month -(define-obsolete-function-alias 'calendar-absolute-from-coptic - 'calendar-coptic-to-absolute "23.1") - (defun calendar-coptic-from-absolute (date) "Compute the Coptic equivalent for absolute date DATE. The result is a list of the form (MONTH DAY YEAR). @@ -135,9 +132,6 @@ Defaults to today's date if DATE is not given." (message "Date is pre-%s calendar" calendar-coptic-name) (message "%s date: %s" calendar-coptic-name f)))) -(define-obsolete-function-alias 'calendar-print-coptic-date - 'calendar-coptic-print-date "23.1") - (defun calendar-coptic-read-date () "Interactively read the arguments for a Coptic date command. Reads a year, month, and day." @@ -164,9 +158,6 @@ Reads a year, month, and day." (lambda (x) (and (< 0 x) (<= x last)))))) (list (list month day year)))) -(define-obsolete-function-alias 'coptic-prompt-for-date - 'calendar-coptic-read-date "23.1") - ;;;###cal-autoload (defun calendar-coptic-goto-date (date &optional noecho) "Move cursor to Coptic date DATE. @@ -176,8 +167,6 @@ Echo Coptic date unless NOECHO is t." (calendar-coptic-to-absolute date))) (or noecho (calendar-coptic-print-date))) -(define-obsolete-function-alias 'calendar-goto-coptic-date - 'calendar-coptic-goto-date "23.1") (defvar date) @@ -208,9 +197,6 @@ Gregorian date Sunday, December 31, 1 BC." (let ((calendar-coptic-epoch calendar-ethiopic-epoch)) (calendar-coptic-to-absolute date))) -(define-obsolete-function-alias 'calendar-absolute-from-ethiopic - 'calendar-ethiopic-to-absolute "23.1") - (defun calendar-ethiopic-from-absolute (date) "Compute the Ethiopic equivalent for absolute date DATE. The result is a list of the form (MONTH DAY YEAR). @@ -238,9 +224,6 @@ Defaults to today's date if DATE is not given." (calendar-coptic-month-name-array calendar-ethiopic-month-name-array)) (call-interactively 'calendar-coptic-print-date))) -(define-obsolete-function-alias 'calendar-print-ethiopic-date - 'calendar-ethiopic-print-date "23.1") - ;;;###cal-autoload (defun calendar-ethiopic-goto-date (date &optional noecho) "Move cursor to Ethiopic date DATE. @@ -254,9 +237,6 @@ Echo Ethiopic date unless NOECHO is t." (calendar-ethiopic-to-absolute date))) (or noecho (calendar-ethiopic-print-date))) -(define-obsolete-function-alias 'calendar-goto-ethiopic-date - 'calendar-ethiopic-goto-date "23.1") - ;; To be called from diary-list-sexp-entries, where DATE is bound. ;;;###diary-autoload (defun diary-ethiopic-date () diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el index 34bbb292268..e8d6077b165 100644 --- a/lisp/calendar/cal-dst.el +++ b/lisp/calendar/cal-dst.el @@ -179,6 +179,7 @@ Return nil if no such transition can be found." (if (eq (car (current-time-zone probe)) hi-utc-diff) (setq hi probe) (setq lo probe))) + (setcdr hi (list (cdr hi))) hi)))) (autoload 'calendar-persian-to-absolute "cal-persia") diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el index 4c1dfe3fa85..b88adb9b636 100644 --- a/lisp/calendar/cal-french.el +++ b/lisp/calendar/cal-french.el @@ -129,9 +129,6 @@ Gregorian date Sunday, December 31, 1 BC." day ; days so far this month (1- calendar-french-epoch)))) ; days before start of calendar -(define-obsolete-function-alias 'calendar-absolute-from-french - 'calendar-french-to-absolute "23.1") - (defun calendar-french-from-absolute (date) "Compute the French Revolutionary equivalent for absolute date DATE. The result is a list of the form (MONTH DAY YEAR). @@ -196,9 +193,6 @@ Defaults to today's date if DATE is not given." (message "Date is pre-French Revolution") (message "French Revolutionary date: %s" f)))) -(define-obsolete-function-alias 'calendar-print-french-date - 'calendar-french-print-date "23.1") - ;;;###cal-autoload (defun calendar-french-goto-date (date &optional noecho) "Move cursor to French Revolutionary date DATE. @@ -249,9 +243,6 @@ Echo French Revolutionary date unless NOECHO is non-nil." (calendar-french-to-absolute date))) (or noecho (calendar-french-print-date))) -(define-obsolete-function-alias 'calendar-goto-french-date - 'calendar-french-goto-date "23.1") - (defvar date) ;; To be called from diary-list-sexp-entries, where DATE is bound. diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el index c6229ceb59e..8a975d8e862 100644 --- a/lisp/calendar/cal-hebrew.el +++ b/lisp/calendar/cal-hebrew.el @@ -32,9 +32,6 @@ (require 'calendar) -(define-obsolete-variable-alias 'diary-sabbath-candles-minutes - 'diary-hebrew-sabbath-candles-minutes "23.1") - (defcustom diary-hebrew-sabbath-candles-minutes 18 "Number of minutes before sunset for sabbath candle lighting. Used by `diary-hebrew-sabbath-candles'." @@ -136,9 +133,6 @@ Gregorian date Sunday, December 31, 1 BC." (calendar-hebrew-elapsed-days year) ; days in prior years -1373429))) ; days elapsed before absolute date 1 -(define-obsolete-function-alias 'calendar-absolute-from-hebrew - 'calendar-hebrew-to-absolute "23.1") - (defun calendar-hebrew-from-absolute (date) "Compute the Hebrew date (month day year) corresponding to absolute DATE. The absolute date is the number of days elapsed since the (imaginary) @@ -194,9 +188,6 @@ Driven by the variable `calendar-date-display-form'." (message "Hebrew date (until sunset): %s" (calendar-hebrew-date-string (calendar-cursor-to-date t)))) -(define-obsolete-function-alias 'calendar-print-hebrew-date - 'calendar-hebrew-print-date "23.1") - (defun calendar-hebrew-yahrzeit (death-date year) "Absolute date of the anniversary of Hebrew DEATH-DATE in Hebrew YEAR." (let ((death-day (calendar-extract-day death-date)) @@ -230,9 +221,6 @@ Driven by the variable `calendar-date-display-form'." (t (calendar-hebrew-to-absolute (list death-month death-day year)))))) -(define-obsolete-function-alias 'hebrew-calendar-yahrzeit - 'calendar-hebrew-yahrzeit "23.1") - (defun calendar-hebrew-read-date () "Interactively read the arguments for a Hebrew date command. Reads a year, month, and day." @@ -284,9 +272,6 @@ Reads a year, month, and day." (calendar-hebrew-to-absolute date))) (or noecho (calendar-hebrew-print-date))) -(define-obsolete-function-alias 'calendar-goto-hebrew-date - 'calendar-hebrew-goto-date "23.1") - (defvar displayed-month) ; from calendar-generate (defun calendar-hebrew-date-is-visible-p (month day) @@ -398,10 +383,6 @@ or ALL is non-nil." "Hoshanah Rabbah")))))))) ;;;###holiday-autoload -(define-obsolete-function-alias 'holiday-rosh-hashanah-etc - 'holiday-hebrew-rosh-hashanah "23.1") - -;;;###holiday-autoload (defun holiday-hebrew-hanukkah (&optional all) "List of dates related to Hanukkah, as visible in calendar window. Shows only Hanukkah, unless `calendar-hebrew-all-holidays-flag' or ALL @@ -434,10 +415,6 @@ is non-nil." (list (list (calendar-gregorian-from-absolute abs-h) "Hanukkah"))))))) ;;;###holiday-autoload -(define-obsolete-function-alias 'holiday-hanukkah - 'holiday-hebrew-hanukkah "23.1") - -;;;###holiday-autoload (defun holiday-hebrew-passover (&optional all) "List of dates related to Passover, as visible in calendar window. Shows only the major holidays, unless `calendar-hebrew-all-holidays-flag' @@ -520,10 +497,6 @@ or ALL is non-nil." "Shavuot (second day)"))))))))) ;;;###holiday-autoload -(define-obsolete-function-alias 'holiday-passover-etc - 'holiday-hebrew-passover "23.1") - -;;;###holiday-autoload (defun holiday-hebrew-tisha-b-av () "List of dates around Tisha B'Av, as visible in calendar window." (when (memq displayed-month '(5 6 7 8 9)) @@ -545,10 +518,6 @@ or ALL is non-nil." (calendar-dayname-on-or-before 6 (+ abs-t-a 7))) "Shabbat Nahamu")))))) -;;;###holiday-autoload -(define-obsolete-function-alias 'holiday-tisha-b-av-etc - 'holiday-hebrew-tisha-b-av "23.1") - (autoload 'holiday-julian "cal-julian") ;;;###holiday-autoload @@ -634,9 +603,6 @@ is provided for use with `diary-nongregorian-listing-hook'." (diary-list-entries-1 calendar-hebrew-month-name-array-leap-year diary-hebrew-entry-symbol 'calendar-hebrew-from-absolute)) -;;;###diary-autoload -(define-obsolete-function-alias 'list-hebrew-diary-entries - 'diary-hebrew-list-entries "23.1") (autoload 'calendar-mark-complex "diary-lib") @@ -662,10 +628,6 @@ passed to `calendar-mark-visible-date' as MARK." (calendar-mark-complex month day year 'calendar-hebrew-from-absolute color)))) -;;;###diary-autoload -(define-obsolete-function-alias 'mark-hebrew-calendar-date-pattern - 'calendar-hebrew-mark-date-pattern "23.1") - (autoload 'diary-mark-entries-1 "diary-lib") ;;;###diary-autoload @@ -678,10 +640,6 @@ window. See `list-hebrew-diary-entries' for more information." diary-hebrew-entry-symbol 'calendar-hebrew-from-absolute)) -;;;###diary-autoload -(define-obsolete-function-alias 'mark-hebrew-diary-entries - 'diary-hebrew-mark-entries "23.1") - (autoload 'diary-insert-entry-1 "diary-lib") ;;;###cal-autoload @@ -693,10 +651,6 @@ Prefix argument ARG makes the entry nonmarking." diary-hebrew-entry-symbol 'calendar-hebrew-from-absolute)) -;;;###diary-autoload -(define-obsolete-function-alias 'insert-hebrew-diary-entry - 'diary-hebrew-insert-entry "23.1") - ;;;###cal-autoload (defun diary-hebrew-insert-monthly-entry (arg) "Insert a monthly diary entry. @@ -706,9 +660,6 @@ Prefix argument ARG makes the entry nonmarking." (diary-insert-entry-1 'monthly arg calendar-hebrew-month-name-array-leap-year diary-hebrew-entry-symbol 'calendar-hebrew-from-absolute)) -;;;###diary-autoload -(define-obsolete-function-alias 'insert-monthly-hebrew-diary-entry - 'diary-hebrew-insert-monthly-entry "23.1") ;;;###cal-autoload (defun diary-hebrew-insert-yearly-entry (arg) @@ -719,9 +670,6 @@ Prefix argument ARG makes the entry nonmarking." (diary-insert-entry-1 'yearly arg calendar-hebrew-month-name-array-leap-year diary-hebrew-entry-symbol 'calendar-hebrew-from-absolute)) -;;;###diary-autoload -(define-obsolete-function-alias 'insert-yearly-hebrew-diary-entry - 'diary-hebrew-insert-yearly-entry "23.1") ;;;###autoload (defun calendar-hebrew-list-yahrzeits (death-date start-year end-year) @@ -786,10 +734,6 @@ from the cursor position." (calendar-absolute-from-gregorian (list 1 1 i))))))) "\n")))) (message "Computing Yahrzeits...done")) -;;;###autoload -(define-obsolete-function-alias 'list-yahrzeit-dates - 'calendar-hebrew-list-yahrzeits "23.1") - (defun calendar-hebrew-birthday (date year) "Absolute date of the anniversary of Hebrew birth DATE, in Hebrew YEAR." (let ((b-day (calendar-extract-day date)) @@ -869,8 +813,6 @@ use when highlighting the day in the calendar." "" (format " and %d day%s" day (if (= day 1) "" "s")))))))))) -;;;###diary-autoload -(define-obsolete-function-alias 'diary-omer 'diary-hebrew-omer "23.1") (autoload 'diary-make-date "diary-lib") @@ -912,9 +854,6 @@ use when highlighting the day in the calendar." (diary-ordinal-suffix diff)))))) ;;;###diary-autoload -(define-obsolete-function-alias 'diary-yahrzeit 'diary-hebrew-yahrzeit "23.1") - -;;;###diary-autoload (defun diary-hebrew-rosh-hodesh (&optional mark) "Rosh Hodesh diary entry. Entry applies if date is Rosh Hodesh, the day before, or the Saturday before. @@ -976,9 +915,6 @@ use when highlighting the day in the calendar." (calendar-hebrew-last-month-of-year h-year)) 0 h-month))))))))) -;;;###diary-autoload -(define-obsolete-function-alias 'diary-rosh-hodesh - 'diary-hebrew-rosh-hodesh "23.1") (defconst calendar-hebrew-parashiot-names ["Bereshith" "Noah" "Lech L'cha" "Vayera" "Hayei Sarah" "Toledoth" @@ -1166,8 +1102,6 @@ use when highlighting the day in the calendar." (cdr parasha)))) (calendar-hebrew-parasha-name parasha))))))))) -(define-obsolete-function-alias 'diary-parasha 'diary-hebrew-parasha "23.1") - (declare-function solar-setup "solar" ()) (declare-function solar-sunrise-sunset "solar" (date)) @@ -1199,10 +1133,6 @@ use when highlighting the day in the calendar." 60.0)) (cdr sunset))))))))) -;;;###diary-autoload -(define-obsolete-function-alias 'diary-sabbath-candles - 'diary-hebrew-sabbath-candles "23.1") - (provide 'cal-hebrew) diff --git a/lisp/calendar/cal-islam.el b/lisp/calendar/cal-islam.el index 70461c841ce..8e287526b5f 100644 --- a/lisp/calendar/cal-islam.el +++ b/lisp/calendar/cal-islam.el @@ -87,9 +87,6 @@ Gregorian date Sunday, December 31, 1 BC." leap-years-in-cycle ; leap days this cycle (1- calendar-islamic-epoch)))) ; days before start of calendar -(define-obsolete-function-alias 'calendar-absolute-from-islamic - 'calendar-islamic-to-absolute "23.1") - (defun calendar-islamic-from-absolute (date) "Compute the Islamic date (month day year) corresponding to absolute DATE. The absolute date is the number of days elapsed since the (imaginary) @@ -141,9 +138,6 @@ Driven by the variable `calendar-date-display-form'." (message "Date is pre-Islamic") (message "Islamic date (until sunset): %s" i)))) -(define-obsolete-function-alias 'calendar-print-islamic-date - 'calendar-islamic-print-date "23.1") - (defun calendar-islamic-read-date () "Interactively read the arguments for an Islamic date command. Reads a year, month, and day." @@ -177,9 +171,6 @@ Reads a year, month, and day." (calendar-islamic-to-absolute date))) (or noecho (calendar-islamic-print-date))) -(define-obsolete-function-alias 'calendar-goto-islamic-date - 'calendar-islamic-goto-date "23.1") - (defvar displayed-month) ; from calendar-generate (defvar displayed-year) @@ -260,9 +251,6 @@ marked in the calendar. This function is provided for use with diary-islamic-entry-symbol 'calendar-islamic-from-absolute)) -(define-obsolete-function-alias 'list-islamic-diary-entries - 'diary-islamic-list-entries "23.1") - (autoload 'calendar-mark-1 "diary-lib") ;;;###diary-autoload @@ -273,9 +261,6 @@ passed to `calendar-mark-visible-date' as MARK." (calendar-mark-1 month day year 'calendar-islamic-from-absolute 'calendar-islamic-to-absolute color)) -(define-obsolete-function-alias 'mark-islamic-calendar-date-pattern - 'calendar-islamic-mark-date-pattern "23.1") - (autoload 'diary-mark-entries-1 "diary-lib") ;;;###diary-autoload @@ -288,9 +273,6 @@ window. See `diary-islamic-list-entries' for more information." diary-islamic-entry-symbol 'calendar-islamic-from-absolute)) -(define-obsolete-function-alias - 'mark-islamic-diary-entries 'diary-islamic-mark-entries "23.1") - (autoload 'diary-insert-entry-1 "diary-lib") ;;;###cal-autoload @@ -303,9 +285,6 @@ Prefix argument ARG makes the entry nonmarking." diary-islamic-entry-symbol 'calendar-islamic-from-absolute)) -(define-obsolete-function-alias 'insert-islamic-diary-entry - 'diary-islamic-insert-entry "23.1") - ;;;###cal-autoload (defun diary-islamic-insert-monthly-entry (arg) "Insert a monthly diary entry. @@ -316,9 +295,6 @@ Prefix argument ARG makes the entry nonmarking." diary-islamic-entry-symbol 'calendar-islamic-from-absolute)) -(define-obsolete-function-alias 'insert-monthly-islamic-diary-entry - 'diary-islamic-insert-monthly-entry "23.1") - ;;;###cal-autoload (defun diary-islamic-insert-yearly-entry (arg) "Insert an annual diary entry. @@ -328,8 +304,6 @@ Prefix argument ARG makes the entry nonmarking." (diary-insert-entry-1 'yearly arg calendar-islamic-month-name-array diary-islamic-entry-symbol 'calendar-islamic-from-absolute)) -(define-obsolete-function-alias - 'insert-yearly-islamic-diary-entry 'diary-islamic-insert-yearly-entry "23.1") (defvar date) diff --git a/lisp/calendar/cal-iso.el b/lisp/calendar/cal-iso.el index d1abad26275..f3cc430590f 100644 --- a/lisp/calendar/cal-iso.el +++ b/lisp/calendar/cal-iso.el @@ -47,9 +47,6 @@ Sunday). The Gregorian date Sunday, December 31, 1 BC is imaginary." (* 7 (1- (calendar-extract-month date))) (if (zerop day) 6 (1- day))))) -(define-obsolete-function-alias 'calendar-absolute-from-iso - 'calendar-iso-to-absolute "23.1") - ;;;###cal-autoload (defun calendar-iso-from-absolute (date) "Compute the `ISO commercial date' corresponding to the absolute DATE. @@ -91,9 +88,6 @@ date Sunday, December 31, 1 BC." (message "ISO date: %s" (calendar-iso-date-string (calendar-cursor-to-date t)))) -(define-obsolete-function-alias 'calendar-print-iso-date - 'calendar-iso-print-date "23.1") - (defun calendar-iso-read-date (&optional dayflag) "Interactively read the arguments for an ISO date command. Reads a year and week, and if DAYFLAG is non-nil a day (otherwise @@ -118,9 +112,6 @@ taken to be 1)." 1))) (list (list week day year)))) -(define-obsolete-function-alias 'calendar-iso-read-args - 'calendar-iso-read-date "23.1") - ;;;###cal-autoload (defun calendar-iso-goto-date (date &optional noecho) "Move cursor to ISO DATE; echo ISO date unless NOECHO is non-nil." @@ -129,9 +120,6 @@ taken to be 1)." (calendar-iso-to-absolute date))) (or noecho (calendar-iso-print-date))) -(define-obsolete-function-alias 'calendar-goto-iso-date - 'calendar-iso-goto-date "23.1") - ;;;###cal-autoload (defun calendar-iso-goto-week (date &optional noecho) "Move cursor to ISO DATE; echo ISO date unless NOECHO is non-nil. @@ -141,9 +129,6 @@ Interactively, goes to the first day of the specified week." (calendar-iso-to-absolute date))) (or noecho (calendar-iso-print-date))) -(define-obsolete-function-alias 'calendar-goto-iso-week - 'calendar-iso-goto-week "23.1") - (defvar date) ;; To be called from diary-list-sexp-entries, where DATE is bound. diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el index 5a634161da0..3cfa612d0a1 100644 --- a/lisp/calendar/cal-julian.el +++ b/lisp/calendar/cal-julian.el @@ -45,9 +45,6 @@ The Gregorian date Sunday, December 31, 1 BC is imaginary." (/ (1- year) 4) -2))) -(define-obsolete-function-alias 'calendar-absolute-from-julian - 'calendar-julian-to-absolute "23.1") - ;;;###cal-autoload (defun calendar-julian-from-absolute (date) "Compute the Julian (month day year) corresponding to the absolute DATE. @@ -93,9 +90,6 @@ Driven by the variable `calendar-date-display-form'." (message "Julian date: %s" (calendar-julian-date-string (calendar-cursor-to-date t)))) -(define-obsolete-function-alias 'calendar-print-julian-date - 'calendar-julian-print-date "23.1") - ;;;###cal-autoload (defun calendar-julian-goto-date (date &optional noecho) "Move cursor to Julian DATE; echo Julian date unless NOECHO is non-nil." @@ -132,9 +126,6 @@ Driven by the variable `calendar-date-display-form'." (calendar-julian-to-absolute date))) (or noecho (calendar-julian-print-date))) -(define-obsolete-function-alias 'calendar-goto-julian-date - 'calendar-julian-goto-date "23.1") - ;;;###holiday-autoload (defun holiday-julian (month day string) "Holiday on MONTH, DAY (Julian) called STRING. @@ -156,9 +147,6 @@ nil if it is not visible in the current calendar window." "Absolute date of astronomical (Julian) day number D." (- d 1721424.5)) -(define-obsolete-function-alias 'calendar-absolute-from-astro - 'calendar-astro-to-absolute "23.1") - ;;;###cal-autoload (defun calendar-astro-from-absolute (d) "Astronomical (Julian) day number of absolute date D." @@ -181,9 +169,6 @@ Defaults to today's date if DATE is not given." "Astronomical (Julian) day number (at noon UTC): %s.0" (calendar-astro-date-string (calendar-cursor-to-date t)))) -(define-obsolete-function-alias 'calendar-print-astro-day-number - 'calendar-astro-print-day-number "23.1") - ;;;###cal-autoload (defun calendar-astro-goto-day-number (daynumber &optional noecho) "Move cursor to astronomical (Julian) DAYNUMBER. @@ -197,8 +182,6 @@ Echo astronomical (Julian) day number unless NOECHO is non-nil." (calendar-astro-to-absolute daynumber)))) (or noecho (calendar-astro-print-day-number))) -(define-obsolete-function-alias 'calendar-goto-astro-day-number - 'calendar-astro-goto-day-number "23.1") (defvar date) diff --git a/lisp/calendar/cal-mayan.el b/lisp/calendar/cal-mayan.el index 96f5769a549..cf3fc064b6a 100644 --- a/lisp/calendar/cal-mayan.el +++ b/lisp/calendar/cal-mayan.el @@ -132,9 +132,6 @@ but some use 1137140. Using 1232041 gives you Spinden's correlation; using (message "Mayan date: %s" (calendar-mayan-date-string (calendar-cursor-to-date t)))) -(define-obsolete-function-alias 'calendar-print-mayan-date - 'calendar-mayan-print-date "23.1") - (defun calendar-mayan-read-haab-date () "Prompt for a Mayan haab date." (let* ((completion-ignore-case t) @@ -179,9 +176,6 @@ Echo Mayan date unless NOECHO is non-nil." (calendar-absolute-from-gregorian (calendar-cursor-to-date)))))) (or noecho (calendar-mayan-print-date))) -(define-obsolete-function-alias 'calendar-next-haab-date - 'calendar-mayan-next-haab-date "23.1") - ;;;###cal-autoload (defun calendar-mayan-previous-haab-date (haab-date &optional noecho) "Move cursor to previous instance of Mayan HAAB-DATE. @@ -194,9 +188,6 @@ Echo Mayan date unless NOECHO is non-nil." (1- (calendar-absolute-from-gregorian (calendar-cursor-to-date)))))) (or noecho (calendar-mayan-print-date))) -(define-obsolete-function-alias 'calendar-previous-haab-date - 'calendar-mayan-previous-haab-date "23.1") - (defun calendar-mayan-haab-to-string (haab) "Convert Mayan HAAB date (a pair) into its traditional written form." (let ((month (cdr haab))) @@ -247,9 +238,6 @@ Echo Mayan date unless NOECHO is non-nil." (calendar-absolute-from-gregorian (calendar-cursor-to-date)))))) (or noecho (calendar-mayan-print-date))) -(define-obsolete-function-alias 'calendar-next-tzolkin-date - 'calendar-mayan-next-tzolkin-date "23.1") - ;;;###cal-autoload (defun calendar-mayan-previous-tzolkin-date (tzolkin-date &optional noecho) "Move cursor to previous instance of Mayan TZOLKIN-DATE. @@ -262,9 +250,6 @@ Echo Mayan date unless NOECHO is non-nil." (1- (calendar-absolute-from-gregorian (calendar-cursor-to-date)))))) (or noecho (calendar-mayan-print-date))) -(define-obsolete-function-alias 'calendar-previous-tzolkin-date - 'calendar-mayan-previous-tzolkin-date "23.1") - (defun calendar-mayan-tzolkin-to-string (tzolkin) "Convert Mayan TZOLKIN date (a pair) into its traditional written form." (format "%d %s" @@ -309,9 +294,6 @@ Echo Mayan date unless NOECHO is non-nil." (calendar-goto-date (calendar-gregorian-from-absolute date)) (or noecho (calendar-mayan-print-date))))) -(define-obsolete-function-alias 'calendar-next-calendar-round-date - 'calendar-mayan-next-round-date "23.1") - ;;;###cal-autoload (defun calendar-mayan-previous-round-date (tzolkin-date haab-date &optional noecho) @@ -330,9 +312,6 @@ Echo Mayan date unless NOECHO is non-nil." (calendar-goto-date (calendar-gregorian-from-absolute date)) (or noecho (calendar-mayan-print-date))))) -(define-obsolete-function-alias 'calendar-previous-calendar-round-date - 'calendar-mayan-previous-round-date "23.1") - (defun calendar-mayan-long-count-to-absolute (c) "Compute the absolute date corresponding to the Mayan Long Count C. Long count is a list (baktun katun tun uinal kin)" @@ -344,9 +323,6 @@ Long count is a list (baktun katun tun uinal kin)" ;; Days before absolute date 0. (- calendar-mayan-days-before-absolute-zero))) -(define-obsolete-function-alias 'calendar-absolute-from-mayan-long-count - 'calendar-mayan-long-count-to-absolute "23.1") - (defun calendar-mayan-long-count-common-era (lc) "Return non-nil if long count LC represents a date in the Common Era." (let ((base (calendar-mayan-long-count-from-absolute 1))) @@ -377,9 +353,6 @@ Echo Mayan date unless NOECHO is non-nil." (calendar-mayan-long-count-to-absolute date))) (or noecho (calendar-mayan-print-date))) -(define-obsolete-function-alias 'calendar-goto-mayan-long-count-date - 'calendar-mayan-goto-long-count-date "23.1") - (defvar date) ;; To be called from diary-list-sexp-entries, where DATE is bound. diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el index 662613926de..7462df84566 100644 --- a/lisp/calendar/cal-menu.el +++ b/lisp/calendar/cal-menu.el @@ -56,6 +56,11 @@ ["One time" diary-bahai-insert-entry] ["Monthly" diary-bahai-insert-monthly-entry] ["Yearly" diary-bahai-insert-yearly-entry]) + ("Insert Chinese" + ["One time" diary-chinese-insert-entry] + ["Monthly" diary-chinese-insert-monthly-entry] + ["Yearly" diary-chinese-insert-yearly-entry] + ["Anniversary" diary-chinese-insert-anniversary-entry]) ("Insert Islamic" ["One time" diary-islamic-insert-entry] ["Monthly" diary-islamic-insert-monthly-entry] @@ -273,14 +278,6 @@ is non-nil." ["Show diary" diary-show-all-entries] ["Exit calendar" calendar-exit])) -;; Undocumented and probably useless. -(defvar cal-menu-load-hook nil - "Hook run on loading of the `cal-menu' package.") -(make-obsolete-variable 'cal-menu-load-hook - "it will be removed in future." "23.1") - -(run-hooks 'cal-menu-load-hook) - (provide 'cal-menu) ;; Local Variables: diff --git a/lisp/calendar/cal-move.el b/lisp/calendar/cal-move.el index bf9333d7dac..f7bae5f6441 100644 --- a/lisp/calendar/cal-move.el +++ b/lisp/calendar/cal-move.el @@ -175,9 +175,6 @@ EVENT is an event like `last-nonmenu-event'." (t (list month 1 year)))))) (run-hooks 'calendar-move-hook))) -(define-obsolete-function-alias - 'scroll-calendar-left 'calendar-scroll-left "23.1") - ;;;###cal-autoload (defun calendar-scroll-right (&optional arg event) "Scroll the displayed calendar window right by ARG months. @@ -188,9 +185,6 @@ EVENT is an event like `last-nonmenu-event'." last-nonmenu-event)) (calendar-scroll-left (- (or arg 1)) event)) -(define-obsolete-function-alias - 'scroll-calendar-right 'calendar-scroll-right "23.1") - ;;;###cal-autoload (defun calendar-scroll-left-three-months (arg &optional event) "Scroll the displayed calendar window left by 3*ARG months. @@ -201,9 +195,6 @@ EVENT is an event like `last-nonmenu-event'." last-nonmenu-event)) (calendar-scroll-left (* 3 arg) event)) -(define-obsolete-function-alias 'scroll-calendar-left-three-months - 'calendar-scroll-left-three-months "23.1") - ;; cf scroll-bar-toolkit-scroll ;;;###cal-autoload (defun calendar-scroll-toolkit-scroll (event) @@ -226,9 +217,6 @@ EVENT is an event like `last-nonmenu-event'." last-nonmenu-event)) (calendar-scroll-left (* -3 arg) event)) -(define-obsolete-function-alias 'scroll-calendar-right-three-months - 'calendar-scroll-right-three-months "23.1") - ;;;###cal-autoload (defun calendar-forward-day (arg) "Move the cursor forward ARG days. diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el index ebf7be2da4b..542dea64e03 100644 --- a/lisp/calendar/cal-persia.el +++ b/lisp/calendar/cal-persia.el @@ -87,9 +87,6 @@ Gregorian date Sunday, December 31, 1 BC." (calendar-persian-last-day-of-month m year)) day)))) ; days so far this month -(define-obsolete-function-alias 'calendar-absolute-from-persian - 'calendar-persian-to-absolute "23.1") - (defun calendar-persian-year-from-absolute (date) "Persian year corresponding to the absolute DATE." (let* ((d0 ; prior days since start of 2820 cycles @@ -163,9 +160,6 @@ Gregorian date Sunday, December 31, 1 BC." (message "Persian date: %s" (calendar-persian-date-string (calendar-cursor-to-date t)))) -(define-obsolete-function-alias 'calendar-print-persian-date - 'calendar-persian-print-date "23.1") - (defun calendar-persian-read-date () "Interactively read the arguments for a Persian date command. Reads a year, month, and day." @@ -192,9 +186,6 @@ Reads a year, month, and day." (lambda (x) (and (< 0 x) (<= x last)))))) (list (list month day year)))) -(define-obsolete-function-alias 'persian-prompt-for-date - 'calendar-persian-read-date "23.1") - ;;;###cal-autoload (defun calendar-persian-goto-date (date &optional noecho) "Move cursor to Persian date DATE. @@ -204,8 +195,6 @@ Echo Persian date unless NOECHO is non-nil." (calendar-persian-to-absolute date))) (or noecho (calendar-persian-print-date))) -(define-obsolete-function-alias 'calendar-goto-persian-date - 'calendar-persian-goto-date "23.1") (defvar date) diff --git a/lisp/calendar/cal-x.el b/lisp/calendar/cal-x.el index 1d3c4f537f0..22daa46fb14 100644 --- a/lisp/calendar/cal-x.el +++ b/lisp/calendar/cal-x.el @@ -65,9 +65,6 @@ Relevant if `calendar-setup' has the value `one-frame'." (vertical-scroll-bars boolean)) :group 'calendar) -(define-obsolete-variable-alias 'calendar-after-frame-setup-hooks - 'calendar-after-frame-setup-hook "23.1") - (defcustom calendar-after-frame-setup-hook nil "List of functions to be run after creating a calendar and/or diary frame." :type 'hook @@ -96,13 +93,9 @@ Runs `calendar-after-frame-setup-hook', selects frame, iconifies if needed." "Display and dedicate the window associated with the diary buffer." (set-window-dedicated-p (display-buffer - (if (if (listp diary-display-function) - (or (memq 'diary-fancy-display diary-display-function) - (memq 'fancy-diary-display diary-display-function)) - (memq diary-display-function '(diary-fancy-display - fancy-diary-display))) + (if (eq diary-display-function 'diary-fancy-display) (progn - ;; If there are no diary entries, there won't be a fancy-diary + ;; If there are no diary entries, there won't be a buffer ;; to dedicate, so make a basic one. (or (get-buffer diary-fancy-buffer) (calendar-in-read-only-buffer diary-fancy-buffer @@ -150,36 +143,6 @@ If PROMPT is non-nil, prompt for the month and year to use." (if (eq config 'one-frame) (calendar-dedicate-diary)))))) - -;;;###cal-autoload -(defun calendar-one-frame-setup (&optional prompt) - "Display calendar and diary in a single dedicated frame. -See `calendar-frame-setup' for more information." - (declare (obsolete calendar-frame-setup "23.1")) - (calendar-frame-setup 'one-frame prompt)) - -;;;###cal-autoload -(defun calendar-only-one-frame-setup (&optional prompt) - "Display calendar in a dedicated frame. -See `calendar-frame-setup' for more information." - (declare (obsolete calendar-frame-setup "23.1")) - (calendar-frame-setup 'calendar-only prompt)) - -;;;###cal-autoload -(defun calendar-two-frame-setup (&optional prompt) - "Display calendar and diary in separate, dedicated frames. -See `calendar-frame-setup' for more information." - (declare (obsolete calendar-frame-setup "23.1")) - (calendar-frame-setup 'two-frames prompt)) - -;; Undocumented and probably useless. -(defvar cal-x-load-hook nil - "Hook run on loading of the `cal-x' package.") -(make-obsolete-variable 'cal-x-load-hook "it will be removed in future." "23.1") - -(run-hooks 'cal-x-load-hook) - - (provide 'cal-x) ;;; cal-x.el ends here diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index a0d66a0ac64..e42a0100696 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -190,9 +190,6 @@ movement commands will not work correctly." (calendar-redraw)) :group 'calendar) -(define-obsolete-variable-alias 'view-diary-entries-initially - 'calendar-view-diary-initially-flag "23.1") - (defcustom calendar-view-diary-initially-flag nil "Non-nil means display current date's diary entries on entry to calendar. The diary is displayed in another window when the calendar is first displayed, @@ -202,9 +199,6 @@ be overridden by the value of `calendar-setup'." :type 'boolean :group 'diary) -(define-obsolete-variable-alias 'mark-diary-entries-in-calendar - 'calendar-mark-diary-entries-flag "23.1") - ;; FIXME :set (defcustom calendar-mark-diary-entries-flag nil "Non-nil means mark dates with diary entries, in the calendar window. @@ -226,8 +220,6 @@ If nil, make an icon of the frame. If non-nil, delete the frame." See the variable `calendar-today-marker'." :group 'calendar-faces) -(define-obsolete-face-alias 'calendar-today-face 'calendar-today "22.1") - (defface diary '((((min-colors 88) (class color) (background light)) :foreground "red1") @@ -244,8 +236,6 @@ Used to mark diary entries in the calendar (see `diary-entry-marker'), and to highlight the date header in the fancy diary." :group 'calendar-faces) -(define-obsolete-face-alias 'diary-face 'diary "22.1") - (defface holiday '((((class color) (background light)) :background "pink") @@ -257,8 +247,6 @@ and to highlight the date header in the fancy diary." See `calendar-holiday-marker'." :group 'calendar-faces) -(define-obsolete-face-alias 'holiday-face 'holiday "22.1") - (defface calendar-weekday-header '((t :inherit font-lock-constant-face)) "Face used for weekday column headers in the calendar. See also the face `calendar-weekend-header'." @@ -308,9 +296,6 @@ The value can be either a single-character string (e.g. \"*\") or a face." :group 'holidays :version "23.1") -(define-obsolete-variable-alias 'view-calendar-holidays-initially - 'calendar-view-holidays-initially-flag "23.1") - (defcustom calendar-view-holidays-initially-flag nil "Non-nil means display holidays for current three month period on entry. The holidays are displayed in another window when the calendar is first @@ -318,9 +303,6 @@ displayed." :type 'boolean :group 'holidays) -(define-obsolete-variable-alias 'mark-holidays-in-calendar - 'calendar-mark-holidays-flag "23.1") - ;; FIXME :set (defcustom calendar-mark-holidays-flag nil "Non-nil means mark dates of holidays in the calendar window. @@ -339,9 +321,6 @@ This is the place to add key bindings to `calendar-mode-map'." :type 'hook :group 'calendar-hooks) -(define-obsolete-variable-alias 'initial-calendar-window-hook - 'calendar-initial-window-hook "23.1") - (defcustom calendar-initial-window-hook nil "List of functions to be called when the calendar window is created. Quitting the calendar and re-entering it will cause these functions @@ -349,9 +328,6 @@ to be called again." :type 'hook :group 'calendar-hooks) -(define-obsolete-variable-alias 'today-visible-calendar-hook - 'calendar-today-visible-hook "23.1") - (defcustom calendar-today-visible-hook nil "List of functions called whenever the current date is visible. To mark today's date, add the function `calendar-mark-today'. @@ -364,9 +340,6 @@ since it may cause the movement commands to fail." :options '(calendar-mark-today calendar-star-date) :group 'calendar-hooks) -(define-obsolete-variable-alias 'today-invisible-calendar-hook - 'calendar-today-invisible-hook "23.1") - (defcustom calendar-today-invisible-hook nil "List of functions called whenever the current date is not visible. See also `calendar-today-visible-hook'." @@ -689,54 +662,28 @@ details, see the documentation for the variable `diary-list-entries-hook'." :type 'string :group 'diary) -(define-obsolete-variable-alias 'hebrew-diary-entry-symbol - 'diary-hebrew-entry-symbol "23.1") +(defcustom diary-chinese-entry-symbol "C" + "Symbol indicating a diary entry according to the Chinese calendar." + :type 'string + :group 'diary + :version "25.1") (defcustom diary-hebrew-entry-symbol "H" "Symbol indicating a diary entry according to the Hebrew calendar." :type 'string :group 'diary) -(define-obsolete-variable-alias 'islamic-diary-entry-symbol - 'diary-islamic-entry-symbol "23.1") - (defcustom diary-islamic-entry-symbol "I" "Symbol indicating a diary entry according to the Islamic calendar." :type 'string :group 'diary) -(define-obsolete-variable-alias 'bahai-diary-entry-symbol - 'diary-bahai-entry-symbol "23.1") - (defcustom diary-bahai-entry-symbol "B" "Symbol indicating a diary entry according to the Bahá'í calendar." :type 'string :group 'diary) -(defcustom european-calendar-style nil - "Non-nil means use the European style of dates in the diary and display. -In this case, a date like 1/2/1990 would be interpreted as -February 1, 1990. See `diary-european-date-forms' for the -default European diary date styles. - -Setting this variable directly does not take effect (if the -calendar package is already loaded). Rather, use either -\\[customize] or the function `calendar-set-date-style'." - :type 'boolean - ;; Without :initialize (require 'calendar) throws an error because - ;; calendar-set-date-style is undefined at this point. - :initialize 'custom-initialize-default - :set (lambda (symbol value) - (if value - (calendar-set-date-style 'european) - (calendar-set-date-style 'american))) - :group 'calendar) - -(make-obsolete-variable 'european-calendar-style 'calendar-date-style "23.1") - -;; If this is autoloaded, c-d-s gets set before any customization of e-c-s. -(defcustom calendar-date-style (if european-calendar-style 'european - 'american) +(defcustom calendar-date-style 'american "Your preferred style for writing dates. The options are: `american' - month/day/year @@ -785,9 +732,6 @@ but `diary-date-forms' (which see)." (choice symbol regexp))))) :group 'diary) -(define-obsolete-variable-alias 'american-date-diary-pattern - 'diary-american-date-forms "23.1") - (defcustom diary-american-date-forms '((month "/" day "[^/0-9]") (month "/" day "/" year "[^0-9]") @@ -809,9 +753,6 @@ but `diary-date-forms' (which see)." (choice symbol regexp))))) :group 'diary) -(define-obsolete-variable-alias 'european-date-diary-pattern - 'diary-european-date-forms "23.1") - (defcustom diary-european-date-forms '((day "/" month "[^/0-9]") (day "/" month "/" year "[^0-9]") @@ -901,9 +842,6 @@ Normally you should not customize this, but `calendar-date-display-form' :version "23.1" :group 'calendar) -(define-obsolete-variable-alias 'european-calendar-display-form - 'calendar-european-date-display-form "23.1") - (defcustom calendar-european-date-display-form '((if dayname (concat dayname ", ")) day " " monthname " " year) "Pseudo-pattern governing the way a date appears in the European style. @@ -912,9 +850,6 @@ Normally you should not customize this, but `calendar-date-display-form' :type 'sexp :group 'calendar) -(define-obsolete-variable-alias 'american-calendar-display-form - 'calendar-american-date-display-form "23.1") - (defcustom calendar-american-date-display-form '((if dayname (concat dayname ", ")) monthname " " day ", " year) "Pseudo-pattern governing the way a date appears in the American style. @@ -1029,21 +964,6 @@ The valid styles are described in the documentation of `calendar-date-style'." (calendar-redraw) (calendar-update-mode-line)) -(defun european-calendar () - "Set the interpretation and display of dates to the European style." - (declare (obsolete calendar-set-date-style "23.1")) - (interactive) - (calendar-set-date-style 'european)) - -(defun american-calendar () - "Set the interpretation and display of dates to the American style." - (declare (obsolete calendar-set-date-style "23.1")) - (interactive) - (calendar-set-date-style 'american)) - -(define-obsolete-variable-alias 'holidays-in-diary-buffer - 'diary-show-holidays-flag "23.1") - (defcustom diary-show-holidays-flag t "Non-nil means include holidays in the diary display. The holidays appear in the mode line of the diary buffer, or in the @@ -1057,9 +977,6 @@ somewhat; setting it to nil makes the diary display faster." :type 'boolean :group 'calendar) -(define-obsolete-variable-alias 'all-hebrew-calendar-holidays - 'calendar-hebrew-all-holidays-flag "23.1") - (defcustom calendar-hebrew-all-holidays-flag nil "If nil, show only major holidays from the Hebrew calendar. This means only those Jewish holidays that appear on secular calendars. @@ -1068,9 +985,6 @@ calendar." :type 'boolean :group 'holidays) -(define-obsolete-variable-alias 'all-christian-calendar-holidays - 'calendar-christian-all-holidays-flag "23.1") - (defcustom calendar-christian-all-holidays-flag nil "If nil, show only major holidays from the Christian calendar. This means only those Christian holidays that appear on secular calendars. @@ -1079,9 +993,6 @@ calendar." :type 'boolean :group 'holidays) -(define-obsolete-variable-alias 'all-islamic-calendar-holidays - 'calendar-islamic-all-holidays-flag "23.1") - (defcustom calendar-islamic-all-holidays-flag nil "If nil, show only major holidays from the Islamic calendar. This means only those Islamic holidays that appear on secular calendars. @@ -1090,9 +1001,6 @@ calendar." :type 'boolean :group 'holidays) -(define-obsolete-variable-alias 'all-bahai-calendar-holidays - 'calendar-bahai-all-holidays-flag "23.1") - (defcustom calendar-bahai-all-holidays-flag nil "If nil, show only major holidays from the Bahá'í calendar. These are the days on which work and school must be suspended. @@ -1123,8 +1031,6 @@ calendar." (defconst diary-fancy-buffer "*Fancy Diary Entries*" "Name of the buffer used for the optional fancy display of the diary.") -(define-obsolete-variable-alias 'fancy-diary-buffer 'diary-fancy-buffer "23.1") - (defconst calendar-other-calendars-buffer "*Other Calendars*" "Name of the buffer used for the display of date on other calendars.") @@ -1157,9 +1063,6 @@ Optional NMONTHS is the number of months per year (default 12)." (and (< macro-y 0) (> ,mon 1) (setq ,yr (1- ,yr))) (if (< ,yr 1) (setq ,yr (1- ,yr))))) ; 0 AD -> -1 BC, etc -(define-obsolete-function-alias 'increment-calendar-month - 'calendar-increment-month "23.1") - (defvar displayed-month) (defvar displayed-year) @@ -1172,17 +1075,6 @@ MON defaults to `displayed-month'. YR defaults to `displayed-year'." (calendar-increment-month mon yr n) (cons mon yr)) -(defmacro calendar-for-loop (var from init to final do &rest body) - "Execute a for loop. -Evaluate BODY with VAR bound to successive integers from INIT to FINAL, -inclusive. The standard macro `dotimes' is preferable in most cases." - (declare (obsolete "use `dotimes' or `while' instead." "23.1") - (debug (symbolp "from" form "to" form "do" body)) - (indent defun)) - `(let ((,var (1- ,init))) - (while (>= ,final (setq ,var (1+ ,var))) - ,@body))) - (defmacro calendar-sum (index initial condition expression) "For INDEX = INITIAL, +1, ... (as long as CONDITION holds), sum EXPRESSION." (declare (debug (symbolp form form form))) @@ -1242,25 +1134,16 @@ with disabled undo. Leaves point at point-min, displays BUFFER." "Extract the month part of DATE which has the form (month day year)." (car date)) -(define-obsolete-function-alias 'extract-calendar-month - 'calendar-extract-month "23.1") - ;; Note gives wrong answer for result of (calendar-read-date 'noday), ;; but that is only used by `calendar-other-month'. (defsubst calendar-extract-day (date) "Extract the day part of DATE which has the form (month day year)." (cadr date)) -(define-obsolete-function-alias 'extract-calendar-day - 'calendar-extract-day "23.1") - (defsubst calendar-extract-year (date) "Extract the year part of DATE which has the form (month day year)." (nth 2 date)) -(define-obsolete-function-alias 'extract-calendar-year - 'calendar-extract-year "23.1") - (defsubst calendar-leap-year-p (year) "Return t if YEAR is a Gregorian leap year. A negative year is interpreted as BC; -1 being 1 BC, and so on." @@ -1418,10 +1301,16 @@ display the generated calendar." ;; the right thing in that case. ;; ;; Is this a wide frame? If so, split it horizontally. - (if (window-splittable-p t) (split-window-right)) + + ;; The following doesn't sound useful: If we split horizontally + ;; here, the subsequent `pop-to-buffer' will likely split again + ;; horizontally and we end up with three side-by-side windows. + (when (window-splittable-p (selected-window) t) + (split-window-right)) (pop-to-buffer calendar-buffer) ;; Has the window already been split vertically? (when (and (not (window-dedicated-p)) + (window-splittable-p (selected-window)) (window-full-height-p)) (let ((win (split-window-below))) ;; In the upper window, show whatever was visible before. @@ -1439,7 +1328,7 @@ display the generated calendar." '(nil . ((inhibit-same-window . t))))) (diary-view-entries))))) (if calendar-view-holidays-initially-flag - (let* ((diary-buffer (get-file-buffer diary-file)) + (let* ((diary-buffer (diary-live-p)) (diary-window (if diary-buffer (get-buffer-window diary-buffer))) (split-height-threshold (if diary-window 2 1000))) ;; FIXME display buffer? @@ -1473,17 +1362,15 @@ Optional integers MON and YR are used instead of today's date." ;; combined don't fit height to that of its buffer. (set-window-vscroll nil 0)) (sit-for 0)) - (and (bound-and-true-p font-lock-mode) - (font-lock-fontify-buffer)) (and calendar-mark-holidays-flag -;;; (calendar-date-is-valid-p today) ; useful for BC dates + ;; (calendar-date-is-valid-p today) ; useful for BC dates (calendar-mark-holidays) (and in-calendar-window (sit-for 0))) (unwind-protect (if calendar-mark-diary-entries-flag (diary-mark-entries)) - (if today-visible - (run-hooks 'calendar-today-visible-hook) - (run-hooks 'calendar-today-invisible-hook))))) + (run-hooks (if today-visible + 'calendar-today-visible-hook + 'calendar-today-invisible-hook))))) (defun calendar-generate (month year) "Generate a three-month Gregorian calendar centered around MONTH, YEAR." @@ -1714,6 +1601,10 @@ line." (define-key map "iBd" 'diary-bahai-insert-entry) (define-key map "iBm" 'diary-bahai-insert-monthly-entry) (define-key map "iBy" 'diary-bahai-insert-yearly-entry) + (define-key map "iCd" 'diary-chinese-insert-entry) + (define-key map "iCm" 'diary-chinese-insert-monthly-entry) + (define-key map "iCy" 'diary-chinese-insert-yearly-entry) + (define-key map "iCa" 'diary-chinese-insert-anniversary-entry) (define-key map "?" 'calendar-goto-info-node) (define-key map "Hm" 'cal-html-cursor-month) (define-key map "Hy" 'cal-html-cursor-year) @@ -1791,14 +1682,18 @@ is COMMAND's keybinding, STRING describes the binding." nil "today")) '(calendar-date-string (calendar-current-date) t) (calendar-mode-line-entry 'calendar-scroll-left "next month" ">")) - "The mode line of the calendar buffer. + "If non-nil, the mode line of the calendar buffer. This is a list of items that evaluate to strings. The elements are evaluated and concatenated, evenly separated by blanks. During evaluation, the variable `date' is available as the date nearest the cursor (or today's date if that fails). To update -the mode-line as the cursor moves, add `calendar-update-mode-line' -to `calendar-move-hook'. Here is an example that has the Hebrew date, -the day number/days remaining in the year, and the ISO week/year numbers: +the mode-line as the cursor moves, add +`calendar-update-mode-line' to `calendar-move-hook'. + +If nil, do not modify the mode line at all. + +Here is an example that has the Hebrew date, the day number/days +remaining in the year, and the ISO week/year numbers: (list \"\" @@ -1876,7 +1771,8 @@ the STRINGS are just concatenated and the result truncated." (defun calendar-update-mode-line () "Update the calendar mode line with the current date and date style." - (if (bufferp (get-buffer calendar-buffer)) + (if (and calendar-mode-line-format + (bufferp (get-buffer calendar-buffer))) (with-current-buffer calendar-buffer (let ((start (- calendar-left-margin 2)) (date (condition-case nil @@ -1924,8 +1820,6 @@ the STRINGS are just concatenated and the result truncated." (dolist (b calendar-buffers) (quit-windows-on b kill)))))) -(define-obsolete-function-alias 'exit-calendar 'calendar-exit "23.1") - (defun calendar-current-date (&optional offset) "Return the current date in a list (month day year). Optional integer OFFSET is a number of days from the current date." @@ -2478,9 +2372,6 @@ Returns the corresponding Gregorian date." ;; Note there are side effects on calendar navigation. (<= 1 year)))) -(define-obsolete-function-alias 'calendar-date-is-legal-p - 'calendar-date-is-valid-p "23.1") - (defun calendar-date-equal (date1 date2) "Return t if the DATE1 and DATE2 are the same." (and @@ -2553,9 +2444,6 @@ MARK defaults to `diary-entry-marker'." (make-overlay (1- (point)) (1+ (point))) 'face (calendar-make-temp-face mark)))))))) -(define-obsolete-function-alias 'mark-visible-calendar-date - 'calendar-mark-visible-date "23.1") - (defun calendar-star-date () "Replace the date under the cursor in the calendar window with asterisks. You might want to add this function to `calendar-today-visible-hook'." @@ -2730,8 +2618,6 @@ If called by a mouse-event, pops up a menu with the result." "---") (calendar-string-spread (list str) ?- width))))) -(define-obsolete-function-alias 'calendar-version 'emacs-version "23.1") - (run-hooks 'calendar-load-hook) (provide 'calendar) diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 724270d2a88..29364b55b6c 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -49,13 +49,6 @@ are holidays." :type 'boolean :group 'diary) -(defcustom diary-face 'diary - "Face name to use for diary entries." - :type 'face - :group 'calendar-faces) -(make-obsolete-variable 'diary-face "customize the face `diary' instead." - "23.1") - (defface diary-anniversary '((t :inherit font-lock-keyword-face)) "Face used for anniversaries in the fancy diary display." :version "22.1" @@ -72,8 +65,6 @@ are holidays." :version "22.1" :group 'calendar-faces) -(define-obsolete-face-alias 'diary-button-face 'diary-button "22.1") - ;; Face markup of calendar and diary displays: Any entry line that ;; ends with [foo:value] where foo is a face attribute (except :box ;; :stipple) or with [face:blah] tags, will have these values applied @@ -133,9 +124,6 @@ are: `string', `symbol', `int', `tnil', `stringtnil.'" :type 'function :group 'diary) -(define-obsolete-variable-alias 'sexp-diary-entry-symbol - 'diary-sexp-entry-symbol "23.1") - (defcustom diary-sexp-entry-symbol "%%" "The string used to indicate a sexp diary entry in `diary-file'. See the documentation for the function `diary-list-sexp-entries'." @@ -168,18 +156,10 @@ Used for example by the appointment package - see `appt-activate'." :type 'hook :group 'diary) -(define-obsolete-variable-alias 'diary-display-hook 'diary-display-function - "23.1") - (defcustom diary-display-function 'diary-fancy-display "Function used to display the diary. The two standard options are `diary-fancy-display' and `diary-simple-display'. -For historical reasons, `nil' is the same as `diary-simple-display' -\(so you must use `ignore' for no display). Also for historical -reasons, this variable can be a list of functions to run. These -uses are not recommended and may be removed at some point. - When this function is called, the variable `diary-entries-list' is a list, in order by date, of all relevant diary entries in the form of ((MONTH DAY YEAR) STRING), where string is the diary @@ -188,17 +168,13 @@ produce a different buffer for display (perhaps combined with holidays), or hard copy output." :type '(choice (const diary-fancy-display :tag "Fancy display") (const diary-simple-display :tag "Basic display") - (const ignore :tag "No display") - (const nil :tag "Obsolete way to choose basic display") - (hook :tag "Obsolete form with list of display functions")) + (const :tag "No display" ignore) + (function :tag "User-specified function")) :initialize 'custom-initialize-default :set 'diary-set-maybe-redraw :version "23.2" ; simple->fancy :group 'diary) -(define-obsolete-variable-alias 'list-diary-entries-hook - 'diary-list-entries-hook "23.1") - (defcustom diary-list-entries-hook nil "Hook run after diary file is culled for relevant entries. @@ -227,9 +203,6 @@ the main file and all included files, you would use the nongregorian hook." :options '(diary-include-other-diary-files diary-sort-entries) :group 'diary) -(define-obsolete-variable-alias 'mark-diary-entries-hook - 'diary-mark-entries-hook "23.1") - (defcustom diary-mark-entries-hook nil "List of functions called after marking diary entries in the calendar. You might wish to add `diary-mark-included-diary-files', in which case @@ -244,9 +217,6 @@ differ only if you are using included diary files. In that case, :options '(diary-mark-included-diary-files) :group 'diary) -(define-obsolete-variable-alias 'nongregorian-diary-listing-hook - 'diary-nongregorian-listing-hook "23.1") - (defcustom diary-nongregorian-listing-hook nil "List of functions called for listing diary file and included files. As the files are processed for diary entries, these functions are used @@ -264,9 +234,6 @@ use `diary-list-entries-hook', which runs only for the main diary file." diary-islamic-list-entries) :group 'diary) -(define-obsolete-variable-alias 'nongregorian-diary-marking-hook - 'diary-nongregorian-marking-hook "23.1") - (defcustom diary-nongregorian-marking-hook nil "List of functions called for marking diary file and included files. As the files are processed for diary entries, these functions are used @@ -284,9 +251,6 @@ use `diary-mark-entries-hook', which runs only for the main diary file." diary-islamic-mark-entries) :group 'diary) -(define-obsolete-variable-alias 'print-diary-entries-hook - 'diary-print-entries-hook "23.1") - (defcustom diary-print-entries-hook 'lpr-buffer "Run by `diary-print-entries' after preparing a temporary diary buffer. The buffer shows only the diary entries currently visible in the @@ -334,9 +298,6 @@ expressions that can involve the keywords `days' (a number), `date' :type 'sexp :group 'diary) -(define-obsolete-variable-alias 'abbreviated-calendar-year - 'diary-abbreviated-year-flag "23.1") - (defcustom diary-abbreviated-year-flag t "Interpret a two-digit year DD in a diary entry as either 19DD or 20DD. This applies to the Gregorian, Hebrew, Islamic, and Bahá'í calendars. @@ -468,7 +429,8 @@ Only used if `diary-header-line-flag' is non-nil." ;; just visiting the diary-file. This is i) unlikely, and ii) no great loss. ;;;###cal-autoload (defun diary-live-p () - "Return non-nil if the diary is being displayed." + "Return non-nil if the diary is being displayed. +The actual return value is a diary buffer." (or (get-buffer diary-fancy-buffer) (and diary-file (find-buffer-visiting diary-file)))) @@ -484,9 +446,6 @@ just visiting the `diary-file'), and SYMBOL's value is to be changed." ;; Note this assumes diary was called without prefix arg. (diary)))) -(define-obsolete-variable-alias 'number-of-diary-entries - 'diary-number-of-entries "23.1") - (defcustom diary-number-of-entries 1 "Specifies how many days of diary entries are to be displayed initially. This variable affects the diary display when the command \\[diary] is @@ -562,10 +521,6 @@ DFILE specifies the file to use as the diary file." (let ((diary-file dfile)) (diary-view-entries arg))) -;;;###cal-autoload -(define-obsolete-function-alias 'view-other-diary-entries - 'diary-view-other-diary-entries "23.1") - (defvar diary-syntax-table (let ((st (copy-syntax-table (standard-syntax-table)))) (modify-syntax-entry ?* "w" st) @@ -684,8 +639,6 @@ Also removes the region between `diary-comment-start' and (list marker dfile literal) globcolor))))))) -(define-obsolete-function-alias 'add-to-diary-list 'diary-add-to-list "23.1") - (defun diary-list-entries-2 (date mark globattr list-only &optional months symbol gdate) "Internal subroutine of `diary-list-entries'. @@ -909,12 +862,7 @@ LIST-ONLY is non-nil, in which case it just returns the list." 'display-buffer-in-previous-window (copy-sequence (car display-buffer-fallback-action)))))) - (if (and diary-display-function - (listp diary-display-function)) - ;; Backwards compatibility. - (run-hooks 'diary-display-function) - (funcall (or diary-display-function - 'diary-simple-display))))) + (funcall diary-display-function))) (run-hooks 'diary-hook))))) (and temp-buff (buffer-name temp-buff) (kill-buffer temp-buff))) (or d-incp (message "Preparing diary...done")) @@ -975,9 +923,6 @@ For details, see `diary-include-files'. See also `diary-mark-included-diary-files'." (diary-include-files)) -(define-obsolete-function-alias 'include-other-diary-files - 'diary-include-other-diary-files "23.1") - (defvar date-string) ; bound in diary-list-entries (defun diary-display-no-entries () @@ -1036,9 +981,6 @@ in the mode line. This is an option for `diary-display-function'." (set-window-point window diary-saved-point) (set-window-start window (point-min))))))) -(define-obsolete-function-alias 'simple-diary-display - 'diary-simple-display "23.1") - (defvar diary-goto-entry-function 'diary-goto-entry "Function called to jump to a diary entry. Modes that require special handling of the included file @@ -1165,9 +1107,6 @@ This is an option for `diary-display-function'." (diary-fancy-display-mode)) (calendar-set-mode-line date-string)))) -(define-obsolete-function-alias 'fancy-diary-display - 'diary-fancy-display "23.1") - ;; FIXME modernize? (defun diary-print-entries () "Print a hard copy of the diary display. @@ -1212,9 +1151,6 @@ the actual printing." (run-hooks 'diary-print-entries-hook) (kill-buffer temp-buffer)))) -(define-obsolete-function-alias 'print-diary-entries - 'diary-print-entries "23.1") - ;;;###cal-autoload (defun diary-show-all-entries () "Show all of the diary entries in the diary file. @@ -1462,9 +1398,6 @@ marks. This is intended to deal with deleted diary entries." (and temp-buff (buffer-name temp-buff) (kill-buffer temp-buff))) (or d-incp (message "Marking diary entries...done")))) -;;;###cal-autoload -(define-obsolete-function-alias 'mark-diary-entries 'diary-mark-entries "23.1") - (defun diary-sexp-entry (sexp entry date) "Process a SEXP diary ENTRY for DATE." (let ((result (if calendar-debug-sexp @@ -1542,9 +1475,6 @@ is marked. See the documentation for the function `diary-list-sexp-entries'." (or (cadr (diary-pull-attrs entry file-glob-attrs)) (if (consp mark) (car mark))))))))) -(define-obsolete-function-alias 'mark-sexp-diary-entries - 'diary-mark-sexp-entries "23.1") - (defun diary-mark-included-diary-files () "Mark diary entries from included diary files. To use, add this function to `diary-mark-entries-hook'. @@ -1552,9 +1482,6 @@ For details, see `diary-include-files'. See also `diary-include-other-diary-files'." (diary-include-files t)) -(define-obsolete-function-alias 'mark-included-diary-files - 'diary-mark-included-diary-files "23.1") - (defun calendar-mark-days-named (dayname &optional color) "Mark all dates in the calendar window that are day DAYNAME of the week. 0 means all Sundays, 1 means all Mondays, and so on. @@ -1577,9 +1504,6 @@ Optional argument COLOR is passed to `calendar-mark-visible-date' as MARK." color) (setq day (+ day 7)))))) -(define-obsolete-function-alias 'mark-calendar-days-named - 'calendar-mark-days-named "23.1") - (defun calendar-mark-month (month year p-month p-day p-year &optional color) "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P-DAY/P-YEAR. A value of 0 in any position of the pattern is a wildcard. @@ -1593,9 +1517,6 @@ Optional argument COLOR is passed to `calendar-mark-visible-date' as MARK." (calendar-mark-visible-date (list month (1+ i) year) color)) (calendar-mark-visible-date (list month p-day year) color)))) -(define-obsolete-function-alias 'mark-calendar-month - 'calendar-mark-month "23.1") - (defun calendar-mark-date-pattern (month day year &optional color) "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR. A value of 0 in any position is a wildcard. Optional argument COLOR is @@ -1608,9 +1529,6 @@ passed to `calendar-mark-visible-date' as MARK." (calendar-mark-month m y month day year color) (calendar-increment-month m y 1))))) -(define-obsolete-function-alias 'mark-calendar-date-pattern - 'calendar-mark-date-pattern "23.1") - ;; Bahai, Hebrew, Islamic. (defun calendar-mark-complex (month day year fromabs &optional color) "Mark dates in the calendar conforming to MONTH DAY YEAR of some system. @@ -1716,8 +1634,6 @@ be the last item in the hook, in case earlier items add diary entries, or change the order." (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare))) -(define-obsolete-function-alias 'sort-diary-entries 'diary-sort-entries "23.1") - (defun diary-list-sexp-entries (date) "Add sexp entries for DATE from the diary file to `diary-entries-list'. @@ -1876,9 +1792,6 @@ best if they are non-marking." (setq entry-found (or entry-found diary-entry))) entry-found)) -(define-obsolete-function-alias 'list-sexp-diary-entries - 'diary-list-sexp-entries "23.1") - (defun diary-make-date (a b c) "Convert A B C into the internal calendar date form. The expected order of the inputs depends on `calendar-date-style', @@ -2140,9 +2053,6 @@ If omitted, NONMARKING defaults to nil and FILE defaults to string " ")) ;;;###cal-autoload -(define-obsolete-function-alias 'make-diary-entry 'diary-make-entry "23.1") - -;;;###cal-autoload (defun diary-insert-entry (arg &optional event) "Insert a diary entry for the date indicated by point. Prefix argument ARG makes the entry nonmarking." @@ -2152,9 +2062,6 @@ Prefix argument ARG makes the entry nonmarking." arg)) ;;;###cal-autoload -(define-obsolete-function-alias 'insert-diary-entry 'diary-insert-entry "23.1") - -;;;###cal-autoload (defun diary-insert-weekly-entry (arg) "Insert a weekly diary entry for the day of the week indicated by point. Prefix argument ARG makes the entry nonmarking." @@ -2162,10 +2069,6 @@ Prefix argument ARG makes the entry nonmarking." (diary-make-entry (calendar-day-name (calendar-cursor-to-date t)) arg)) -;;;###cal-autoload -(define-obsolete-function-alias 'insert-weekly-diary-entry - 'diary-insert-weekly-entry "23.1") - (defun diary-date-display-form (&optional type) "Return value for `calendar-date-display-form' using `calendar-date-style'. Optional symbol TYPE is either `monthly' or `yearly'." @@ -2221,10 +2124,6 @@ Prefix argument ARG makes the entry nonmarking." (diary-insert-entry-1 'monthly arg)) ;;;###cal-autoload -(define-obsolete-function-alias 'insert-monthly-diary-entry - 'diary-insert-monthly-entry "23.1") - -;;;###cal-autoload (defun diary-insert-yearly-entry (arg) "Insert an annual diary entry for the day of the year indicated by point. Prefix argument ARG makes the entry nonmarking." @@ -2232,10 +2131,6 @@ Prefix argument ARG makes the entry nonmarking." (diary-insert-entry-1 'yearly arg)) ;;;###cal-autoload -(define-obsolete-function-alias 'insert-yearly-diary-entry - 'diary-insert-yearly-entry "23.1") - -;;;###cal-autoload (defun diary-insert-anniversary-entry (arg) "Insert an anniversary diary entry for the date given by point. Prefix argument ARG makes the entry nonmarking." @@ -2248,10 +2143,6 @@ Prefix argument ARG makes the entry nonmarking." arg))) ;;;###cal-autoload -(define-obsolete-function-alias 'insert-anniversary-diary-entry - 'diary-insert-anniversary-entry "23.1") - -;;;###cal-autoload (defun diary-insert-block-entry (arg) "Insert a block diary entry for the days between the point and marked date. Prefix argument ARG makes the entry nonmarking." @@ -2275,10 +2166,6 @@ Prefix argument ARG makes the entry nonmarking." arg))) ;;;###cal-autoload -(define-obsolete-function-alias 'insert-block-diary-entry - 'diary-insert-block-entry "23.1") - -;;;###cal-autoload (defun diary-insert-cyclic-entry (arg) "Insert a cyclic diary entry starting at the date given by point. Prefix argument ARG makes the entry nonmarking." @@ -2292,10 +2179,6 @@ Prefix argument ARG makes the entry nonmarking." (calendar-date-string (calendar-cursor-to-date t) nil t)) arg))) -;;;###cal-autoload -(define-obsolete-function-alias 'insert-cyclic-diary-entry - 'diary-insert-cyclic-entry "23.1") - ;;; Diary mode. (defun diary-redraw-calendar () @@ -2356,7 +2239,7 @@ full month names." (if (equal (car x) 'backup) (concat "\\)" (eval (car (reverse x)))) "\\)")) - '(1 diary-face))) + '(1 'diary))) diary-date-forms))) (defmacro diary-font-lock-keywords-1 (markfunc listfunc feature months symbol) @@ -2381,6 +2264,7 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL." (defvar calendar-hebrew-month-name-array-leap-year) (defvar calendar-islamic-month-name-array) (defvar calendar-bahai-month-name-array) +(defvar calendar-chinese-month-name-array) ;;;###cal-autoload (defun diary-font-lock-keywords () @@ -2403,6 +2287,11 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL." cal-bahai calendar-bahai-month-name-array diary-bahai-entry-symbol) + (diary-font-lock-keywords-1 diary-chinese-mark-entries + diary-chinese-list-entries + cal-china + calendar-chinese-month-name-array + diary-chinese-entry-symbol) (list (cons (format "^%s.*$" (regexp-quote diary-include-string)) @@ -2419,7 +2308,8 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL." (regexp-opt (mapcar 'regexp-quote (list diary-hebrew-entry-symbol diary-islamic-entry-symbol - diary-bahai-entry-symbol)) + diary-bahai-entry-symbol + diary-chinese-entry-symbol)) t)) '(1 font-lock-constant-face)) '(diary-font-lock-sexps . font-lock-keyword-face) @@ -2486,11 +2376,8 @@ This depends on the calendar date style." (put-text-property (match-beginning 0) (match-end 0) 'font-lock-multiline t) t)) -(define-obsolete-variable-alias 'fancy-diary-font-lock-keywords - 'diary-fancy-font-lock-keywords "23.1") - (defvar diary-fancy-font-lock-keywords - `((diary-fancy-date-matcher . diary-face) + `((diary-fancy-date-matcher . 'diary) ("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" . 'diary-anniversary) ("^.*Yahrzeit.*$" . font-lock-constant-face) ("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face) @@ -2537,9 +2424,6 @@ Fontify the region between BEG and END, quietly unless VERBOSE is non-nil." (list (cons t diary-fancy-overriding-map))) (view-mode 1)) -(define-obsolete-function-alias 'fancy-diary-display-mode - 'diary-fancy-display-mode "23.1") - ;; Following code from Dave Love <fx@gnu.org>. ;; Import Outlook-format appointments from mail messages in Gnus or ;; Rmail using command `diary-from-outlook'. This, or the specialized diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el index 5609a0c0e0b..8085c1cf119 100644 --- a/lisp/calendar/holidays.el +++ b/lisp/calendar/holidays.el @@ -43,9 +43,6 @@ ;; explicitly load this file. ;;;###autoload -(define-obsolete-variable-alias 'general-holidays - 'holiday-general-holidays "23.1") -;;;###autoload (defcustom holiday-general-holidays (mapcar 'purecopy '((holiday-fixed 1 1 "New Year's Day") @@ -73,9 +70,6 @@ See the documentation for `calendar-holidays' for details." (put 'holiday-general-holidays 'risky-local-variable t) ;;;###autoload -(define-obsolete-variable-alias 'oriental-holidays - 'holiday-oriental-holidays "23.1") -;;;###autoload (defcustom holiday-oriental-holidays (mapcar 'purecopy '((holiday-chinese-new-year) @@ -98,8 +92,6 @@ See the documentation for `calendar-holidays' for details." (put 'holiday-oriental-holidays 'risky-local-variable t) ;;;###autoload -(define-obsolete-variable-alias 'local-holidays 'holiday-local-holidays "23.1") -;;;###autoload (defcustom holiday-local-holidays nil "Local holidays. See the documentation for `calendar-holidays' for details." @@ -109,8 +101,6 @@ See the documentation for `calendar-holidays' for details." (put 'holiday-local-holidays 'risky-local-variable t) ;;;###autoload -(define-obsolete-variable-alias 'other-holidays 'holiday-other-holidays "23.1") -;;;###autoload (defcustom holiday-other-holidays nil "User defined holidays. See the documentation for `calendar-holidays' for details." @@ -120,108 +110,6 @@ See the documentation for `calendar-holidays' for details." (put 'holiday-other-holidays 'risky-local-variable t) ;;;###autoload -(defvar hebrew-holidays-1 - (mapcar 'purecopy - '((holiday-hebrew-rosh-hashanah) - (if calendar-hebrew-all-holidays-flag - (holiday-julian - 11 - (let ((m displayed-month) - (y displayed-year) - year) - (calendar-increment-month m y -1) - (setq year (calendar-extract-year - (calendar-julian-from-absolute - (calendar-absolute-from-gregorian (list m 1 y))))) - (if (zerop (% (1+ year) 4)) - 22 - 21)) "\"Tal Umatar\" (evening)")))) - "Component of the old default value of `holiday-hebrew-holidays'.") -;;;###autoload -(put 'hebrew-holidays-1 'risky-local-variable t) -(make-obsolete-variable 'hebrew-holidays-1 'hebrew-holidays "23.1") - -;;;###autoload -(defvar hebrew-holidays-2 - (mapcar 'purecopy - '((holiday-hebrew-hanukkah) ; respects calendar-hebrew-all-holidays-flag - (if calendar-hebrew-all-holidays-flag - (holiday-hebrew - 10 - (let ((h-year (calendar-extract-year - (calendar-hebrew-from-absolute - (calendar-absolute-from-gregorian - (list displayed-month 28 displayed-year)))))) - (if (= 6 (% (calendar-hebrew-to-absolute (list 10 10 h-year)) - 7)) - 11 10)) - "Tzom Teveth")) - (if calendar-hebrew-all-holidays-flag - (holiday-hebrew 11 15 "Tu B'Shevat")))) - "Component of the old default value of `holiday-hebrew-holidays'.") -;;;###autoload -(put 'hebrew-holidays-2 'risky-local-variable t) -(make-obsolete-variable 'hebrew-holidays-2 'hebrew-holidays "23.1") - -;;;###autoload -(defvar hebrew-holidays-3 - (mapcar 'purecopy - '((if calendar-hebrew-all-holidays-flag - (holiday-hebrew - 11 - (let* ((m displayed-month) - (y displayed-year) - (h-year (progn - (calendar-increment-month m y 1) - (calendar-extract-year - (calendar-hebrew-from-absolute - (calendar-absolute-from-gregorian - (list m (calendar-last-day-of-month m y) y)))))) - (s-s - (calendar-hebrew-from-absolute - (if (= 6 - (% (calendar-hebrew-to-absolute - (list 7 1 h-year)) - 7)) - (calendar-dayname-on-or-before - 6 (calendar-hebrew-to-absolute - (list 11 17 h-year))) - (calendar-dayname-on-or-before - 6 (calendar-hebrew-to-absolute - (list 11 16 h-year)))))) - (day (calendar-extract-day s-s))) - day) - "Shabbat Shirah")))) - "Component of the old default value of `holiday-hebrew-holidays'.") -;;;###autoload -(put 'hebrew-holidays-3 'risky-local-variable t) -(make-obsolete-variable 'hebrew-holidays-3 'hebrew-holidays "23.1") - -;;;###autoload -(defvar hebrew-holidays-4 - (mapcar 'purecopy - '((holiday-hebrew-passover) - (and calendar-hebrew-all-holidays-flag - (let* ((m displayed-month) - (y displayed-year) - (year (progn - (calendar-increment-month m y -1) - (calendar-extract-year - (calendar-julian-from-absolute - (calendar-absolute-from-gregorian (list m 1 y))))))) - (= 21 (% year 28))) - (holiday-julian 3 26 "Kiddush HaHamah")) - (if calendar-hebrew-all-holidays-flag - (holiday-hebrew-tisha-b-av)))) - "Component of the old default value of `holiday-hebrew-holidays'.") -;;;###autoload -(put 'hebrew-holidays-4 'risky-local-variable t) -(make-obsolete-variable 'hebrew-holidays-4 'hebrew-holidays "23.1") - -;;;###autoload -(define-obsolete-variable-alias 'hebrew-holidays - 'holiday-hebrew-holidays "23.1") -;;;###autoload (defcustom holiday-hebrew-holidays (mapcar 'purecopy '((holiday-hebrew-passover) @@ -240,9 +128,6 @@ See the documentation for `calendar-holidays' for details." (put 'holiday-hebrew-holidays 'risky-local-variable t) ;;;###autoload -(define-obsolete-variable-alias 'christian-holidays - 'holiday-christian-holidays "23.1") -;;;###autoload (defcustom holiday-christian-holidays (mapcar 'purecopy '((holiday-easter-etc) ; respects calendar-christian-all-holidays-flag @@ -262,9 +147,6 @@ See the documentation for `calendar-holidays' for details." (put 'holiday-christian-holidays 'risky-local-variable t) ;;;###autoload -(define-obsolete-variable-alias 'islamic-holidays - 'holiday-islamic-holidays "23.1") -;;;###autoload (defcustom holiday-islamic-holidays (mapcar 'purecopy '((holiday-islamic-new-year) @@ -286,8 +168,6 @@ See the documentation for `calendar-holidays' for details." (put 'holiday-islamic-holidays 'risky-local-variable t) ;;;###autoload -(define-obsolete-variable-alias 'bahai-holidays 'holiday-bahai-holidays "23.1") -;;;###autoload (defcustom holiday-bahai-holidays (mapcar 'purecopy '((holiday-bahai-new-year) @@ -309,8 +189,6 @@ See the documentation for `calendar-holidays' for details." (put 'holiday-bahai-holidays 'risky-local-variable t) ;;;###autoload -(define-obsolete-variable-alias 'solar-holidays 'holiday-solar-holidays "23.1") -;;;###autoload (defcustom holiday-solar-holidays (mapcar 'purecopy '((solar-equinoxes-solstices) @@ -516,9 +394,6 @@ use instead of point." (message "Looking up holidays...done")) holiday-list))) -(define-obsolete-function-alias - 'list-calendar-holidays 'calendar-list-holidays "23.1") - ;;;###autoload (defun holidays (&optional arg) "Display the holidays for last month, this month, and next month. @@ -645,9 +520,6 @@ strings describing those holidays that apply on DATE, or nil if none do." (if (calendar-date-equal date (car h)) (setq holiday-list (append holiday-list (cdr h))))))) -(define-obsolete-function-alias - 'check-calendar-holidays 'calendar-check-holidays "23.1") - ;; Formerly cal-tex-list-holidays. (defun holiday-in-range (d1 d2) @@ -724,9 +596,6 @@ use instead of point." (calendar-mark-visible-date (car holiday) calendar-holiday-marker)) (message "Marking holidays...done"))) -(define-obsolete-function-alias - 'mark-calendar-holidays 'calendar-mark-holidays "23.1") - ;; Below are the functions that calculate the dates of holidays; these ;; are eval'ed in the function calendar-holiday-list. If you ;; write other such functions, be sure to imitate the style used below. @@ -813,9 +682,6 @@ HLIST is a list of elements of the form (DATE) TEXT." (and (car p) (calendar-date-is-visible-p (car p)) p)) hlist))) -(define-obsolete-function-alias - 'filter-visible-calendar-holidays 'holiday-filter-visible-calendar "23.1") - (defun holiday-sexp (sexp string) "Sexp holiday for dates in the calendar window. SEXP is an expression in variable `year' that is evaluated to diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index 638f99fd421..452a672ae3c 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -240,6 +240,55 @@ code for the event, and your personal domain name." :type 'string :group 'icalendar) +(defcustom icalendar-export-sexp-enumeration-days + 14 + "Number of days over which a sexp diary entry is enumerated. +In general sexp entries cannot be translated to icalendar format. +They are therefore enumerated, i.e. explicitly evaluated for a +certain number of days, and then exported. The enumeration starts +on the current day and continues for the number of days given here. + +See `icalendar-export-sexp-enumerate-all' for a list of sexp +entries which by default are NOT enumerated." + :version "25.1" + :type 'integer + :group 'icalendar) + +(defcustom icalendar-export-sexp-enumerate-all + nil + "Determines whether ALL sexp diary entries are enumerated. +If non-nil all sexp diary entries are enumerated for +`icalendar-export-sexp-enumeration-days' days instead of +translating into an icalendar equivalent. This affects the +following sexp diary entries: `diary-anniversary', +`diary-cyclic', `diary-date', `diary-float',`diary-block'. All +other sexp entries are enumerated in any case." + :version "25.1" + :type 'boolean + :group 'icalendar) + + +(defcustom icalendar-export-alarms + nil + "Determine if and how alarms are included in exported diary events." + :version "25.1" + :type '(choice (const :tag "Do not include alarms in export" + nil) + (list :tag "Create alarms in exported diary entries" + (integer :tag "Advance time (minutes)" + :value 10) + (set :tag "Alarm type" + (list :tag "Audio" + (const audio :tag "Audio")) + (list :tag "Display" + (const display :tag "Display")) + (list :tag "Email" + (const email) + (repeat :tag "Attendees" + (string :tag "Email")))))) + :group 'icalendar) + + (defvar icalendar-debug nil "Enable icalendar debug messages.") @@ -458,45 +507,52 @@ children." ALIST is an alist entry from a VTIMEZONE, like STANDARD. DST-P is non-nil if this is for daylight savings time. The strings are suitable for assembling into a TZ variable." - (let ((offset (car (cddr (assq 'TZOFFSETTO alist)))) - (rrule-value (car (cddr (assq 'RRULE alist)))) - (dtstart (car (cddr (assq 'DTSTART alist))))) + (let* ((offsetto (car (cddr (assq 'TZOFFSETTO alist)))) + (offsetfrom (car (cddr (assq 'TZOFFSETFROM alist)))) + (rrule-value (car (cddr (assq 'RRULE alist)))) + (dtstart (car (cddr (assq 'DTSTART alist)))) + (no-dst (equal offsetto offsetfrom))) ;; FIXME: for now we only handle RRULE and not RDATE here. - (when (and offset rrule-value dtstart) + (when (and offsetto dtstart (or rrule-value no-dst)) (let* ((rrule (icalendar--split-value rrule-value)) (freq (cadr (assq 'FREQ rrule))) (bymonth (cadr (assq 'BYMONTH rrule))) (byday (cadr (assq 'BYDAY rrule)))) ;; FIXME: we don't correctly handle WKST here. - (if (and (string= freq "YEARLY") bymonth) + (if (or no-dst (and (string= freq "YEARLY") bymonth)) (cons (concat ;; Fake a name. (if dst-p "DST" "STD") ;; For TZ, OFFSET is added to the local time. So, ;; invert the values. - (if (eq (aref offset 0) ?-) "+" "-") - (substring offset 1 3) + (if (eq (aref offsetto 0) ?-) "+" "-") + (substring offsetto 1 3) ":" - (substring offset 3 5)) + (substring offsetto 3 5)) ;; The start time. - (let* ((day (icalendar--get-weekday-number (substring byday -2))) - (week (if (eq day -1) - byday - (substring byday 0 -2)))) - ;; "Translate" the iCalendar way to specify the last - ;; (sun|mon|...)day in month to the tzset way. - (if (string= week "-1") ; last day as iCalendar calls it - (setq week "5")) ; last day as tzset calls it - (concat "M" bymonth "." week "." (if (eq day -1) "0" - (int-to-string day)) - ;; Start time. - "/" - (substring dtstart -6 -4) - ":" - (substring dtstart -4 -2) - ":" - (substring dtstart -2))))))))) + (let* ((day (if no-dst + 1 + (icalendar--get-weekday-number (substring byday -2)))) + (week (if no-dst + "1" + (if (eq day -1) + byday + (substring byday 0 -2))))) + ;; "Translate" the iCalendar way to specify the last + ;; (sun|mon|...)day in month to the tzset way. + (if (string= week "-1") ; last day as iCalendar calls it + (setq week "5")) ; last day as tzset calls it + (when no-dst (setq bymonth "1")) + (concat "M" bymonth "." week "." (if (eq day -1) "0" + (int-to-string day)) + ;; Start time. + "/" + (substring dtstart -6 -4) + ":" + (substring dtstart -4 -2) + ":" + (substring dtstart -2))))))))) (defun icalendar--parse-vtimezone (alist) "Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING). @@ -563,7 +619,12 @@ FIXME: multiple comma-separated values should be allowed!" ;; UTC specifier present (char-equal ?Z (aref isodatetimestring 15))) ;; if not UTC add current-time-zone offset - (setq second (+ (car (current-time-zone)) second))) + ;; current-time-zone should be called with actual UTC time + ;; (daylight saving at that time may differ to current one) + (setq second (+ (car (current-time-zone + (encode-time second minute hour day month year + 0))) + second))) ;; shift if necessary (if day-shift (let ((mdy (calendar-gregorian-from-absolute @@ -708,16 +769,6 @@ ISO format: (year month day)." ;; datetime == nil nil)) -(defun icalendar--date-style () - "Return current calendar date style. -Convenience function to handle transition from old -`european-calendar-style' to new `calendar-date-style'." - (if (boundp 'calendar-date-style) - calendar-date-style - (if (with-no-warnings european-calendar-style) - 'european - 'american))) - (defun icalendar--datetime-to-diary-date (datetime &optional separator) "Convert the decoded DATETIME to diary format. Optional argument SEPARATOR gives the separator between month, @@ -725,7 +776,7 @@ day, and year. If nil a blank character is used as separator. Call icalendar--datetime-to-*-date according to the current calendar date style." (funcall (intern-soft (format "icalendar--datetime-to-%s-date" - (icalendar--date-style))) + calendar-date-style)) datetime separator)) (defun icalendar--datetime-to-colontime (datetime) @@ -835,7 +886,7 @@ is not possible it uses the current calendar date style." (match-end 2)))) (setq year (read (substring datestring (match-beginning 3) (match-end 3)))) - (if (eq (icalendar--date-style) 'american) + (if (eq calendar-date-style 'american) (let ((x month)) (setq month day) (setq day x)))) @@ -891,10 +942,16 @@ is not possible it uses the current calendar date style." (defun icalendar--diarytime-to-isotime (timestring ampmstring) "Convert a time like 9:30pm to an iso-conform string like T213000. -In this example the TIMESTRING would be \"9:30\" and the AMPMSTRING -would be \"pm\"." +In this example the TIMESTRING would be \"9:30\" and the +AMPMSTRING would be \"pm\". The minutes may be missing as long +as the colon is missing as well, i.e. \"9\" is allowed as +TIMESTRING and has the same result as \"9:00\"." (if timestring - (let ((starttimenum (read (icalendar--rris ":" "" timestring)))) + (let* ((parts (save-match-data (split-string timestring ":"))) + (h (car parts)) + (m (if (cdr parts) (cadr parts) + (if (> (length h) 2) "" "00"))) + (starttimenum (read (concat h m)))) ;; take care of am/pm style ;; Be sure *not* to convert 12:00pm - 12:59pm to 2400-2459 (if (and ampmstring (string= "pm" ampmstring) (< starttimenum 1200)) @@ -991,10 +1048,12 @@ FExport diary data into iCalendar file: ") (header "") (contents-n-summary) (contents) + (alarm) (found-error nil) (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol) "?")) - (other-elements nil)) + (other-elements nil) + (cns-cons-or-list nil)) ;; prepare buffer with error messages (save-current-buffer (set-buffer (get-buffer-create "*icalendar-errors*")) @@ -1016,40 +1075,50 @@ FExport diary data into iCalendar file: ") (condition-case error-val (progn - (setq contents-n-summary + (setq cns-cons-or-list (icalendar--convert-to-ical nonmarker entry-main)) (setq other-elements (icalendar--parse-summary-and-rest entry-full)) - (setq contents (concat (car contents-n-summary) - "\nSUMMARY:" (cadr contents-n-summary))) - (let ((cla (cdr (assoc 'cla other-elements))) - (des (cdr (assoc 'des other-elements))) - (loc (cdr (assoc 'loc other-elements))) - (org (cdr (assoc 'org other-elements))) - (sta (cdr (assoc 'sta other-elements))) - (sum (cdr (assoc 'sum other-elements))) - (url (cdr (assoc 'url other-elements))) - (uid (cdr (assoc 'uid other-elements)))) - (if cla - (setq contents (concat contents "\nCLASS:" cla))) - (if des - (setq contents (concat contents "\nDESCRIPTION:" des))) - (if loc - (setq contents (concat contents "\nLOCATION:" loc))) - (if org - (setq contents (concat contents "\nORGANIZER:" org))) - (if sta - (setq contents (concat contents "\nSTATUS:" sta))) - ;;(if sum - ;; (setq contents (concat contents "\nSUMMARY:" sum))) - (if url - (setq contents (concat contents "\nURL:" url))) - - (setq header (concat "\nBEGIN:VEVENT\nUID:" - (or uid - (icalendar--create-uid entry-full - contents))))) - (setq result (concat result header contents "\nEND:VEVENT"))) + (mapc (lambda (contents-n-summary) + (setq contents (concat (car contents-n-summary) + "\nSUMMARY:" + (cdr contents-n-summary))) + (let ((cla (cdr (assoc 'cla other-elements))) + (des (cdr (assoc 'des other-elements))) + (loc (cdr (assoc 'loc other-elements))) + (org (cdr (assoc 'org other-elements))) + (sta (cdr (assoc 'sta other-elements))) + (sum (cdr (assoc 'sum other-elements))) + (url (cdr (assoc 'url other-elements))) + (uid (cdr (assoc 'uid other-elements)))) + (if cla + (setq contents (concat contents "\nCLASS:" cla))) + (if des + (setq contents (concat contents "\nDESCRIPTION:" + des))) + (if loc + (setq contents (concat contents "\nLOCATION:" loc))) + (if org + (setq contents (concat contents "\nORGANIZER:" + org))) + (if sta + (setq contents (concat contents "\nSTATUS:" sta))) + ;;(if sum + ;; (setq contents (concat contents "\nSUMMARY:" sum))) + (if url + (setq contents (concat contents "\nURL:" url))) + + (setq header (concat "\nBEGIN:VEVENT\nUID:" + (or uid + (icalendar--create-uid + entry-full contents)))) + (setq alarm (icalendar--create-ical-alarm + (cdr contents-n-summary)))) + (setq result (concat result header contents alarm + "\nEND:VEVENT"))) + (if (consp cns-cons-or-list) + (list cns-cons-or-list) + cns-cons-or-list))) ;; handle errors (error (setq found-error t) @@ -1081,16 +1150,18 @@ FExport diary data into iCalendar file: ") NONMARKER is a regular expression matching the start of non-marking entries. ENTRY-MAIN is the first line of the diary entry." (or - ;; anniversaries -- %%(diary-anniversary ...) - (icalendar--convert-anniversary-to-ical nonmarker entry-main) - ;; cyclic events -- %%(diary-cyclic ...) - (icalendar--convert-cyclic-to-ical nonmarker entry-main) - ;; diary-date -- %%(diary-date ...) - (icalendar--convert-date-to-ical nonmarker entry-main) - ;; float events -- %%(diary-float ...) - (icalendar--convert-float-to-ical nonmarker entry-main) - ;; block events -- %%(diary-block ...) - (icalendar--convert-block-to-ical nonmarker entry-main) + (unless icalendar-export-sexp-enumerate-all + (or + ;; anniversaries -- %%(diary-anniversary ...) + (icalendar--convert-anniversary-to-ical nonmarker entry-main) + ;; cyclic events -- %%(diary-cyclic ...) + (icalendar--convert-cyclic-to-ical nonmarker entry-main) + ;; diary-date -- %%(diary-date ...) + (icalendar--convert-date-to-ical nonmarker entry-main) + ;; float events -- %%(diary-float ...) + (icalendar--convert-float-to-ical nonmarker entry-main) + ;; block events -- %%(diary-block ...) + (icalendar--convert-block-to-ical nonmarker entry-main))) ;; other sexp diary entries (icalendar--convert-sexp-to-ical nonmarker entry-main) ;; weekly by day -- Monday 8:30 Team meeting @@ -1218,6 +1289,43 @@ Returns an alist." (if url (cons 'url url) nil) (if uid (cons 'uid uid) nil)))))))) +(defun icalendar--create-ical-alarm (summary) + "Return VALARM blocks for the given SUMMARY." + (when icalendar-export-alarms + (let* ((advance-time (car icalendar-export-alarms)) + (alarm-specs (cadr icalendar-export-alarms)) + (fun (lambda (spec) + (icalendar--do-create-ical-alarm advance-time spec summary)))) + (mapconcat fun alarm-specs "")))) + +(defun icalendar--do-create-ical-alarm (advance-time alarm-spec summary) + "Return a VALARM block. +Argument ADVANCE-TIME is a number giving the time when the alarm +fires (minutes before the respective event). Argument ALARM-SPEC +is a list which must be one of '(audio), '(display) or +'(email (ADDRESS1 ...)), see `icalendar-export-alarms'. Argument +SUMMARY is a string which contains a short description for the +alarm." + (let* ((action (car alarm-spec)) + (act (format "\nACTION:%s" + (cdr (assoc action '((audio . "AUDIO") + (display . "DISPLAY") + (email . "EMAIL")))))) + (tri (format "\nTRIGGER:-PT%dM" advance-time)) + (des (if (memq action '(display email)) + (format "\nDESCRIPTION:%s" summary) + "")) + (sum (if (eq action 'email) + (format "\nSUMMARY:%s" summary) + "")) + (att (if (eq action 'email) + (mapconcat (lambda (i) + (format "\nATTENDEE:MAILTO:%s" i)) + (cadr alarm-spec) "") + ""))) + + (concat "\nBEGIN:VALARM" act tri des sum att "\nEND:VALARM"))) + ;; subroutines for icalendar-export-region (defun icalendar--convert-ordinary-to-ical (nonmarker entry-main) "Convert \"ordinary\" diary entry to iCalendar format. @@ -1226,9 +1334,9 @@ entries. ENTRY-MAIN is the first line of the diary entry." (if (string-match (concat nonmarker "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-*" ; date - "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" ; start time + "\\(\\([0-9][0-9]?\\(:[0-9][0-9]\\)?\\)\\([ap]m\\)?" ; start time "\\(" - "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" ; end time + "-\\([0-9][0-9]?\\(:[0-9][0-9]\\)?\\)\\([ap]m\\)?\\)?" ; end time "\\)?" "\\s-*\\(.*?\\) ?$") entry-main) @@ -1245,25 +1353,25 @@ entries. ENTRY-MAIN is the first line of the diary entry." (match-beginning 3) (match-end 3)) nil) - (if (match-beginning 4) + (if (match-beginning 5) (substring entry-main - (match-beginning 4) - (match-end 4)) + (match-beginning 5) + (match-end 5)) nil))) (endtimestring (icalendar--diarytime-to-isotime - (if (match-beginning 6) - (substring entry-main - (match-beginning 6) - (match-end 6)) - nil) (if (match-beginning 7) (substring entry-main (match-beginning 7) (match-end 7)) + nil) + (if (match-beginning 9) + (substring entry-main + (match-beginning 9) + (match-end 9)) nil))) (summary (icalendar--convert-string-for-export - (substring entry-main (match-beginning 8) - (match-end 8))))) + (substring entry-main (match-beginning 10) + (match-end 10))))) (icalendar--dmsg "ordinary %s" entry-main) (unless startisostring @@ -1289,7 +1397,7 @@ entries. ENTRY-MAIN is the first line of the diary entry." (- time 230000))) (setq endisostring1 endisostring)) ))) - (list (concat "\nDTSTART;" + (cons (concat "\nDTSTART;" (if starttimestring "VALUE=DATE-TIME:" "VALUE=DATE:") startisostring @@ -1370,7 +1478,7 @@ entries. ENTRY-MAIN is the first line of the diary entry." starttimestring)))) (setq endtimestring (format "T%06d" (+ 10000 time)))))) - (list (concat "\nDTSTART;" + (cons (concat "\nDTSTART;" (if starttimestring "VALUE=DATE-TIME:" "VALUE=DATE:") @@ -1403,7 +1511,7 @@ entries. ENTRY-MAIN is the first line of the diary entry." NONMARKER is a regular expression matching the start of non-marking entries. ENTRY-MAIN is the first line of the diary entry." (if (string-match (concat nonmarker - (if (eq (icalendar--date-style) 'european) + (if (eq calendar-date-style 'european) "\\([0-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+" "\\([a-z]+\\)\\s-+\\([0-9]+[0-9]?\\)\\s-+") "\\*?\\s-*" @@ -1414,8 +1522,8 @@ entries. ENTRY-MAIN is the first line of the diary entry." "\\s-*\\([^0-9]+.*?\\) ?$" ; must not match years ) entry-main) - (let* ((daypos (if (eq (icalendar--date-style) 'european) 1 2)) - (monpos (if (eq (icalendar--date-style) 'european) 2 1)) + (let* ((daypos (if (eq calendar-date-style 'european) 1 2)) + (monpos (if (eq calendar-date-style 'european) 2 1)) (day (read (substring entry-main (match-beginning daypos) (match-end daypos)))) @@ -1457,7 +1565,7 @@ entries. ENTRY-MAIN is the first line of the diary entry." starttimestring)))) (setq endtimestring (format "T%06d" (+ 10000 time)))))) - (list (concat "\nDTSTART;" + (cons (concat "\nDTSTART;" (if starttimestring "VALUE=DATE-TIME:" "VALUE=DATE:") (format "1900%02d%02d" month day) @@ -1478,13 +1586,16 @@ entries. ENTRY-MAIN is the first line of the diary entry." ;; no match nil)) -(defun icalendar--convert-sexp-to-ical (nonmarker entry-main) - "Convert complex sexp diary entry to iCalendar format -- unsupported! - -FIXME! +(defun icalendar--convert-sexp-to-ical (nonmarker entry-main &optional start) + "Convert sexp diary entry to iCalendar format. +Enumerate the evaluated sexp entry for the next +`icalendar-export-sexp-enumeration-days' days. NONMARKER is a +regular expression matching the start of non-marking entries. +ENTRY-MAIN is the first line of the diary entry. -NONMARKER is a regular expression matching the start of non-marking -entries. ENTRY-MAIN is the first line of the diary entry." +Optional argument START determines the first day of the +enumeration, given as a time value, in same format as returned by +`current-time' -- used for test purposes." (cond ((string-match (concat nonmarker "%%(and \\(([^)]+)\\))\\(\\s-*.*?\\) ?$") entry-main) @@ -1497,10 +1608,37 @@ entries. ENTRY-MAIN is the first line of the diary entry." (substring entry-main (match-beginning 1) (match-end 1)) (substring entry-main (match-beginning 2) (match-end 2))))) ((string-match (concat nonmarker - "%%([^)]+)\\s-*.*") + "%%\\(([^)]+)\\)\\s-*\\(.*\\)") entry-main) + ;; regular sexp entry (icalendar--dmsg "diary-sexp %s" entry-main) - (error "Sexp-entries are not supported yet")) + (let ((p1 (substring entry-main (match-beginning 1) (match-end 1))) + (p2 (substring entry-main (match-beginning 2) (match-end 2))) + (now (or start (current-time)))) + (delete nil + (mapcar + (lambda (offset) + (let* ((day (decode-time (time-add now + (seconds-to-time + (* offset 60 60 24))))) + (d (nth 3 day)) + (m (nth 4 day)) + (y (nth 5 day)) + (se (diary-sexp-entry p1 p2 (list m d y))) + (see (cond ((stringp se) se) + ((consp se) (cdr se)) + (t nil)))) + (cond ((null see) + nil) + ((stringp see) + (let ((calendar-date-style 'iso)) + (icalendar--convert-ordinary-to-ical + nonmarker (format "%4d/%02d/%02d %s" y m d see)))) + (;TODO: + (error (format "Unsupported Sexp-entry: %s" + entry-main)))))) + (number-sequence + 0 (- icalendar-export-sexp-enumeration-days 1)))))) (t ;; no match nil))) @@ -1565,7 +1703,7 @@ entries. ENTRY-MAIN is the first line of the diary entry." (+ 10000 time)))))) (if starttimestring ;; with time -> write rrule - (list (concat "\nDTSTART;VALUE=DATE-TIME:" + (cons (concat "\nDTSTART;VALUE=DATE-TIME:" startisostring starttimestring "\nDTEND;VALUE=DATE-TIME:" @@ -1575,7 +1713,7 @@ entries. ENTRY-MAIN is the first line of the diary entry." endisostring) summary) ;; no time -> write long event - (list (concat "\nDTSTART;VALUE=DATE:" startisostring + (cons (concat "\nDTSTART;VALUE=DATE:" startisostring "\nDTEND;VALUE=DATE:" endisostring+1) summary))) ;; no match @@ -1611,10 +1749,10 @@ entries. ENTRY-MAIN is the first line of the diary entry." (icalendar--dmsg "diary-float %s" entry-main) (error "Don't know if or how to implement day in `diary-float'"))) - (list (concat + (cons (concat ;;Start today (yes this is an arbitrary choice): "\nDTSTART;VALUE=DATE:" - (format-time-string "%Y%m%d" (current-time)) + (format-time-string "%Y%m%d") ;;BUT remove today if `diary-float' ;;expression does not hold true for today: (when @@ -1623,7 +1761,7 @@ entries. ENTRY-MAIN is the first line of the diary entry." (diary-float month dayname n))) (concat "\nEXDATE;VALUE=DATE:" - (format-time-string "%Y%m%d" (current-time)))) + (format-time-string "%Y%m%d"))) "\nRRULE:" (if (or (numberp month) (listp month)) "FREQ=YEARLY;BYMONTH=" @@ -1716,7 +1854,7 @@ entries. ENTRY-MAIN is the first line of the diary entry." starttimestring)))) (setq endtimestring (format "T%06d" (+ 10000 time)))))) - (list (concat "\nDTSTART;" + (cons (concat "\nDTSTART;" (if starttimestring "VALUE=DATE-TIME:" "VALUE=DATE:") startisostring @@ -1785,7 +1923,7 @@ entries. ENTRY-MAIN is the first line of the diary entry." starttimestring)))) (setq endtimestring (format "T%06d" (+ 10000 time)))))) - (list (concat "\nDTSTART;" + (cons (concat "\nDTSTART;" (if starttimestring "VALUE=DATE-TIME:" "VALUE=DATE:") startisostring @@ -2222,11 +2360,11 @@ END-T is the event's end time in diary format." (let ((day (nth 3 dtstart-dec)) (month (nth 4 dtstart-dec))) (setq result (concat "%%(and (diary-date " - (cond ((eq (icalendar--date-style) 'iso) + (cond ((eq calendar-date-style 'iso) (format "t %d %d" month day)) - ((eq (icalendar--date-style) 'european) + ((eq calendar-date-style 'european) (format "%d %d t" day month)) - ((eq (icalendar--date-style) 'american) + ((eq calendar-date-style 'american) (format "%d %d t" month day))) ") (diary-block " dtstart-conv @@ -2248,16 +2386,16 @@ END-T is the event's end time in diary format." (format "%%%%(and (diary-date %s) (diary-block %s %s)) %s%s%s" (let ((day (nth 3 dtstart-dec))) - (cond ((eq (icalendar--date-style) 'iso) + (cond ((eq calendar-date-style 'iso) (format "t t %d" day)) - ((eq (icalendar--date-style) 'european) + ((eq calendar-date-style 'european) (format "%d t t" day)) - ((eq (icalendar--date-style) 'american) + ((eq calendar-date-style 'american) (format "t %d t" day)))) dtstart-conv (if until until-conv - (if (eq (icalendar--date-style) 'iso) "9999 1 1" "1 1 9999")) ;; FIXME: should be unlimited + (if (eq calendar-date-style 'iso) "9999 1 1" "1 1 9999")) ;; FIXME: should be unlimited (or start-t "") (if end-t "-" "") (or end-t "")))) ;; daily diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el index 5250ee13bb3..1e0be16e71c 100644 --- a/lisp/calendar/lunar.el +++ b/lisp/calendar/lunar.el @@ -228,10 +228,6 @@ use instead of point." (lunar-phase-list m1 y1) "\n"))) (message "Computing phases of the moon...done")))) -;;;###cal-autoload -(define-obsolete-function-alias 'calendar-phases-of-moon - 'calendar-lunar-phases "23.1") - ;;;###autoload (defun lunar-phases (&optional arg) "Display the quarters of the moon for last month, this month, and next month. @@ -245,9 +241,6 @@ This function is suitable for execution in an init file." (displayed-year (calendar-extract-year date))) (calendar-lunar-phases)))) -;;;###autoload -(define-obsolete-function-alias 'phases-of-moon 'lunar-phases "23.1") - (defvar date) ;; To be called from diary-list-sexp-entries, where DATE is bound. @@ -266,10 +259,6 @@ use when highlighting the day in the calendar." (cons mark (concat (lunar-phase-name (nth 2 phase)) " " (cadr phase)))))) -;;;###diary-autoload -(define-obsolete-function-alias 'diary-phases-of-moon - 'diary-lunar-phases "23.1") - ;; For the Chinese calendar the calculations for the new moon need to be more ;; accurate than those above, so we use more terms in the approximation. (defun lunar-new-moon-time (k) diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index 503e6327c8b..b2b065ab65e 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -34,21 +34,12 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - -(defvar parse-time-digits (make-vector 256 nil)) +(require 'cl-lib) ;; Byte-compiler warnings (defvar parse-time-elt) (defvar parse-time-val) -(unless (aref parse-time-digits ?0) - (cl-loop for i from ?0 to ?9 - do (aset parse-time-digits i (- i ?0)))) - -(defsubst digit-char-p (char) - (aref parse-time-digits char)) - (defsubst parse-time-string-chars (char) (save-match-data (let (case-fold-search str) @@ -59,30 +50,6 @@ ((string-match "[[:lower:]]" str) ?a) ((string-match "[[:digit:]]" str) ?0))))) -(put 'parse-error 'error-conditions '(parse-error error)) -(put 'parse-error 'error-message "Parsing error") - -(defsubst parse-integer (string &optional start end) - "[CL] Parse and return the integer in STRING, or nil if none." - (let ((integer 0) - (digit 0) - (index (or start 0)) - (end (or end (length string)))) - (when (< index end) - (let ((sign (aref string index))) - (if (or (eq sign ?+) (eq sign ?-)) - (setq sign (parse-time-string-chars sign) - index (1+ index)) - (setq sign 1)) - (while (and (< index end) - (setq digit (digit-char-p (aref string index)))) - (setq integer (+ (* integer 10) digit) - index (1+ index))) - (if (/= index end) - (signal 'parse-error `("not an integer" - ,(substring string (or start 0) end))) - (* sign integer)))))) - (defun parse-time-tokenize (string) "Tokenize STRING into substrings." (let ((start nil) @@ -100,7 +67,7 @@ (setq c (parse-time-string-chars (aref string index)))) (setq all-digits (and all-digits (eq c ?0)))) (if (<= index end) - (push (if all-digits (parse-integer string start index) + (push (if all-digits (cl-parse-integer string :start start :end index) (substring string start index)) list))) (nreverse list))) @@ -131,7 +98,7 @@ `(((6) parse-time-weekdays) ((3) (1 31)) ((4) parse-time-months) - ((5) (100 4038)) + ((5) (100 ,most-positive-fixnum)) ((2 1 0) ,#'(lambda () (and (stringp parse-time-elt) (= (length parse-time-elt) 8) @@ -147,8 +114,8 @@ (= 5 (length parse-time-elt)) (or (= (aref parse-time-elt 0) ?+) (= (aref parse-time-elt 0) ?-)))) - ,#'(lambda () (* 60 (+ (parse-integer parse-time-elt 3 5) - (* 60 (parse-integer parse-time-elt 1 3))) + ,#'(lambda () (* 60 (+ (cl-parse-integer parse-time-elt :start 3 :end 5) + (* 60 (cl-parse-integer parse-time-elt :start 1 :end 3))) (if (= (aref parse-time-elt 0) ?-) -1 1)))) ((5 4 3) ,#'(lambda () (and (stringp parse-time-elt) @@ -210,14 +177,77 @@ unknown are returned as nil." (let ((new-val (if rule (let ((this (pop rule))) (if (vectorp this) - (parse-integer + (cl-parse-integer parse-time-elt - (aref this 0) (aref this 1)) + :start (aref this 0) + :end (aref this 1)) (funcall this))) parse-time-val))) (rplaca (nthcdr (pop slots) time) new-val)))))))) time)) +(defconst parse-time-iso8601-regexp + (let* ((dash "-?") + (colon ":?") + (4digit "\\([0-9][0-9][0-9][0-9]\\)") + (2digit "\\([0-9][0-9]\\)") + (date-fullyear 4digit) + (date-month 2digit) + (date-mday 2digit) + (time-hour 2digit) + (time-minute 2digit) + (time-second 2digit) + (time-secfrac "\\(\\.[0-9]+\\)?") + (time-numoffset (concat "[-+]\\(" time-hour "\\):" time-minute)) + (time-offset (concat "Z" time-numoffset)) + (partial-time (concat time-hour colon time-minute colon time-second + time-secfrac)) + (full-date (concat date-fullyear dash date-month dash date-mday)) + (full-time (concat partial-time time-offset)) + (date-time (concat full-date "T" full-time))) + (list (concat "^" full-date) + (concat "T" partial-time) + (concat "Z" time-numoffset))) + "List of regular expressions matching ISO 8601 dates. +1st regular expression matches the date. +2nd regular expression matches the time. +3rd regular expression matches the (optional) timezone specification.") + +(defun parse-iso8601-time-string (date-string) + (let* ((date-re (nth 0 parse-time-iso8601-regexp)) + (time-re (nth 1 parse-time-iso8601-regexp)) + (tz-re (nth 2 parse-time-iso8601-regexp)) + re-start + time seconds minute hour fractional-seconds + day month year day-of-week dst tz) + ;; We need to populate 'time' with + ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ) + + ;; Nobody else handles iso8601 correctly, let's do it ourselves. + (when (string-match date-re date-string re-start) + (setq year (string-to-number (match-string 1 date-string)) + month (string-to-number (match-string 2 date-string)) + day (string-to-number (match-string 3 date-string)) + re-start (match-end 0)) + (when (string-match time-re date-string re-start) + (setq hour (string-to-number (match-string 1 date-string)) + minute (string-to-number (match-string 2 date-string)) + seconds (string-to-number (match-string 3 date-string)) + fractional-seconds (string-to-number (or + (match-string 4 date-string) + "0")) + re-start (match-end 0)) + (when (string-match tz-re date-string re-start) + (setq tz (match-string 1 date-string))) + (setq time (list seconds minute hour day month year day-of-week dst tz)))) + + ;; Fall back to having Gnus do fancy things for us. + (when (not time) + (setq time (parse-time-string date-string))) + + (and time + (apply 'encode-time time)))) + (provide 'parse-time) ;;; parse-time.el ends here diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 5ba0d083358..bb7e97ea7f3 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -30,10 +30,9 @@ ;; value equal to HIGH * 2^16 + LOW + USEC * 10^-6 + PSEC * 10^-12 ;; seconds, where missing components are treated as zero. HIGH can be ;; negative, either because the value is a time difference, or because -;; the machine supports negative time stamps that fall before the epoch. -;; The macro `with-decoded-time-value' and the function -;; `encode-time-value' make it easier to deal with these formats. -;; See `time-subtract' for an example of how to use them. +;; it represents a time stamp before the epoch. Typically, there are +;; more time values than the underlying system time type supports, +;; but the reverse can also be true. ;;; Code: @@ -44,7 +43,7 @@ The value of the last form in BODY is returned. Each element of the list VARLIST is a list of the form \(HIGH-SYMBOL LOW-SYMBOL MICRO-SYMBOL [PICO-SYMBOL [TYPE-SYMBOL]] TIME-VALUE). -The time value TIME-VALUE is decoded and the result it bound to +The time value TIME-VALUE is decoded and the result is bound to the symbols HIGH-SYMBOL, LOW-SYMBOL and MICRO-SYMBOL. The optional PICO-SYMBOL is bound to the picoseconds part. @@ -66,7 +65,32 @@ list (HIGH LOW MICRO PICO)." (pop elt))) (time-value (car elt)) (gensym (make-symbol "time"))) - `(let* ,(append `((,gensym ,time-value) + `(let* ,(append `((,gensym (or ,time-value (current-time))) + (,gensym + (cond + ((integerp ,gensym) + (list (ash ,gensym -16) + (logand ,gensym 65535))) + ((floatp ,gensym) + (let* ((usec (* 1000000 (mod ,gensym 1))) + (ps (round (* 1000000 (mod usec 1)))) + (us (floor usec)) + (lo (floor (mod ,gensym 65536))) + (hi (floor ,gensym 65536))) + (if (eq ps 1000000) + (progn + (setq ps 0) + (setq us (1+ us)) + (if (eq us 1000000) + (progn + (setq us 0) + (setq lo (1+ lo)) + (if (eq lo 65536) + (progn + (setq lo 0) + (setq hi (1+ hi)))))))) + (list hi lo us ps))) + (t ,gensym))) (,high (pop ,gensym)) ,low ,micro) (when pico `(,pico)) @@ -108,6 +132,10 @@ it is assumed that PICO was omitted and should be treated as zero." ((eq type 3) (list high low micro pico)) ((null type) (encode-time-value high low micro 0 pico)))) +(when (and (fboundp 'time-add) (subrp (symbol-function 'time-add))) + (make-obsolete 'encode-time-value nil "25.1") + (make-obsolete 'with-decoded-time-value nil "25.1")) + (autoload 'parse-time-string "parse-time") (autoload 'timezone-make-date-arpa-standard "timezone") @@ -119,13 +147,20 @@ it is assumed that PICO was omitted and should be treated as zero." (defun date-to-time (date) "Parse a string DATE that represents a date-time and return a time value. If DATE lacks timezone information, GMT is assumed." - (condition-case () + (condition-case err (apply 'encode-time (parse-time-string date)) - (error (condition-case () - (apply 'encode-time - (parse-time-string - (timezone-make-date-arpa-standard date))) - (error (error "Invalid date: %s" date)))))) + (error + (let ((overflow-error '(error "Specified time is not representable"))) + (if (equal err overflow-error) + (apply 'signal err) + (condition-case err + (apply 'encode-time + (parse-time-string + (timezone-make-date-arpa-standard date))) + (error + (if (equal err overflow-error) + (apply 'signal err) + (error "Invalid date: %s" date))))))))) ;; Bit of a mess. Emacs has float-time since at least 21.1. ;; This file is synced to Gnus, and XEmacs packages may have been written @@ -140,56 +175,28 @@ If DATE lacks timezone information, GMT is assumed." (or (featurep 'emacs) (and (fboundp 'float-time) (subrp (symbol-function 'float-time))) - (defun time-to-seconds (time) - "Convert time value TIME to a floating point number." - (with-decoded-time-value ((high low micro pico type time)) - (+ (* 1.0 high 65536) + (defun time-to-seconds (&optional time) + "Convert optional value TIME to a floating point number. +TIME defaults to the current time." + (with-decoded-time-value ((high low micro pico type + (or time (current-time)))) + (+ (* high 65536.0) low (/ (+ (* micro 1e6) pico) 1e12)))))) ;;;###autoload (defun seconds-to-time (seconds) - "Convert SECONDS (a floating point number) to a time value." - (let* ((usec (* 1000000 (mod seconds 1))) - (ps (round (* 1000000 (mod usec 1)))) - (us (floor usec)) - (lo (floor (mod seconds 65536))) - (hi (floor seconds 65536))) - (if (eq ps 1000000) - (progn - (setq ps 0) - (setq us (1+ us)) - (if (eq us 1000000) - (progn - (setq us 0) - (setq lo (1+ lo)) - (if (eq lo 65536) - (progn - (setq lo 0) - (setq hi (1+ hi)))))))) - (list hi lo us ps))) - -;;;###autoload -(defun time-less-p (t1 t2) - "Return non-nil if time value T1 is earlier than time value T2." - (with-decoded-time-value ((high1 low1 micro1 pico1 type1 t1) - (high2 low2 micro2 pico2 type2 t2)) - (or (< high1 high2) - (and (= high1 high2) - (or (< low1 low2) - (and (= low1 low2) - (or (< micro1 micro2) - (and (= micro1 micro2) - (< pico1 pico2))))))))) + "Convert SECONDS to a time value." + (time-add 0 seconds)) ;;;###autoload (defun days-to-time (days) "Convert DAYS into a time value." - (let* ((seconds (* 1.0 days 60 60 24)) - (high (condition-case nil (floor (/ seconds 65536)) - (range-error most-positive-fixnum)))) - (list high (condition-case nil (floor (- seconds (* 1.0 high 65536))) - (range-error 65535))))) + (let ((time (condition-case nil (seconds-to-time (* 86400.0 days)) + (range-error (list most-positive-fixnum 65535))))) + (if (integerp days) + (setcdr (cdr time) nil)) + time)) ;;;###autoload (defun time-since (time) @@ -198,53 +205,71 @@ TIME should be either a time value or a date-time string." (when (stringp time) ;; Convert date strings to internal time. (setq time (date-to-time time))) - (time-subtract (current-time) time)) + (time-subtract nil time)) ;;;###autoload (defalias 'subtract-time 'time-subtract) -;;;###autoload -(defun time-subtract (t1 t2) - "Subtract two time values, T1 minus T2. +;; These autoloads do nothing in Emacs 25, where the functions are builtin. +;;;###autoload(autoload 'time-add "time-date") +;;;###autoload(autoload 'time-subtract "time-date") +;;;###autoload(autoload 'time-less-p "time-date") + +(eval-and-compile + (when (not (and (fboundp 'time-add) (subrp (symbol-function 'time-add)))) + + (defun time-add (t1 t2) + "Add two time values T1 and T2. One should represent a time difference." + (with-decoded-time-value ((high low micro pico type t1) + (high2 low2 micro2 pico2 type2 t2)) + (setq high (+ high high2) + low (+ low low2) + micro (+ micro micro2) + pico (+ pico pico2) + type (max type type2)) + (when (>= pico 1000000) + (setq micro (1+ micro) + pico (- pico 1000000))) + (when (>= micro 1000000) + (setq low (1+ low) + micro (- micro 1000000))) + (when (>= low 65536) + (setq high (1+ high) + low (- low 65536))) + (encode-time-value high low micro pico type))) + + (defun time-subtract (t1 t2) + "Subtract two time values, T1 minus T2. Return the difference in the format of a time value." - (with-decoded-time-value ((high low micro pico type t1) - (high2 low2 micro2 pico2 type2 t2)) - (setq high (- high high2) - low (- low low2) - micro (- micro micro2) - pico (- pico pico2) - type (max type type2)) - (when (< pico 0) - (setq micro (1- micro) - pico (+ pico 1000000))) - (when (< micro 0) - (setq low (1- low) - micro (+ micro 1000000))) - (when (< low 0) - (setq high (1- high) - low (+ low 65536))) - (encode-time-value high low micro pico type))) - -;;;###autoload -(defun time-add (t1 t2) - "Add two time values T1 and T2. One should represent a time difference." - (with-decoded-time-value ((high low micro pico type t1) - (high2 low2 micro2 pico2 type2 t2)) - (setq high (+ high high2) - low (+ low low2) - micro (+ micro micro2) - pico (+ pico pico2) - type (max type type2)) - (when (>= pico 1000000) - (setq micro (1+ micro) - pico (- pico 1000000))) - (when (>= micro 1000000) - (setq low (1+ low) - micro (- micro 1000000))) - (when (>= low 65536) - (setq high (1+ high) - low (- low 65536))) - (encode-time-value high low micro pico type))) + (with-decoded-time-value ((high low micro pico type t1) + (high2 low2 micro2 pico2 type2 t2)) + (setq high (- high high2) + low (- low low2) + micro (- micro micro2) + pico (- pico pico2) + type (max type type2)) + (when (< pico 0) + (setq micro (1- micro) + pico (+ pico 1000000))) + (when (< micro 0) + (setq low (1- low) + micro (+ micro 1000000))) + (when (< low 0) + (setq high (1- high) + low (+ low 65536))) + (encode-time-value high low micro pico type))) + + (defun time-less-p (t1 t2) + "Return non-nil if time value T1 is earlier than time value T2." + (with-decoded-time-value ((high1 low1 micro1 pico1 type1 t1) + (high2 low2 micro2 pico2 type2 t2)) + (or (< high1 high2) + (and (= high1 high2) + (or (< low1 low2) + (and (= low1 low2) + (or (< micro1 micro2) + (and (= micro1 micro2) + (< pico1 pico2))))))))))) ;;;###autoload (defun date-to-day (date) @@ -265,11 +290,9 @@ DATE1 and DATE2 should be date-time strings." (not (zerop (% year 100)))) (zerop (% year 400)))) -;;;###autoload -(defun time-to-day-in-year (time) - "Return the day number within the year corresponding to TIME." - (let* ((tim (decode-time time)) - (month (nth 4 tim)) +(defun time-date--day-in-year (tim) + "Return the day number within the year corresponding to the decoded time TIM." + (let* ((month (nth 4 tim)) (day (nth 3 tim)) (year (nth 5 tim)) (day-of-year (+ day (* 31 (1- month))))) @@ -280,13 +303,18 @@ DATE1 and DATE2 should be date-time strings." day-of-year)) ;;;###autoload +(defun time-to-day-in-year (time) + "Return the day number within the year corresponding to TIME." + (time-date--day-in-year (decode-time time))) + +;;;###autoload (defun time-to-days (time) "The number of days between the Gregorian date 0001-12-31bce and TIME. TIME should be a time value. The Gregorian date Sunday, December 31, 1bce is imaginary." (let* ((tim (decode-time time)) (year (nth 5 tim))) - (+ (time-to-day-in-year time) ; Days this year + (+ (time-date--day-in-year tim) ; Days this year (* 365 (1- year)) ; + Days in prior years (/ (1- year) 4) ; + Julian leap years (- (/ (1- year) 100)) ; - century years @@ -388,6 +416,23 @@ This function does not work for SECONDS greater than `most-positive-fixnum'." t t string)))))) (replace-regexp-in-string "%%" "%" string)) +(defvar seconds-to-string + (list (list 1 "ms" 0.001) + (list 100 "s" 1) + (list (* 60 100) "m" 60.0) + (list (* 3600 30) "h" 3600.0) + (list (* 3600 24 400) "d" (* 3600.0 24.0)) + (list nil "y" (* 365.25 24 3600))) + "Formatting used by the function `seconds-to-string'.") +;;;###autoload +(defun seconds-to-string (delay) + "Convert the time interval in seconds to a short string." + (cond ((> 0 delay) (concat "-" (seconds-to-string (- delay)))) + ((= 0 delay) "0s") + (t (let ((sts seconds-to-string) here) + (while (and (car (setq here (pop sts))) + (<= (car here) delay))) + (concat (format "%.2f" (/ delay (car (cddr here)))) (cadr here)))))) (provide 'time-date) diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index f1b53c51e7d..cd79781fbd6 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -320,7 +320,7 @@ display (non-nil means on)." (cancel-timer timeclock-update-timer) (setq timeclock-update-timer nil)))) -(defsubst timeclock-time-to-date (time) +(defsubst timeclock-time-to-date (&optional time) "Convert the TIME value to a textual date string." (format-time-string "%Y/%m/%d" time)) @@ -351,7 +351,7 @@ discover the name of the project." (unless (and timeclock-last-event (equal (timeclock-time-to-date (cadr timeclock-last-event)) - (timeclock-time-to-date (current-time)))) + (timeclock-time-to-date))) (let ((workday (or (and (numberp arg) arg) (and arg 0) (and timeclock-get-workday-function @@ -543,7 +543,7 @@ non-nil, the amount returned will be relative to past time worked." If TODAY-ONLY is non-nil, the value returned will be relative only to the time worked today, and not to past time." (timeclock-seconds-to-time - (- (timeclock-time-to-seconds (current-time)) + (- (timeclock-time-to-seconds) (let ((discrep (timeclock-find-discrep))) (if discrep (if today-only @@ -647,14 +647,12 @@ that variable's documentation." (if timeclock-use-elapsed (timeclock-workday-elapsed) (timeclock-workday-remaining (not timeclock-relative)))) - (last-in (equal (car timeclock-last-event) "i"))) + (last-in (equal (car timeclock-last-event) "i")) + (todays-date (timeclock-time-to-date))) (when (and (< remainder 0) (not (and timeclock-day-over - (equal timeclock-day-over - (timeclock-time-to-date - (current-time)))))) - (setq timeclock-day-over - (timeclock-time-to-date (current-time))) + (equal timeclock-day-over todays-date)))) + (setq timeclock-day-over todays-date) (run-hooks 'timeclock-day-over-hook)) (setq timeclock-mode-string (propertize @@ -725,9 +723,8 @@ recorded to disk. If MOMENT is non-nil, use that as the current time. This is only provided for coherency when used by `timeclock-discrepancy'." (if (equal (car timeclock-last-event) "i") - (- (timeclock-time-to-seconds (or moment (current-time))) - (timeclock-time-to-seconds - (cadr timeclock-last-event))) + (- (timeclock-time-to-seconds moment) + (timeclock-time-to-seconds (cadr timeclock-last-event))) timeclock-last-period)) (defsubst timeclock-entry-length (entry) @@ -1156,7 +1153,7 @@ discrepancy, today's discrepancy, and the time worked today." (+ timeclock-last-period timeclock-elapsed))))) (setq timeclock-last-event event timeclock-last-event-workday - (if (equal (timeclock-time-to-date now) last-date-limited) + (if (equal todays-date last-date-limited) last-date-seconds timeclock-workday)) (forward-line)) @@ -1182,7 +1179,7 @@ discrepancy, today's discrepancy, and the time worked today." (defun timeclock-day-base (&optional time) "Given a time within a day, return 0:0:0 within that day. If optional argument TIME is non-nil, use that instead of the current time." - (let ((decoded (decode-time (or time (current-time))))) + (let ((decoded (decode-time time))) (setcar (nthcdr 0 decoded) 0) (setcar (nthcdr 1 decoded) 0) (setcar (nthcdr 2 decoded) 0) diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index 264297a8212..5c958350ff0 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,13 +1,367 @@ +2015-01-07 Stefan Monnier <monnier@iro.umontreal.ca> + + Don't use <class> as a variable and don't assume that <class>-list-p is + automatically defined. + + * ede/speedbar.el (ede-speedbar-compile-line) + (ede-speedbar-get-top-project-for-line): + * ede.el (ede-buffer-belongs-to-target-p) + (ede-buffer-belongs-to-project-p, ede-build-forms-menu) + (ede-add-project-to-global-list): + * semantic/db-typecache.el (semanticdb-get-typecache): + * semantic/db-file.el (semanticdb-load-database): + * semantic/db-el.el (semanticdb-elisp-sym->tag): + * semantic/db-ebrowse.el (semanticdb-ebrowse-load-helper): + * ede/project-am.el (project-am-preferred-target-type): + * ede/proj.el (ede-proj-load): + * ede/custom.el (ede-customize-current-target, ede-customize-target): + * semantic/ede-grammar.el ("semantic grammar"): + * semantic/scope.el (semantic-scope-reset-cache) + (semantic-calculate-scope): + * srecode/map.el (srecode-map-update-map): + * srecode/insert.el (srecode-insert-show-error-report) + (srecode-insert-method, srecode-insert-include-lookup) + (srecode-insert-method): + * srecode/fields.el (srecode-active-template-region): + * srecode/compile.el (srecode-flush-active-templates) + (srecode-compile-inserter): Don't use <class> as a variable. + Use `oref-default' for class slots. + + * semantic/grammar.el (semantic-grammar-eldoc-last-data): New var. + (semantic-grammar-eldoc-get-macro-docstring): Use it instead of + eldoc-last-data. + * semantic/fw.el (semantic-exit-on-input): Use `declare'. + (semantic-throw-on-input): Use `with-current-buffer'. + * semantic/db.el (semanticdb-abstract-table-list): Define if not + pre-defined. + * semantic/db-find.el (semanticdb-find-tags-collector): + Use save-current-buffer. + (semanticdb-find-tags-collector): Don't use <class> as a variable. + * semantic/complete.el (semantic-complete-active-default) + (semantic-complete-current-matched-tag): Declare. + (semantic-complete-inline-custom-type): Don't use <class> as a variable. + * semantic/bovine/make.el (semantic-analyze-possible-completions): + Use with-current-buffer. + * semantic.el (semantic-parser-warnings): Declare. + * ede/base.el (ede-target-list): Define if not pre-defined. + (ede-with-projectfile): Prefer find-file-noselect over + save-window-excursion. + +2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * srecode/srt-mode.el (srecode-macro-help): Use eieio-class-children. + + * semantic/db.el (semanticdb-cache-get): Prefer eieio-object-class over + eieio--object-class. + + * semantic/db-el.el (semanticdb-elisp-sym->tag): Prefer find-class over + class-v. + + * ede/generic.el (ede-find-target): Prefer \` and \' to ^ and $. + +2014-12-14 Dmitry Gutov <dgutov@yandex.ru> + + * semantic.el (semantic-analyze-completion-at-point-function) + (semantic-analyze-notc-completion-at-point-function) + (semantic-analyze-nolongprefix-completion-at-point-function): + Do nothing if the current buffer is not using Semantic (bug#19077). + +2014-12-14 Paul Eggert <eggert@cs.ucla.edu> + + * semantic/lex-spp.el (semantic-lex-spp-analyzer-do-replace): + Rename from semantic-lex-spp-anlyzer-do-replace. + +2014-12-08 Matt Curtis <matt.r.curtis@gmail.com> (tiny change) + + * pulse.el (pulse-momentary-highlight-one-line): Respect the POINT + argument (bug#17260). + +2014-11-09 Eric Ludlam <zappo@gnu.org> + + * semantic.el (semantic-mode): Add/remove 3 + completion-at-point-functions. + (semantic-completion-at-point-function): Remove. + (semantic-analyze-completion-at-point-function) + (semantic-analyze-notc-completion-at-point-function) + (semantic-analyze-nolongprefix-completion-at-point-function): + New completion at point functions. + + * semantic/doc.el (semantic-doc-snarf-comment-for-tag): Fix case + when comment-end is empty string. + + * semantic/debug.el + (semantic-debug-parser-debugger-source): New buffer local + variable. + (semantic-debug-interface): Add 'nil' initform to overlays. + (semantic-debug-mode): Remove read-only tags from buffers on exit. + (semantic-debug): Add autoload cookie. Force the language + specific debugger to load. + + * semantic/db.el (generic::semanticdb-full-filename): New generic + method to allow this method to be used on buffer names via an + associated database. + + * semantic/symref.el + (semantic-symref-cleanup-recent-buffers-fcn): When cleaning up + buffers, don't clean up buffers that are being used (i.e., in a + window) when the hook fires. + (semantic-symref-recently-opened-buffers): New tracking variable. + (semantic-symref-cleanup-recent-buffers-fcn): New hook fcn. + (semantic-symref-result-get-tags): Move logic into + `semantic-symref-hit-to-tag-via-buffer', and cleanup buffers via + the symref cleanup function in post-command-hook. + (semantic-symref-hit-to-tag-via-buffer): Logic that used to be + from above. + (semantic-symref-hit-to-tag-via-db): New. + + * semantic/analyze.el: + (semantic-analyze-find-tag-sequence-default): If first entry in + sequence is the only one, apply tagclass filter. + (semantic-analyze-princ-sequence): Show slot even if empty. + (semantic-analyze-find-tag-sequence) + (semantic-analyze-find-tag-sequence-default): Add flags argument. + Add support for forcing the final entry of the sequence to be of + class variable. + (semantic-analyze-find-tag): Fix bug where input class filter was + ignored if there was a typecache match. + (semantic-analyze-current-context-default): For assignments, the + assignee now must be of class variable. + + * semantic/analyze/complete.el + (semantic-analyze-possible-completions-default): + Add 'no-longprefix' flag. When used, the prefix and prefixtypes are + shortened to just the last symbol. + + * semantic/bovine/c.el (semantic-c-do-lex-if): Catch errors from + 'hideif', and push to the parser warning stack. + (semantic-lex-cpp-define): When a comment is at the end of a + macro, do not subtract an extra 1 from the found position. + Fixes bug with: #define foo (a)/**/ adding an extra ')' to the stream. + + * semantic/bovine/scm.el (semantic-lex-scheme-symbol): + Allow symbols to be one char long. + + * semantic/bovine/grammar.el + (bovine-grammar-calculate-source-on-path): New. + (bovine-grammar-setupcode-builder): Use it. + + * ede.el (ede/detect): New require. + (ede-version): Bump version + (ede-initialize-state-current-buffer): Use new + `ede-detect-directory-for-project' to detect projects first + instead of depending on currente dir only. + (ede-delete-project-from-global-list): New. + (ede-flush-deleted-projects): Use above. + (ede-check-project-query-fcn): New variable + (ede-check-project-directory): Use above when querying the user. + Added to support unit testing of this security measure. + (ede-initialize-state-current-buffer): + Use `ede-directory-project-cons' instead of the -detect- fcn to take + advantage of the cache. Pass found project into + `ede-load-project-file'. + (ede-load-project-file): Add new input DETECTIN. + (ede-rescan-toplevel): Get the proj root a better way. + (ede-load-project-file): Return the loaded object. When asking + for existing project, ask for an exact match. + (ede-initialize-state-current-buffer): Simplify some conditional + logic. + (ede-load-project-file): Simplify conditional logic. + (ede-global-list-sanity-check): New Testing fcn. + (ede-parent-project): Replace old code with call to faster + `ede-find-subproject-for-directory'. + (ede-load-project-file): + Use `ede-directory-get-toplevel-open-project' instead of above + deleted. Rename "pfc" to "autoloader". + Use `ede-directory-project-cons' to detect a project. Delete no + project found case where we search up the tree. + + * ede/auto.el (ede-project-autoload): Fix doc typo. + Add `:root-only' slot. + (ede-auto-load-project): Doc update: warn to not use. + (ede-dir-to-projectfile): Delete. + (ede-project-autoload-dirmatch): Add subdir-only slot. + Make configdatastash unbound by default. + (ede-do-dirmatch): If subdir-only is true, then don't allow exact + matches. Account for configdatastash as unbound. Assume value of + nil means no tool installed. Make sure loaded path matches from + beginning. Stash the regexp, not the raw string. + (ede-project-class-files): Note that makefile and automake are not + root only. + (ede-auto-detect-in-dir): New (for use with `ede/detect.el'). + (ede-project-dirmatch-p): Delete. + (ede-project-root-directory): Remove body, return nil. + (ede-project-autoload): :proj-root-dirmatch can be null & doc fix. + (ede-auto-detect-in-dir): If there is no :proj-file, check for a + dirmatch. + + * ede/generic.el (ede/config): Replace require of ede. + (ede-generic-new-autoloader): Generic projects are now safe by + default. Note this is NOT a root only project. + (project-rescan, ede-project-root, ede-generic-target-java) + (ede-java-classpath, ede-find-subproject-for-directory): New. + (ede-enable-generic-projects): Add new autoloaders for git, bzr, + hg, sv, CVS. + (ede-generic-vc-project) + (ede-generic-vc-project::ede-generic-setup-configuration): New. + (ede-generic-config): Remove slots: c-include-path, + c-preprocessor-table, c-preprocessor-files, classpath, + build-command, debug-command, run command. Inherit from + ede-extra-config-build, ede-extra-config-program. + Make run-command :value match :custom so only strings are accepted. + Add some more :group slot specifiers. + (ede-generic-project): Add mixins `ede-project-with-config-c' and + `ede-project-with-config-java'. Inherit from + `ede-project-with-config-build', + `ede-project-with-config-program'. Subclass + `ede-project-with-config'. Remove duplication from new baseclass. + (ede-generic-target): Inherit from `ede-target-with-config-build', + `ede-target-with-config-program'. Subclass `ede-target-with-config'. + (ede-generic-target-c-cpp): Add mixin `ede-target-with-config-c'. + (ede-generic-target-java): Add mixin `ede-target-with-config-java'. + (ede-preprocessor-map, ede-system-include-path) + (edejava-classpath): Delete, moved to config.el. + (project-compile-project, project-compile-target) + (project-debug-target, project-run-target): Delete. + (ede-generic-get-configuration, ede-generic-setup-configuration) + (ede-commit-project, project-rescan) + (ede-generic-project::ede-customize) + (ede-generic-target::ede-customize) + (ede-generic-config::eieio-done-customizing) + (ede-generic-config::ede-commit): Delete. Subsumed by new + baseclass. + (ede-preprocessor-map, ede-system-include-path) + (project-debug-target, project-run-target): Call new + `ede-config-get-configuration' instead of old version. + (ede-generic-load): Do not add to global list here. + + * ede/files.el (ede-find-project-root) + (ede-files-find-existing) + (ede-directory-get-toplevel-open-project-new): Delete. + (ede-project-root-directory): Use `ede-project-root' first. + (ede-project-directory-remove-hash) + (ede--directory-project-from-hash) + (ede--directory-project-add-description-to-hash): Rename to make + internal symbols (via --). Expand input dir first. + (ede-directory-project-p): Doc fix (note obsoleted.) + (ede-toplevel-project-or-nil): Alias to `ede-toplevel-project'. + (ede-toplevel-project): Doc Fix. Delete commented out old code. + Simplify returning result from ede-detect-directory-for-project. + (ede-directory-get-open-project): Support when + inodes are disabled. If disabled to str compare on root project. + (ede-directory-get-toplevel-open-project): Enabled nested + projects. When doing directory name matching, save the 'short' + version of an answer (non-exact match) and eventually select the + shortest answer at the end. Expand the filename of tested + projects. Better support for when inodes are disabled. + Add 'exact' option so that it will return a project that is an exact + match. + (ede-find-subproject-for-directory): Small optimization to run + `file-truename' less often. + (ede-directory-project-p): Move content, then use + `ede-directory-project-cons'. + Use `ede-detect-directory-for-project', replacing old detection loop. + (ede-directory-project-cons): New, from above. + (ede-toplevel-project): Toss old scanning code. + Use `ede-detect-directory-for-project' instead. + (ede-directory-get-toplevel-open-project-new): New. + + * ede/linux.el (ede-linux-project-root): Delete. + (ede-project-autoload): Remove dirmatch entry - it is no longer + needed. + + * ede/proj.el (project-rescan): Replace direct + manipulation of `ede-projects' with equivalent and better + functions. + (ede-proj-load): Replace call to test if dir has project to + explicity ask filesystem if Project.ede is there. + + * ede/config.el: + * ede/detect.el: New files. + + * ede/project-am.el (project-run-target): Add "./" to program to + run for systems where '.' isn't in PATH. + (project-am-load): Remove old code regarding `ede-constructing'. + Just read in the makefiles. + + * ede/linux.el (ede-linux-load): Do not add to global list here. + Don't check for existing anymore. + (project-rescan): New. + (ede-linux-project-list, ede-linux-file-existing): Delete. + (ede-linux-project-root): Delete body. Need symbol for autoloads + for now. + (ede-linux-project): No longer instance tracker. + (ede-project-autoload): Don't provide :proj-root + + * ede/emacs.el (ede-emacs-load): Do not add project to global list + here. Don't look for existing first. + (ede-project-autoload): Remove dirmatch entry - it is no longer + needed. Don't provide proj-root anymore. + (ede-emacs-project-list, ede-emacs-file-existing): Delete. + (ede-emacs-project-root): Remove body (need symbol for loaddefs + still). + (ede-emacs-project): Do not instance track anymore. + + * ede/cpp-root.el (initialize-instance): Remove commented code. + Add note about why we are adding the project to the master list. + Make sure if we are replacing a prev version, remove from global + list. + (ede-cpp-root-file-existing) + (ede-cpp-root-project-file-for-dir) + (ede-cpp-root-count, ede-cpp-root-project-root, ede-cpp-root-load) + (ede-project-autoload cpp-root): Delete. + (ede-project-root-directory): Return :directory instead of + calculating from :file. + (project-rescan): New. + + * ede/base.el (ede-toplevel): Only use buffer cached value if + subproj not passed in. + + * srecode/java.el (srecode-semantic-handle-:java): Fix case when + an EDE project didn't support java paths. + +2014-11-09 David Engster <dengste@eml.cc> + + * ede/proj-elisp.el (ede-proj-target-elisp::ede-proj-tweak-autoconf): + Kill buffer after saving modified elisp-comp script, so as to avoid + "file has changed on disk; really edit the buffer" questions when + script gets rewritten. + +2014-10-29 Paul Eggert <eggert@cs.ucla.edu> + + Simplify use of current-time and friends. + * srecode/args.el (srecode-semantic-handle-:time): + Don't call current-time twice to get the current time stamp, + as this can lead to inconsistent results. + +2014-10-24 Stefan Monnier <monnier@iro.umontreal.ca> + + * semantic/complete.el: Require semantic/db-find. + 2014-10-20 Glenn Morris <rgm@gnu.org> - * Version 24.4 released. + * Merge in all changes up to 24.4 release. -2014-09-18 David Engster <deng@randomsample.de> +2014-10-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * semantic/wisent/comp.el (wisent-defcontext): Move declarations + outside of eval-when-compile. Use `declare'. + (wisent-with-context): Add `defvar' declarations in case this macro is + used in a file compiled with lexical-binding. + (wisent-semantic-action-expand-body): Avoid add-to-list on local var. + +2014-09-22 David Engster <deng@randomsample.de> * ede/emacs.el (ede-emacs-version): Do not call 'egrep' to determine Emacs version (it was dead code anyway). Make sure that configure.ac or configure.in exist. (Bug#18476) +2014-06-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * semantic/ia.el (semantic-ia-complete-symbol-menu): Use posn-at-point + instead of senator-completion-menu-point-as-event; un-comment, tho keep + the "no smart completion" fallback commented since it still doesn't + work. + 2014-05-01 Glenn Morris <rgm@gnu.org> * ede.el (ede-project-directories, ede-check-project-directory): @@ -20,6 +374,14 @@ * ede/emacs.el (ede-emacs-version): Update AC_INIT regexp. (Bug#17160) +2014-03-29 Glenn Morris <rgm@gnu.org> + + * ede/dired.el (ede-dired-minor-mode): Add autoload cookie. + (generated-autoload-file, generated-autoload-load-name): + Set file-local values. + * ede.el: Load ede/loaddefs at compile time too. + (ede-dired-minor-mode): Remove hand-written autoload. + 2014-03-04 Glenn Morris <rgm@gnu.org> * semantic/util.el (semantic-complete-symbol): @@ -61,8 +423,8 @@ structure tags are not analyzed correctly. Also, always search the extended miniscope even when not dealing with types. - * semantic/ctxt.el (semantic-get-local-variables-default): Also - try to parse local variables for buffers which are currently + * semantic/ctxt.el (semantic-get-local-variables-default): + Also try to parse local variables for buffers which are currently marked as unparseable. Otherwise, it is often impossible to complete local variables. @@ -103,8 +465,8 @@ (semantic-cpp-lexer): Use new `semantic-lex-spp-paren-or-list'. * semantic/bovine/gcc.el (semantic-gcc-setup): Add 'features.h' to - the list of files whose preprocessor symbols are included. This - pulls in things like __USE_POSIX and similar. + the list of files whose preprocessor symbols are included. + This pulls in things like __USE_POSIX and similar. * semantic/format.el (semantic-format-tag-prototype-default): Display default values if available. @@ -113,11 +475,11 @@ (semantic-analyze-refs-proto): Add 'default-value' as ignorable in call to `semantic-tag-similar-p'. - * semantic/db-mode.el (semanticdb-semantic-init-hook-fcn): Always - set buffer for `semanticdb-current-table'. + * semantic/db-mode.el (semanticdb-semantic-init-hook-fcn): + Always set buffer for `semanticdb-current-table'. - * semantic/db.el (semanticdb-table::semanticdb-refresh-table): The - previous change turned up a bug in this method. Since the current + * semantic/db.el (semanticdb-table::semanticdb-refresh-table): + The previous change turned up a bug in this method. Since the current table now correctly has a buffer set, the first clause in the `cond' would be taken, but there was a `save-excursion' missing. @@ -141,8 +503,8 @@ impossible to find project includes. * semantic/decorate/include.el - (semantic-decoration-on-includes-highlight-default): Remove - 'unloaded' from throttle when decorating includes, otherwise all + (semantic-decoration-on-includes-highlight-default): + Remove 'unloaded' from throttle when decorating includes, otherwise all would be loaded. Rename 'table' to 'currenttable' to make things clearer. @@ -157,7 +519,7 @@ architecture). (ede-linux--get-build-directory, ede-linux--get-archs) (ede-linux--detect-architecture, ede-linux--get-architecture) - (ede-linux--include-path): Added function to detect Linux-specific + (ede-linux--include-path): Add function to detect Linux-specific information. (ede-linux-load): Set new Linux-specific information when creating a project. @@ -175,8 +537,8 @@ * ede/generic.el (project-run-target): Remove incorrect require. - * semantic/format.el (semantic-format-tag-prototype-default): Use - concat only for strings. + * semantic/format.el (semantic-format-tag-prototype-default): + Use concat only for strings. 2013-11-30 Glenn Morris <rgm@gnu.org> diff --git a/lisp/cedet/cedet-global.el b/lisp/cedet/cedet-global.el index e613b46ce00..99bffcb16b5 100644 --- a/lisp/cedet/cedet-global.el +++ b/lisp/cedet/cedet-global.el @@ -93,6 +93,13 @@ SCOPE is the scope of the search, such as 'project or 'subdirs." (apply 'call-process cedet-global-gtags-command nil b nil flags) + + ;; Check for warnings. + (with-current-buffer b + (goto-char (point-min)) + (when (re-search-forward "Error\\|Warning" nil t) + (error "Output:\n%S" (buffer-string)))) + b)) (defun cedet-gnu-global-expand-filename (filename) @@ -181,8 +188,10 @@ If a database already exists, then just update it." (let ((default-directory dir)) (cedet-gnu-global-gtags-call (when root - '("-i");; Incremental update flag. - ))))) + '("-u");; Incremental update flag. + )) + ) + )) (provide 'cedet-global) diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index c0312ddd5bc..87cfb85b2c2 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el @@ -45,8 +45,10 @@ (require 'ede/source) (require 'ede/base) (require 'ede/auto) +(require 'ede/detect) -(load "ede/loaddefs" nil 'nomessage) +(eval-and-compile + (load "ede/loaddefs" nil 'nomessage)) (declare-function ede-commit-project "ede/custom") (declare-function ede-convert-path "ede/files") @@ -60,7 +62,7 @@ (declare-function ede-up-directory "ede/files") (declare-function semantic-lex-make-spp-table "semantic/lex-spp") -(defconst ede-version "1.2" +(defconst ede-version "2.0" "Current version of the Emacs EDE.") ;;; Code: @@ -246,12 +248,12 @@ Argument LIST-O-O is the list of objects to choose from." (let ((obj ede-object)) (if (consp obj) (setq obj (car obj))) - (and obj (obj-of-class-p obj ede-target)))) + (and obj (obj-of-class-p obj 'ede-target)))) (defun ede-buffer-belongs-to-project-p () "Return non-nil if this buffer belongs to at least one project." (if (or (null ede-object) (consp ede-object)) nil - (obj-of-class-p ede-object-project ede-project))) + (obj-of-class-p ede-object-project 'ede-project))) (defun ede-menu-obj-of-class-p (class) "Return non-nil if some member of `ede-object' is a child of CLASS." @@ -279,7 +281,7 @@ Argument MENU-DEF is the menu definition to use." ;; First, collect the build items from the project (setq newmenu (append newmenu (ede-menu-items-build obj t))) ;; Second, declare the current target menu items - (if (and ede-obj (ede-menu-obj-of-class-p ede-target)) + (if (and ede-obj (ede-menu-obj-of-class-p 'ede-target)) (while ede-obj (setq newmenu (append newmenu (ede-menu-items-build (car ede-obj) t)) @@ -450,8 +452,6 @@ If optional argument CURRENT is non-nil, return sub-menu code." ;;; Mode Declarations ;; -(eval-and-compile - (autoload 'ede-dired-minor-mode "ede/dired" "EDE commands for dired" t)) (defun ede-apply-target-options () "Apply options to the current buffer for the active project/target." @@ -501,42 +501,50 @@ Sets buffer local variables for EDE." ;; Init the buffer. (let* ((ROOT nil) (proj (ede-directory-get-open-project default-directory - 'ROOT)) - (projauto nil)) - - (when (or proj ROOT - ;; If there is no open project, look up the project - ;; autoloader to see if we should initialize. - (setq projauto (ede-directory-project-p default-directory t))) - - (when (and (not proj) projauto) - - ;; No project was loaded, but we have a project description - ;; object. This means that we can check if it is a safe - ;; project to load before requesting it to be loaded. - - (when (or (oref projauto safe-p) - ;; The project style is not safe, so check if it is - ;; in `ede-project-directories'. - (let ((top (ede-toplevel-project default-directory))) - (ede-directory-safe-p top))) - - ;; The project is safe, so load it in. - (setq proj (ede-load-project-file default-directory 'ROOT)))) - - ;; Only initialize EDE state in this buffer if we found a project. - (when proj - - (setq ede-object (ede-buffer-object (current-buffer) + 'ROOT))) + + (when (not proj) + ;; If there is no open project, look up the project + ;; autoloader to see if we should initialize. + (let ((projdetect (ede-directory-project-cons default-directory))) + + (when projdetect + ;; No project was loaded, but we have a project description + ;; object. This means that we try to load it. + ;; + ;; Before loading, we need to check if it is a safe + ;; project to load before requesting it to be loaded. + + (when (or (oref (cdr projdetect) safe-p) + ;; The project style is not safe, so check if it is + ;; in `ede-project-directories'. + (let ((top (car projdetect))) + (ede-directory-safe-p top))) + + ;; The project is safe, so load it in. + (setq proj (ede-load-project-file default-directory projdetect 'ROOT)))))) + + ;; If PROJ is now loaded in, we can initialize our buffer to it. + (when proj + + ;; ede-object represents the specific EDE related class that best + ;; represents this buffer. It could be a project (for a project file) + ;; or a target. Also save off ede-object-project, the project that + ;; the buffer belongs to for the case where ede-object is a target. + (setq ede-object (ede-buffer-object (current-buffer) 'ede-object-project)) - (setq ede-object-root-project - (or ROOT (ede-project-root ede-object-project))) + ;; Every project has a root. It might be the same as ede-object. + ;; Cache that also as the root is a very common thing to need. + (setq ede-object-root-project + (or ROOT (ede-project-root ede-object-project))) - (if (and (not ede-object) ede-object-project) - (ede-auto-add-to-target)) + ;; Check to see if we want to add this buffer to a target. + (if (and (not ede-object) ede-object-project) + (ede-auto-add-to-target)) - (ede-apply-target-options))))) + ;; Apply any options from the found target. + (ede-apply-target-options)))) (defun ede-reset-all-buffers () "Reset all the buffers due to change in EDE." @@ -680,6 +688,7 @@ Otherwise, create a new project for DIR." (if (ede-check-project-directory dir) (progn ;; Load the project in DIR, or make one. + ;; @TODO - IS THIS REAL? (ede-load-project-file dir) ;; Check if we loaded anything on the previous line. @@ -701,6 +710,10 @@ Otherwise, create a new project for DIR." (error "%s is not an allowed project directory in `ede-project-directories'" dir))) +(defvar ede-check-project-query-fcn 'y-or-n-p + "Function used to ask the user if they want to permit a project to load. +This is abstracted out so that tests can answer this question.") + (defun ede-check-project-directory (dir) "Check if DIR should be in `ede-project-directories'. If it is not, try asking the user if it should be added; if so, @@ -713,9 +726,10 @@ Return nil if DIR should not be in `ede-project-directories'." ;; If `ede-project-directories' is a list, maybe add it. (when (listp ede-project-directories) (or (member dir ede-project-directories) - (when (y-or-n-p (format "`%s' is not listed in `ede-project-directories'. + (when (funcall ede-check-project-query-fcn + (format "`%s' is not listed in `ede-project-directories'. Add it to the list of allowed project directories? " - dir)) + dir)) (push dir ede-project-directories) ;; If possible, save `ede-project-directories'. (if (or custom-file user-init-file) @@ -783,7 +797,9 @@ Optional argument NAME is the name to give this project." (error "Unknown file name specifier %S" pf))) - :targets nil))) + :targets nil) + + )) (inits (oref obj initializers))) ;; Force the name to match for new objects. (eieio-object-set-name-string nobj (oref nobj :name)) @@ -822,16 +838,17 @@ ARGS are additional arguments to pass to method SYM." (defun ede-rescan-toplevel () "Rescan all project files." (interactive) - (if (not (ede-directory-get-open-project default-directory)) - ;; This directory isn't open. Can't rescan. - (error "Attempt to rescan a project that isn't open") + (when (not (ede-toplevel)) + ;; This directory isn't open. Can't rescan. + (error "Attempt to rescan a project that isn't open")) - ;; Continue - (let ((toppath (ede-toplevel-project default-directory)) - (ede-deep-rescan t)) + ;; Continue + (let ((root (ede-toplevel)) + (ede-deep-rescan t)) - (project-rescan (ede-load-project-file toppath)) - (ede-reset-all-buffers)))) + (project-rescan root) + (ede-reset-all-buffers) + )) (defun ede-new-target (&rest args) "Create a new target specific to this type of project file. @@ -919,6 +936,8 @@ Optional argument FORCE forces the file to be removed without asking." (interactive) (ede-invoke-method 'project-edit-file-target)) +;;; Compilation / Debug / Run +;; (defun ede-compile-project () "Compile the current project." (interactive) @@ -1059,11 +1078,15 @@ On success, return the added project." (error "No project created to add to master list")) (when (not (eieio-object-p proj)) (error "Attempt to add non-object to master project list")) - (when (not (obj-of-class-p proj ede-project-placeholder)) + (when (not (obj-of-class-p proj 'ede-project-placeholder)) (error "Attempt to add a non-project to the ede projects list")) (add-to-list 'ede-projects proj) proj) +(defun ede-delete-project-from-global-list (proj) + "Remove project PROJ from the master list of projects." + (setq ede-projects (remove proj ede-projects))) + (defun ede-flush-deleted-projects () "Scan the projects list for projects which no longer exist. Flush the dead projects from the project cache." @@ -1073,80 +1096,85 @@ Flush the dead projects from the project cache." (when (not (file-exists-p (oref P :file))) (add-to-list 'dead P))) (dolist (D dead) - (setq ede-projects (remove D ede-projects))) + (ede-delete-project-from-global-list D)) )) -(defun ede-load-project-file (dir &optional rootreturn) +(defvar ede--disable-inode) ;Defined in ede/files.el. + +(defun ede-global-list-sanity-check () + "Perform a sanity check to make sure there are no duplicate projects." + (interactive) + (let ((scanned nil)) + (dolist (P ede-projects) + (if (member (oref P :directory) scanned) + (error "Duplicate project (by dir) found in %s!" (oref P :directory)) + (push (oref P :directory) scanned))) + (unless ede--disable-inode + (setq scanned nil) + (dolist (P ede-projects) + (if (member (ede--project-inode P) scanned) + (error "Duplicate project (by inode) found in %s!" (ede--project-inode P)) + (push (ede--project-inode P) scanned)))) + (message "EDE by directory %sis still sane." (if ede--disable-inode "" "& inode ")))) + +(defun ede-load-project-file (dir &optional detectin rootreturn) "Project file independent way to read a project in from DIR. +Optional DETECTIN is an autoload cons from `ede-detect-directory-for-project' +which can be passed in to save time. Optional ROOTRETURN will return the root project for DIR." - ;; Only load if something new is going on. Flush the dirhash. - (ede-project-directory-remove-hash dir) - ;; Do the load - ;;(message "EDE LOAD : %S" file) - (let* ((file dir) - (path (file-name-as-directory (expand-file-name dir))) - (pfc (ede-directory-project-p path)) - (toppath nil) - (o nil)) - (cond - ((not pfc) - ;; @TODO - Do we really need to scan? Is this a waste of time? - ;; Scan upward for a the next project file style. - (let ((p path)) - (while (and p (not (ede-directory-project-p p))) - (setq p (ede-up-directory p))) - (if p (ede-load-project-file p) - nil) - ;; recomment as we go - ;;nil - )) - ;; Do nothing if we are building an EDE project already. - (ede-constructing - nil) - ;; Load in the project in question. - (t - (setq toppath (ede-toplevel-project path)) - ;; We found the top-most directory. Check to see if we already - ;; have an object defining its project. - (setq pfc (ede-directory-project-p toppath t)) - - ;; See if it's been loaded before - (setq o (object-assoc (ede-dir-to-projectfile pfc toppath) 'file - ede-projects)) - - ;; If not open yet, load it. - (unless o - (let ((ede-constructing pfc)) - (setq o (ede-auto-load-project pfc toppath)))) - - ;; Return the found root project. - (when rootreturn (set rootreturn o)) - - (let (tocheck found) - ;; Now find the project file belonging to FILE! - (setq tocheck (list o)) - (setq file (ede-dir-to-projectfile pfc (expand-file-name path))) - (while (and tocheck (not found)) - (let ((newbits nil)) - (when (car tocheck) - (if (string= file (oref (car tocheck) file)) - (setq found (car tocheck))) - (setq newbits (oref (car tocheck) subproj))) - (setq tocheck - (append (cdr tocheck) newbits)))) - (if (not found) - (message "No project for %s, but passes project-p test" file) - ;; Now that the file has been reset inside the project object, do - ;; the cache maintenance. - (setq ede-project-cache-files - (delete (oref found file) ede-project-cache-files))) - found))))) + ;; Don't do anything if we are in the process of + ;; constructing an EDE object. + ;; + ;; Prevent recursion. + (unless ede-constructing + + ;; Only load if something new is going on. Flush the dirhash. + (ede-project-directory-remove-hash dir) + + ;; Do the load + ;;(message "EDE LOAD : %S" file) + (let* ((file dir) + (path (file-name-as-directory (expand-file-name dir))) + (detect (or detectin (ede-directory-project-cons path))) + (autoloader nil) + (toppath nil) + (o nil)) + + (when detect + (setq toppath (car detect)) + (setq autoloader (cdr detect)) + + ;; See if it's been loaded before. Use exact matching since + ;; know that 'toppath' is the root of the project. + (setq o (ede-directory-get-toplevel-open-project toppath 'exact)) + + ;; If not open yet, load it. + (unless o + ;; NOTE: We set ede-constructing to the autoloader we are using. + ;; Some project types have one class, but many autoloaders + ;; and this is how we tell the instantiation which kind of + ;; project to make. + (let ((ede-constructing autoloader)) + + ;; This is the only place `ede-auto-load-project' should be called. + + (setq o (ede-auto-load-project autoloader toppath)))) + + ;; Return the found root project. + (when rootreturn (set rootreturn o)) + + ;; The project has been found (in the global list) or loaded from + ;; disk (via autoloader.) We can now search for the project asked + ;; for from DIR in the sub-list. + (ede-find-subproject-for-directory o path) + + ;; Return the project. + o)))) ;;; PROJECT ASSOCIATIONS ;; ;; Moving between relative projects. Associating between buffers and ;; projects. - (defun ede-parent-project (&optional obj) "Return the project belonging to the parent directory. Return nil if there is no previous directory. diff --git a/lisp/cedet/ede/auto.el b/lisp/cedet/ede/auto.el index c4fba7f3973..769bea4ce50 100644 --- a/lisp/cedet/ede/auto.el +++ b/lisp/cedet/ede/auto.el @@ -47,8 +47,13 @@ :initform nil :documentation "An index into the match-data of `configregex'.") - (configdatastash :initform nil - :documentation + (subdir-only :initarg :subdir-only + :initform t + :documentation + "Non-nil means an exact match to the found directory is a non-match. +This implies projects exist only in subdirectories of the configuration path. +If `:subdir-only' is nil, then the directory from the configuration file is the project.") + (configdatastash :documentation "Save discovered match string.") ) "Support complex matches for projects that live in named directories. @@ -80,8 +85,11 @@ into memory.") ;; If the thing to match is stored in a config file. ((stringp fc) (when (file-exists-p fc) - (let ((matchstring (oref dirmatch configdatastash))) - (unless matchstring + (let ((matchstring + (if (slot-boundp dirmatch 'configdatastash) + (oref dirmatch configdatastash) + nil))) + (when (and (not matchstring) (not (slot-boundp dirmatch 'configdatastash))) (save-current-buffer (let* ((buff (get-file-buffer fc)) (readbuff @@ -94,12 +102,27 @@ into memory.") (setq matchstring (match-string (or (oref dirmatch configregexidx) 0))))) (if (not buff) (kill-buffer readbuff)))) - ;; Save what we find in our cache. - (oset dirmatch configdatastash matchstring)) + (when matchstring + ;; If this dirmatch only finds subdirs of matchstring, then + ;; force matchstring to be a directory. + (when (oref dirmatch subdir-only) + (setq matchstring (file-name-as-directory matchstring))) + ;; Convert matchstring to a regexp + (setq matchstring (concat "^" (regexp-quote matchstring))) + ;; Stash it for later. + (oset dirmatch configdatastash matchstring)) + ;; Debug + ;;(message "Stashing config data for dirmatch %S as %S" (eieio-object-name dirmatch) matchstring) + ) + ;;(message "dirmatch %s against %s" matchstring (expand-file-name file)) ;; Match against our discovered string - (and matchstring (string-match (regexp-quote matchstring) file)) + (setq file (file-name-as-directory (expand-file-name file))) + (and matchstring (string-match matchstring (expand-file-name file)) + (or (not (oref dirmatch subdir-only)) + (not (= (match-end 0) (length file)))) + ) ))) - + ;; Add new matches here ;; ((stringp somenewslot ...) ;; ) @@ -119,13 +142,21 @@ into memory.") :documentation "The lisp file belonging to this class.") (proj-file :initarg :proj-file :documentation "Name of a project file of this type.") + (root-only :initarg :root-only + :initform t ;; Default - majority case. + :documentation + "Non-nil if project detection only finds proj-file @ project root.") (proj-root-dirmatch :initarg :proj-root-dirmatch - :initform "" - :type (or string ede-project-autoload-dirmatch) + :initform nil + :type (or null string ede-project-autoload-dirmatch) :documentation "To avoid loading a project, check if the directory matches this. -For projects that use directory name matches, a function would load that project. -Specifying this matcher will allow EDE to check without loading the project.") +Specifying this matcher object will allow EDE to perform a complex +check without loading the project. + +NOTE: If you use dirmatch, you may need to set :root-only to `nil'. +While it may be a root based project, all subdirs will happen to return +true for the dirmatch, so for scanning purposes, set it to `nil'.") (proj-root :initarg :proj-root :type function :documentation "A function symbol to call for the project root. @@ -168,12 +199,14 @@ type is required and the load function used.") (ede-project-autoload "edeproject-makefile" :name "Make" :file 'ede/proj :proj-file "Project.ede" + :root-only nil :load-type 'ede-proj-load :class-sym 'ede-proj-project :safe-p nil) (ede-project-autoload "edeproject-automake" :name "Automake" :file 'ede/proj :proj-file "Project.ede" + :root-only nil :initializers '(:makefile-type Makefile.am) :load-type 'ede-proj-load :class-sym 'ede-proj-project @@ -181,6 +214,7 @@ type is required and the load function used.") (ede-project-autoload "automake" :name "automake" :file 'ede/project-am :proj-file "Makefile.am" + :root-only nil :load-type 'project-am-load :class-sym 'project-am-makefile :new-p nil @@ -233,97 +267,33 @@ added. Possible values are: ;; Splice into the list. (setcdr prev (cons projauto next)))))))) -;;; EDE project-autoload methods +;;; Project Autoload Methods ;; -(defmethod ede-project-root ((this ede-project-autoload)) - "If a project knows its root, return it here. -Allows for one-project-object-for-a-tree type systems." - nil) - -(defun ede-project-dirmatch-p (file dirmatch) - "Return non-nil if FILE matches DIRMATCH. -DIRMATCH could be nil (no match), a string (regexp match), -or an `ede-project-autoload-dirmatch' object." - ;; If dirmatch is a string, then we simply match it against - ;; the file we are testing. - (if (stringp dirmatch) - (string-match dirmatch file) - ;; if dirmatch is instead a dirmatch object, we test against - ;; that object instead. - (if (ede-project-autoload-dirmatch-p dirmatch) - (ede-do-dirmatch dirmatch file) - (error "Unknown project directory match type.")) - )) -(defmethod ede-project-root-directory ((this ede-project-autoload) - &optional file) - "If a project knows its root, return it here. -Allows for one-project-object-for-a-tree type systems. -Optional FILE is the file to test. If there is no FILE, use -the current buffer." - (when (not file) - (setq file default-directory)) - (when (slot-boundp this :proj-root) - (let ((dirmatch (oref this proj-root-dirmatch)) - (rootfcn (oref this proj-root)) - (callfcn t)) - (when rootfcn - (if ;; If the dirmatch (an object) is not installed, then we - ;; always skip doing a match. - (and (ede-project-autoload-dirmatch-p dirmatch) - (not (ede-dirmatch-installed dirmatch))) - (setq callfcn nil) - ;; Other types of dirmatch: - (when (and - ;; If the Emacs Lisp file handling this project hasn't - ;; been loaded, we will use the quick dirmatch feature. - (not (featurep (oref this file))) - ;; If the dirmatch is an empty string, then we always - ;; skip doing a match. - (not (and (stringp dirmatch) (string= dirmatch ""))) - ) - ;; If this file DOES NOT match dirmatch, we set the callfcn - ;; to nil, meaning don't load the ede support file for this - ;; type of project. If it does match, we will load the file - ;; and use a more accurate programmatic match from there. - (unless (ede-project-dirmatch-p file dirmatch) - (setq callfcn nil)))) - ;; Call into the project support file for a match. - (when callfcn - (condition-case nil - (funcall rootfcn file) - (error - (funcall rootfcn)))) - )))) - -(defmethod ede-dir-to-projectfile ((this ede-project-autoload) dir) - "Return a full file name of project THIS found in DIR. -Return nil if the project file does not exist." +;; New method using detect.el +(defmethod ede-auto-detect-in-dir ((this ede-project-autoload) dir) + "Return non-nil if THIS project autoload is found in DIR." (let* ((d (file-name-as-directory dir)) - (root (ede-project-root-directory this d)) (pf (oref this proj-file)) - (dm (oref this proj-root-dirmatch)) - (f (cond ((stringp pf) - (expand-file-name pf (or root d))) - ((and (symbolp pf) (fboundp pf)) - ;; If there is a symbol to call, lets make extra - ;; sure we really can call it without loading in - ;; other EDE projects. This happens if the file is - ;; already loaded, or if there is a dirmatch, but - ;; root is empty. - (when (and (featurep (oref this file)) - (or (not (stringp dm)) - (not (string= dm ""))) - root) - (funcall pf (or root d)))))) - ) - (when (and f (file-exists-p f)) - f))) + (f (when (stringp pf) (expand-file-name pf d)))) + (if f + (and f (file-exists-p f)) + (let ((dirmatch (oref this proj-root-dirmatch))) + (cond + ((stringp dirmatch) + nil) ; <- do something here - maybe obsolete the option? + ((ede-project-autoload-dirmatch-p dirmatch) + (if (and dirmatch (ede-dirmatch-installed dirmatch)) + (ede-do-dirmatch dirmatch dir) + ;(message "Dirmatch %S not installed." dirmatch) + ))))))) (defmethod ede-auto-load-project ((this ede-project-autoload) dir) "Load in the project associated with THIS project autoload description. THIS project description should be valid for DIR, where the project will -be loaded." +be loaded. + +NOTE: Do not call this - it should only be called from `ede-load-project-file'." ;; Last line of defense: don't load unsafe projects. (when (not (or (oref this :safe-p) (ede-directory-safe-p dir))) @@ -332,7 +302,27 @@ be loaded." (let ((o (funcall (oref this load-type) dir))) (when (not o) (error "Project type error: :load-type failed to create a project")) - (ede-add-project-to-global-list o))) + (ede-add-project-to-global-list o) + ;; @TODO - Add to hash over at `ede-inode-directory-hash'. + )) + + + + + + +;;; -------- Old Methods +;; See if we can do without them. + +;; @FIXME - delete from loaddefs to remove this. +(defmethod ede-project-root ((this ede-project-autoload)) + "If a project knows its root, return it here. +Allows for one-project-object-for-a-tree type systems." + nil) + +;; @FIXME - delete from loaddefs to remove this. +(defmethod ede-project-root-directory ((this ede-project-autoload) &optional file) + "" nil) (provide 'ede/auto) diff --git a/lisp/cedet/ede/autoconf-edit.el b/lisp/cedet/ede/autoconf-edit.el index 471841e8d82..687b8a0f5ad 100644 --- a/lisp/cedet/ede/autoconf-edit.el +++ b/lisp/cedet/ede/autoconf-edit.el @@ -60,6 +60,7 @@ configure the initial configure script using `autoconf-new-automake-string'" (defvar autoconf-preferred-macro-order '("AC_INIT" + "AC_CONFIG_SRCDIR" "AM_INIT_AUTOMAKE" "AM_CONFIG_HEADER" ;; Arg parsing diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el index 75d83c12c03..ce7857b53a3 100644 --- a/lisp/cedet/ede/base.el +++ b/lisp/cedet/ede/base.el @@ -159,6 +159,9 @@ and querying them will cause the actual project to get loaded.") ;; Projects can also affect how EDE works, by changing what appears in ;; the EDE menu, or how some keys are bound. ;; +(unless (fboundp 'ede-target-list-p) + (cl-deftype ede-target-list () '(list-of ede-target))) + (defclass ede-project (ede-project-placeholder) ((subproj :initform nil :type list @@ -287,16 +290,18 @@ All specific project types must derive from this project." ;; (defmacro ede-with-projectfile (obj &rest forms) "For the project in which OBJ resides, execute FORMS." - `(save-window-excursion - (let* ((pf (if (obj-of-class-p ,obj ede-target) - (ede-target-parent ,obj) - ,obj)) - (dbka (get-file-buffer (oref pf file)))) - (if (not dbka) (find-file (oref pf file)) - (switch-to-buffer dbka)) + (declare (indent 1)) + (unless (symbolp obj) + (message "Beware! ede-with-projectfile's first arg is copied: %S" obj)) + `(let* ((pf (if (obj-of-class-p ,obj 'ede-target) + (ede-target-parent ,obj) + ,obj)) + (dbka (get-file-buffer (oref pf file)))) + (with-current-buffer + (if (not dbka) (find-file-noselect (oref pf file)) + dbka) ,@forms (if (not dbka) (kill-buffer (current-buffer)))))) -(put 'ede-with-projectfile 'lisp-indent-function 1) ;;; The EDE persistent cache. ;; @@ -605,7 +610,7 @@ Display the results as a debug list." "Return the ede project which is the root of the current project. Optional argument SUBPROJ indicates a subproject to start from instead of the current project." - (or ede-object-root-project + (or (when (not subproj) ede-object-root-project) (let* ((cp (or subproj (ede-current-project)))) (or (and cp (ede-project-root cp)) (progn diff --git a/lisp/cedet/ede/config.el b/lisp/cedet/ede/config.el new file mode 100644 index 00000000000..e479af05595 --- /dev/null +++ b/lisp/cedet/ede/config.el @@ -0,0 +1,416 @@ +;;; ede/config.el --- Configuration Handler baseclass + +;; Copyright (C) 2014-2015 Free Software Foundation, Inc. + +;; Author: Eric Ludlam <eric@siege-engine.com> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Some auto-detecting projects (such as the 'generic' project type) +;; can be enhanced by also saving a configuration file that is EDE +;; specific. EDE will be able to load that configuration from the save +;; file as a way of augmenting what is normally already detected. +;; +;; How To Use: +;; +;; Subclass `ede-extra-config', and add the features you want to use. +;; Several mixins are available for adding in C++ or Java support. Bring +;; in the pieces you need. +;; +;; Your project and targets should all have a common baseclass from +;; `ede-project-with-config' or `ede-target-with-config'. When +;; subclassing the project, be sure to override the class allocated +;; slots for the `config-class'. This will tie your new project to +;; the new configuration type. +;; +;; You can also override the file name used to save the configuration +;; object in. +;; +;; If you need to take special action in `project-rescan' be sure to also +;; call `call-next-method' to also get the configuration rescanned. +;; +;; Note on config file safety: +;; +;; Normally an EDE project that loads a save file should have it's +;; autoload slot :safe-p set to nil. Projects who save data via +;; config.el can mark their project as :safe-p t. The config system will +;; do the queries needed to protect the user. This allows a generic +;; project to become active in cases where no save file exists, nor is +;; needed. + +;;; Code: +(require 'ede) + +;;; CONFIG +;; +;; This is the base of a configuration class supported by the +;; `ede-project-with-config' baseclass. +;; +(defclass ede-extra-config (eieio-persistent) + ((extension :initform ".ede") + (file-header-line :initform ";; EDE Project Configuration") + (project :type ede-project-with-config-child + :documentation + "The project this config is bound to.") + (ignored-file :initform nil + :type (or null symbol) + :documentation + "Set to non-nil if this was created and an on-disk file +was ignored. Use this to warn the user that they might want to load in +an on-disk version.") + ) + "Baseclass for auxiliary configuration files for EDE. +This should be subclassed by projects that auto detect a project +and also want to save some extra level of configuration.") + +;;; PROJECT BASECLASS +;; +;; Subclass this baseclass if you want your EDE project to also +;; support saving an extra configuration file of unique data +;; needed for this project. +;; +(defclass ede-project-with-config (ede-project) + ((menu :initform nil) + (config-file-basename + :initform "Config.ede" + :allocation :class + :type string + :documentation + "The filename to use for saving the configuration. +This filename excludes the directory name and is used to +initialize the :file slot of the persistent baseclass.") + (config-class + :initform ede-extra-config + :allocation :class + :type class + :documentation + "The class of the configuration used by this project.") + (config :initform nil + :type (or null ede-extra-config-child) + :documentation + "The configuration object for this project.") + ) + "Baseclass for projects that save a configuration.") + +(defclass ede-target-with-config (ede-target) + () + "Baseclass for targets of classes that use a config object.") + +;;; Rescanning + +(defmethod project-rescan ((this ede-project-with-config)) + "Rescan this generic project from the sources." + ;; Force the config to be rescanned. + (oset this config nil) + ;; Ask if it is safe to load the config from disk. + (ede-config-get-configuration this t) + ) + +;;; Project Methods for configuration + +(defmethod ede-config-get-configuration ((proj ede-project-with-config) &optional loadask) + "Return the configuration for the project PROJ. +If optional LOADASK is non-nil, then if a project file exists, and if +the directory isn't on the `safe' list, ask to add it to the safe list." + (let ((config (oref proj config))) + + ;; If the request is coming at a time when we want to ask the user, + ;; and there already is a configuration, AND the last time we ignored + ;; the on-file version we did so automatically (without asking) then + ;; in theory there are NO mods to this config, and we should re-ask, + ;; and possibly re-load. + (when (and loadask config (eq (oref config ignored-file) 'auto)) + (setq config nil)) + + (when (not config) + (let* ((top (oref proj :directory)) + (fname (expand-file-name (oref proj config-file-basename) top)) + (class (oref proj config-class)) + (ignore-type nil)) + (if (and (file-exists-p fname) + (or (ede-directory-safe-p top) + ;; Only force the load if someone asked. + (and loadask (ede-check-project-directory top)))) + ;; Load in the configuration + (setq config (eieio-persistent-read fname class)) + ;; If someone said not to load stuff from here then + ;; pop up a warning. + (when (file-exists-p fname) + (message "Ignoring EDE config file for now and creating a new one. Use C-c . g to load it.") + ;; Set how it was ignored. + (if loadask + (setq ignore-type 'manual) + (setq ignore-type 'auto)) + ) + ;; Create a new one. + (setq config (make-instance class + "Configuration" + :file fname)) + (oset config ignored-file ignore-type) + + ;; Set initial values based on project. + (ede-config-setup-configuration proj config)) + ;; Link things together. + (oset proj config config) + (oset config project proj))) + config)) + +(defmethod ede-config-setup-configuration ((proj ede-project-with-config) config) + "Default configuration setup method." + nil) + +(defmethod ede-commit-project ((proj ede-project-with-config)) + "Commit any change to PROJ to its file." + (let ((config (ede-config-get-configuration proj))) + (ede-commit config))) + +;;; Customization +;; +(defmethod ede-customize ((proj ede-project-with-config)) + "Customize the EDE project PROJ by actually configuring the config object." + (let ((config (ede-config-get-configuration proj t))) + (eieio-customize-object config))) + +(defmethod ede-customize ((target ede-target-with-config)) + "Customize the EDE TARGET by actually configuring the config object." + ;; Nothing unique for the targets, use the project. + (ede-customize-project)) + +(defmethod eieio-done-customizing ((config ede-extra-config)) + "Called when EIEIO is done customizing the configuration object. +We need to go back through the old buffers, and update them with +the new configuration." + (ede-commit config) + ;; Loop over all the open buffers, and re-apply. + (ede-map-targets + (oref config project) + (lambda (target) + (ede-map-target-buffers + target + (lambda (b) + (with-current-buffer b + (ede-apply-target-options))))))) + +(defmethod ede-commit ((config ede-extra-config)) + "Commit all changes to the configuration to disk." + ;; So long as the user is trying to safe this config, make sure they can + ;; get at it again later. + (let ((dir (file-name-directory (oref config file)))) + (ede-check-project-directory dir)) + + (eieio-persistent-save config)) + +;;; PROJECT MIXINS +;; +;; These are project part mixins. Use multiple inheritance for each +;; piece of these configuration options you would like to have as part +;; of your project. + +;;; PROGRAM +;; If there is a program that can be run or debugged that is unknown +;; and needs to be configured. +(defclass ede-extra-config-program () + ((debug-command :initarg :debug-command + :initform "gdb " + :type string + :group commands + :custom string + :group (default build) + :documentation + "Command used for debugging this project.") + (run-command :initarg :run-command + :initform "" + :type string + :group commands + :custom string + :group (default build) + :documentation + "Command used to run something related to this project.")) + "Class to mix into a configuration for debug/run of programs.") + +(defclass ede-project-with-config-program () + () + "Class to mix into a project with configuration for programs.") + +(defclass ede-target-with-config-program () + () + "Class to mix into a project with configuration for programs. +This class brings in method overloads for running and debugging +programs from a project.") + +(defmethod project-debug-target ((target ede-target-with-config-program)) + "Run the current project derived from TARGET in a debugger." + (let* ((proj (ede-target-parent target)) + (config (ede-config-get-configuration proj t)) + (debug (oref config :debug-command)) + (cmd (read-from-minibuffer + "Debug Command: " + debug)) + (cmdsplit (split-string cmd " " t)) + ;; @TODO - this depends on the user always typing in something good + ;; like "gdb" or "dbx" which also exists as a useful Emacs command. + ;; Is there a better way? + (cmdsym (intern-soft (car cmdsplit)))) + (call-interactively cmdsym t))) + +(defmethod project-run-target ((target ede-target-with-config-program)) + "Run the current project derived from TARGET." + (let* ((proj (ede-target-parent target)) + (config (ede-config-get-configuration proj t)) + (run (concat "./" (oref config :run-command))) + (cmd (read-from-minibuffer "Run (like this): " run))) + (ede-shell-run-something target cmd))) + +;;; BUILD +;; If the build style is unknown and needs to be configured. +(defclass ede-extra-config-build () + ((build-command :initarg :build-command + :initform "make -k" + :type string + :group commands + :custom string + :group (default build) + :documentation + "Command used for building this project.")) + "Class to mix into a configuration for compilation.") + +(defclass ede-project-with-config-build () + () + "Class to mix into a project with configuration for builds. +This class brings in method overloads for building.") + +(defclass ede-target-with-config-build () + () + "Class to mix into a project with configuration for builds. +This class brings in method overloads for for building.") + +(defmethod project-compile-project ((proj ede-project-with-config-build) &optional command) + "Compile the entire current project PROJ. +Argument COMMAND is the command to use when compiling." + (let* ((config (ede-config-get-configuration proj t)) + (comp (oref config :build-command))) + (compile comp))) + +(defmethod project-compile-target ((obj ede-target-with-config-build) &optional command) + "Compile the current target OBJ. +Argument COMMAND is the command to use for compiling the target." + (project-compile-project (ede-current-project) command)) + +;;; C / C++ +;; Configure includes and preprocessor symbols for C/C++ needed by +;; Semantic. +(defclass ede-extra-config-c () + ((c-include-path :initarg :c-include-path + :initform nil + :type list + :custom (repeat (string :tag "Path")) + :group c + :documentation + "The include path used by C/C++ projects. +The include path is used when searching for symbols.") + (c-preprocessor-table :initarg :c-preprocessor-table + :initform nil + :type list + :custom (repeat (cons (string :tag "Macro") + (string :tag "Value"))) + :group c + :documentation + "Preprocessor Symbols for this project. +When files within this project are parsed by CEDET, these symbols will be +used to resolve macro occurrences in source files. +If you modify this slot, you will need to force your source files to be +parsed again.") + (c-preprocessor-files :initarg :c-preprocessor-files + :initform nil + :type list + :group c + :custom (repeat (string :tag "Include File")) + :documentation + "Files parsed and used to populate preprocessor tables. +When files within this project are parsed by CEDET, these symbols will be used to +resolve macro occurrences in source files. +If you modify this slot, you will need to force your source files to be +parsed again.")) + "Class to mix into a configuration for compilation.") + +(defclass ede-project-with-config-c () + () + "Class to mix into a project for C/C++ support.") + +(defclass ede-target-with-config-c () + () + "Class to mix into a project for C/C++ support. +This target brings in methods used by Semantic to query +the preprocessor map, and include paths.") + +(defmethod ede-preprocessor-map ((this ede-target-with-config-c)) + "Get the pre-processor map for some generic C code." + (let* ((proj (ede-target-parent this)) + (root (ede-project-root proj)) + (config (ede-config-get-configuration proj)) + filemap + ) + ;; Preprocessor files + (dolist (G (oref config :c-preprocessor-files)) + (let ((table (semanticdb-file-table-object + (ede-expand-filename root G)))) + (when table + (when (semanticdb-needs-refresh-p table) + (semanticdb-refresh-table table)) + (setq filemap (append filemap (oref table lexical-table))) + ))) + ;; The core table + (setq filemap (append filemap (oref config :c-preprocessor-table))) + + filemap + )) + +(defmethod ede-system-include-path ((this ede-target-with-config-c)) + "Get the system include path used by project THIS." + (let* ((proj (ede-target-parent this)) + (config (ede-config-get-configuration proj))) + (oref config c-include-path))) + +;;; Java +;; Configuration needed for programming with Java. +(defclass ede-extra-config-java () + () + "Class to mix into a configuration for compilation.") + +(defclass ede-project-with-config-java () + () + "Class to mix into a project to support java. +This brings in methods to support Semantic querying the +java class path.") + +(defclass ede-target-with-config-java () + () + "Class to mix into a project to support java.") + +(defmethod ede-java-classpath ((proj ede-project-with-config-java)) + "Return the classpath for this project." + (oref (ede-config-get-configuration proj) :classpath)) + +;; Local variables: +;; generated-autoload-file: "loaddefs.el" +;; generated-autoload-load-name: "ede/config" +;; End: + +(provide 'ede/config) + +;;; ede/config.el ends here diff --git a/lisp/cedet/ede/cpp-root.el b/lisp/cedet/ede/cpp-root.el index 99f0d6f022a..e32066af89b 100644 --- a/lisp/cedet/ede/cpp-root.el +++ b/lisp/cedet/ede/cpp-root.el @@ -116,11 +116,6 @@ ;; <write your code here, or return nil> ;; ) ;; -;; (defun MY-ROOT-FCN () -;; "Return the root directory for `default-directory'" -;; ;; You might be able to use `ede-cpp-root-project-root'. -;; ) -;; ;; (defun MY-LOAD (dir) ;; "Load a project of type `cpp-root' for the directory DIR. ;; Return nil if there isn't one." @@ -128,16 +123,14 @@ ;; :locate-fcn 'MYFCN) ;; ) ;; -;; (add-to-list 'ede-project-class-files -;; (ede-project-autoload "cpp-root" +;; (ede-add-project-autoload +;; (ede-project-autoload "cpp-root" ;; :name "CPP ROOT" ;; :file 'ede/cpp-root ;; :proj-file 'MY-FILE-FOR-DIR -;; :proj-root 'MY-ROOT-FCN ;; :load-type 'MY-LOAD ;; :class-sym 'ede-cpp-root-project -;; :safe-p t) -;; t) +;; :safe-p t)) ;; ;;; TODO ;; @@ -168,91 +161,13 @@ ;;; PROJECT CACHE: ;; -;; cpp-root projects are created in a .emacs or other config file, but -;; there still needs to be a way for a particular file to be -;; identified against it. The cache is where we look to map a file -;; against a project. -;; -;; Setting up a simple in-memory cache of active projects allows the -;; user to re-load their configuration file several times without -;; messing up the active project set. +;; cpp-root projects are created in a .emacs or other config file. We +;; need to cache them so if the user re-loads a lisp file with the +;; config in it, we can flush out the old one and replace it. ;; (defvar ede-cpp-root-project-list nil "List of projects created by option `ede-cpp-root-project'.") -(defun ede-cpp-root-file-existing (dir) - "Find a cpp-root project in the list of cpp-root projects. -DIR is the directory to search from." - (let ((projs ede-cpp-root-project-list) - (ans nil)) - (while (and projs (not ans)) - (let ((root (ede-project-root-directory (car projs)))) - (when (string-match (concat "^" (regexp-quote root)) dir) - (setq ans (car projs)))) - (setq projs (cdr projs))) - ans)) - -;;; PROJECT AUTOLOAD CONFIG -;; -;; Each project type registers itself into the project-class list. -;; This way, each time a file is loaded, EDE can map that file to a -;; project. This project type checks files against the internal cache -;; of projects created by the user. -;; -;; EDE asks two kinds of questions. One is, does this DIR belong to a -;; project. If it does, it then asks, what is the ROOT directory to -;; the project in DIR. This is easy for cpp-root projects, but more -;; complex for multiply nested projects. -;; -;; If EDE finds out that a project exists for DIR, it then loads that -;; project. The LOAD routine can either create a new project object -;; (if it needs to load it off disk) or more likely can return an -;; existing object for the discovered directory. cpp-root always uses -;; the second case. - -(defun ede-cpp-root-project-file-for-dir (&optional dir) - "Return a full file name to the project file stored in DIR." - (let ((proj (ede-cpp-root-file-existing dir))) - (when proj (oref proj :file)))) - -(defvar ede-cpp-root-count 0 - "Count number of hits to the cpp root thing. -This is a debugging variable to test various optimizations in file -lookup in the main EDE logic.") - -;;;###autoload -(defun ede-cpp-root-project-root (&optional dir) - "Get the root directory for DIR." - (let ((projfile (ede-cpp-root-project-file-for-dir - (or dir default-directory)))) - (setq ede-cpp-root-count (1+ ede-cpp-root-count)) - ;(debug) - (when projfile - (file-name-directory projfile)))) - -(defun ede-cpp-root-load (dir &optional rootproj) - "Return a CPP root object if you created one. -Return nil if there isn't one. -Argument DIR is the directory it is created for. -ROOTPROJ is nil, since there is only one project." - ;; Snoop through our master list. - (ede-cpp-root-file-existing dir)) - -;;;###autoload -(ede-add-project-autoload - (ede-project-autoload "cpp-root" - :name "CPP ROOT" - :file 'ede/cpp-root - :proj-file 'ede-cpp-root-project-file-for-dir - :proj-root 'ede-cpp-root-project-root - :load-type 'ede-cpp-root-load - :class-sym 'ede-cpp-root-project - :new-p nil - :safe-p t) - ;; When a user creates one of these, it should override any other project - ;; type that might happen to be in this directory, so force this to the - ;; very front. - 'unique) ;;; CLASSES ;; @@ -372,6 +287,7 @@ Each directory needs a project file to control it.") :directory 'ede-cpp-root-project-list))) ;; This is safe, because :directory isn't filled in till later. (when (and old (not (eq old this))) + (ede-delete-project-from-global-list old) (delete-instance old))) ;; Basic initialization. (when (or (not (file-exists-p f)) @@ -381,11 +297,13 @@ Each directory needs a project file to control it.") (oset this :file f) (oset this :directory (file-name-directory f)) (ede-project-directory-remove-hash (file-name-directory f)) + ;; NOTE: We must add to global list here because these classes are not + ;; created via the typical loader, but instead via calls from a .emacs + ;; file. (ede-add-project-to-global-list this) + (unless (slot-boundp this 'targets) (oset this :targets nil)) - ;; We need to add ourselves to the master list. - ;;(setq ede-projects (cons this ede-projects)) )) ;;; SUBPROJ Management. @@ -465,7 +383,7 @@ This knows details about or source tree." (defmethod ede-project-root-directory ((this ede-cpp-root-project)) "Return my root." - (file-name-directory (oref this file))) + (oref this directory)) ;;; C/CPP SPECIFIC CODE ;; @@ -558,6 +476,10 @@ Argument COMMAND is the command to use for compiling the target." (project-compile-project (oref obj :project) command))) +(defmethod project-rescan ((this ede-cpp-root-project)) + "Don't rescan this project from the sources." + (message "cpp-root has nothing to rescan.")) + ;;; Quick Hack (defun ede-create-lots-of-projects-under-dir (dir projfile &rest attributes) "Create a bunch of projects under directory DIR. diff --git a/lisp/cedet/ede/custom.el b/lisp/cedet/ede/custom.el index 3cc3a48c27a..a39b4880283 100644 --- a/lisp/cedet/ede/custom.el +++ b/lisp/cedet/ede/custom.el @@ -61,7 +61,7 @@ "Edit fields of the current target through EIEIO & Custom." (interactive) (require 'eieio-custom) - (if (not (obj-of-class-p ede-object ede-target)) + (if (not (obj-of-class-p ede-object 'ede-target)) (error "Current file is not part of a target")) (ede-customize-target ede-object)) @@ -72,7 +72,7 @@ "Edit fields of the current target through EIEIO & Custom. OBJ is the target object to customize." (require 'eieio-custom) - (if (and obj (not (obj-of-class-p obj ede-target))) + (if (and obj (not (obj-of-class-p obj 'ede-target))) (error "No logical target to customize")) (ede-customize obj)) diff --git a/lisp/cedet/ede/detect.el b/lisp/cedet/ede/detect.el new file mode 100644 index 00000000000..9761b9e0828 --- /dev/null +++ b/lisp/cedet/ede/detect.el @@ -0,0 +1,210 @@ +;;; ede/detect.el --- EDE project detection and file associations + +;; Copyright (C) 2014-2015 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <eric@siege-engine.com> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Project detection for EDE; +;; +;; Detection comes in multiple forms: +;; +;; `ede-detect-scan-directory-for-project' - +;; Scan for a project via the file system. +;; `ede-detect-directory-for-project' - +;; Check our file cache for a project. If that fails, use +;; the scan fcn above. + +;;; Code: + +(require 'ede/auto) ;; Autoload settings. + +(when (or (<= emacs-major-version 23) + ;; predicate as name added in Emacs 24.2 + (and (= emacs-major-version 24) + (< emacs-minor-version 2))) + (message "Loading CEDET fallback autoload library.") + (require 'cedet/dominate + (expand-file-name "../../../etc/fallback-libraries/dominate.el" + (file-name-directory load-file-name)))) + + +;;; BASIC PROJECT SCAN +;; +(defun ede--detect-stop-scan-p (dir) + "Return non-nil if we need to stop scanning upward in DIR." + ;;(let ((stop + (file-exists-p (expand-file-name ".ede_stop_scan" dir))) +;;) +;;(when stop +;;(message "Stop Scan at %s" dir)) +;;stop)) + +(defvar ede--detect-found-project nil + "When searching for a project, temporarily save that file.") + +(defun ede--detect-ldf-predicate (dir) + "Non-nil if DIR contain any known EDE project types." + (if (ede--detect-stop-scan-p dir) + (throw 'stopscan nil) + (let ((types ede-project-class-files)) + ;; Loop over all types, loading in the first type that we find. + (while (and types (not ede--detect-found-project)) + (if (ede-auto-detect-in-dir (car types) dir) + (progn + ;; We found one! + (setq ede--detect-found-project (car types))) + (setq types (cdr types))) + ) + ede--detect-found-project))) + +(defun ede--detect-scan-directory-for-project (directory) + "Detect an EDE project for the current DIRECTORY by scanning. +This function ALWAYS scans files and directories and DOES NOT +use any file caches. +Return a cons cell: + ( ROOTDIR . PROJECT-AUTOLOAD)" + (let* ((ede--detect-found-project nil) + (root + (catch 'stopscan + (locate-dominating-file directory + 'ede--detect-ldf-predicate)))) + (when root + (cons root ede--detect-found-project)))) + +;;; Root Only project detect +;; +;; For projects that only have a detectable ROOT file, but may in fact +;; contain a generic file such as a Makefile, we need to do a second scan +;; to make sure we don't miss-match. +(defun ede--detect-ldf-rootonly-predicate (dir) + "Non-nil if DIR contain any known EDE project types." + (if (ede--detect-stop-scan-p dir) + (throw 'stopscan nil) + (let ((types ede-project-class-files)) + ;; Loop over all types, loading in the first type that we find. + (while (and types (not ede--detect-found-project)) + (if (and + (oref (car types) root-only) + (ede-auto-detect-in-dir (car types) dir)) + (progn + ;; We found one! + (setq ede--detect-found-project (car types))) + (setq types (cdr types))) + ) + ede--detect-found-project))) + +(defun ede--detect-scan-directory-for-rootonly-project (directory) + "Detect an EDE project for the current DIRECTORY by scanning. +This function ALWAYS scans files and directories and DOES NOT +use any file caches. +Return a cons cell: + ( ROOTDIR . PROJECT-AUTOLOAD)" + (let* ((ede--detect-found-project nil) + (root + (catch 'stopscan + (locate-dominating-file directory + 'ede--detect-ldf-rootonly-predicate)))) + (when root + (cons root ede--detect-found-project)))) + + +;;; NESTED PROJECT SCAN +;; +;; For projects that can have their dominating file exist in all their +;; sub-directories as well. + +(defvar ede--detect-nomatch-auto nil + "An ede autoload that needs to be un-matched.") + +(defun ede--detect-ldf-root-predicate (dir) + "Non-nil if DIR no longer match `ede--detect-nomatch-auto'." + (or (ede--detect-stop-scan-p dir) + ;; To know if DIR is at the top, we need to look just above + ;; to see if there is a match. + (let ((updir (file-name-directory (directory-file-name dir)))) + (if (equal updir dir) + ;; If it didn't change, then obviously this must be the top. + t + ;; If it is different, check updir for the file. + (not (ede-auto-detect-in-dir ede--detect-nomatch-auto updir)))))) + +(defun ede--detect-scan-directory-for-project-root (directory auto) + "If DIRECTORY has already been detected with AUTO, find the root. +Some projects have their dominating file in all their directories, such +as Project.ede. In that case we will detect quickly, but then need +to scan upward to find the topmost occurrence of that file." + (let* ((ede--detect-nomatch-auto auto) + (root (locate-dominating-file directory + 'ede--detect-ldf-root-predicate))) + root)) + +;;; TOP LEVEL SCAN +;; +;; This function for combining the above scans. +(defun ede-detect-directory-for-project (directory) + "Detect an EDE project for the current DIRECTORY. +Scan the filesystem for a project. +Return a cons cell: + ( ROOTDIR . PROJECT-AUTOLOAD)" + (let* ((scan (ede--detect-scan-directory-for-project directory)) + (root (car scan)) + (auto (cdr scan))) + (when scan + ;; If what we found is already a root-only project, return it. + (if (oref auto root-only) + scan + + ;; If what we found is a generic project, check to make sure we aren't + ;; in some other kind of root project. + (if (oref auto generic-p) + (let ((moreroot (ede--detect-scan-directory-for-rootonly-project root))) + ;; If we found a rootier project, return that. + (if moreroot + moreroot + + ;; If we didn't find a root from the generic project, then + ;; we need to rescan upward. + (cons (ede--detect-scan-directory-for-project-root root auto) auto))) + + ;; Non-generic non-root projects also need to rescan upward. + (cons (ede--detect-scan-directory-for-project-root root auto) auto))) + + ))) + +;;; TEST +;; +;; A quick interactive testing fcn. +(defun ede-detect-qtest () + "Run a quick test for autodetecting on BUFFER." + (interactive) + (let ((start (current-time)) + (ans (ede-detect-directory-for-project default-directory)) + (end (current-time))) + (if ans + (message "Project found in %d sec @ %s of type %s" + (float-time (time-subtract end start)) + (car ans) + (eieio-object-name-string (cdr ans))) + (message "No Project found.") ))) + + +(provide 'ede/detect) + +;;; ede/detect.el ends here diff --git a/lisp/cedet/ede/dired.el b/lisp/cedet/ede/dired.el index eff78ff9235..836a538e2cd 100644 --- a/lisp/cedet/ede/dired.el +++ b/lisp/cedet/ede/dired.el @@ -56,6 +56,7 @@ map) "Keymap used for ede dired minor mode.") +;;;###autoload (define-minor-mode ede-dired-minor-mode "A minor mode that should only be activated in DIRED buffers. If ARG is nil or a positive number, force on, if @@ -84,4 +85,9 @@ negative, force off." (provide 'ede/dired) +;; Local variables: +;; generated-autoload-file: "loaddefs.el" +;; generated-autoload-load-name: "ede/dired" +;; End: + ;;; ede/dired.el ends here diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el index 292fb375641..621e8951dd7 100644 --- a/lisp/cedet/ede/emacs.el +++ b/lisp/cedet/ede/emacs.el @@ -38,37 +38,12 @@ (declare-function semanticdb-refresh-table "semantic/db") ;;; Code: -(defvar ede-emacs-project-list nil - "List of projects created by option `ede-emacs-project'.") - -(defun ede-emacs-file-existing (dir) - "Find a Emacs project in the list of Emacs projects. -DIR is the directory to search from." - (let ((projs ede-emacs-project-list) - (ans nil)) - (while (and projs (not ans)) - (let ((root (ede-project-root-directory (car projs)))) - (when (string-match (concat "^" (regexp-quote root)) - (file-name-as-directory dir)) - (setq ans (car projs)))) - (setq projs (cdr projs))) - ans)) -;;;###autoload +;; @TODO - get rid of this. Stuck in loaddefs right now. + (defun ede-emacs-project-root (&optional dir) "Get the root directory for DIR." - (when (not dir) (setq dir default-directory)) - (let ((case-fold-search t) - (proj (ede-files-find-existing dir ede-emacs-project-list))) - (if proj - (ede-up-directory (file-name-directory - (oref proj :file))) - ;; No pre-existing project. Let's take a wild-guess if we have - ;; an Emacs project here. - (when (string-match "emacs[^/]*" dir) - (let ((base (substring dir 0 (match-end 0)))) - (when (file-exists-p (expand-file-name "src/emacs.c" base)) - base)))))) + nil) (defun ede-emacs-version (dir) "Find the Emacs version for the Emacs src in DIR. @@ -118,8 +93,8 @@ m4_define(\\[SXEM4CS_BETA_VERSION\\], \\[\\([0-9]+\\)\\])") ;; Return a tuple (cons emacs ver)))) -(defclass ede-emacs-project (ede-project eieio-instance-tracker) - ((tracking-symbol :initform 'ede-emacs-project-list) +(defclass ede-emacs-project (ede-project) + ( ) "Project Type for the Emacs source code." :method-invocation-order :depth-first) @@ -129,17 +104,15 @@ m4_define(\\[SXEM4CS_BETA_VERSION\\], \\[\\([0-9]+\\)\\])") Return nil if there isn't one. Argument DIR is the directory it is created for. ROOTPROJ is nil, since there is only one project." - (or (ede-files-find-existing dir ede-emacs-project-list) - ;; Doesn't already exist, so let's make one. - (let* ((vertuple (ede-emacs-version dir)) - (proj (ede-emacs-project - (car vertuple) - :name (car vertuple) - :version (cdr vertuple) - :directory (file-name-as-directory dir) - :file (expand-file-name "src/emacs.c" - dir)))) - (ede-add-project-to-global-list proj)))) + ;; Doesn't already exist, so let's make one. + (let* ((vertuple (ede-emacs-version dir))) + (ede-emacs-project + (car vertuple) + :name (car vertuple) + :version (cdr vertuple) + :directory (file-name-as-directory dir) + :file (expand-file-name "src/emacs.c" + dir)))) ;;;###autoload (ede-add-project-autoload @@ -147,8 +120,6 @@ ROOTPROJ is nil, since there is only one project." :name "EMACS ROOT" :file 'ede/emacs :proj-file "src/emacs.c" - :proj-root-dirmatch "emacs[^/]*" - :proj-root 'ede-emacs-project-root :load-type 'ede-emacs-load :class-sym 'ede-emacs-project :new-p nil @@ -302,6 +273,15 @@ Knows about how the Emacs source tree is organized." (ede-emacs-find-in-directories name dir dirs)) )) +;;; Command Support +;; +(defmethod project-rescan ((this ede-emacs-project)) + "Rescan this Emacs project from the sources." + (let ((ver (ede-emacs-version (ede-project-root-directory this)))) + (oset this name (car ver)) + (oset this version (cdr ver)) + )) + (provide 'ede/emacs) ;; Local variables: diff --git a/lisp/cedet/ede/files.el b/lisp/cedet/ede/files.el index 2a26372a16f..a3febfa4e5d 100644 --- a/lisp/cedet/ede/files.el +++ b/lisp/cedet/ede/files.el @@ -80,46 +80,15 @@ Allows for one-project-object-for-a-tree type systems." Allows for one-project-object-for-a-tree type systems. Optional FILE is the file to test. It is ignored in preference of the anchor file for the project." - (file-name-directory (expand-file-name (oref this file)))) + (let ((root (or (ede-project-root this) this))) + (file-name-directory (expand-file-name (oref this file))))) -(defmethod ede--project-inode ((proj ede-project-placeholder)) - "Get the inode of the directory project PROJ is in." - (if (slot-boundp proj 'dirinode) - (oref proj dirinode) - (oset proj dirinode (ede--inode-for-dir (oref proj :directory))))) - -(defmethod ede-find-subproject-for-directory ((proj ede-project-placeholder) - dir) - "Find a subproject of PROJ that corresponds to DIR." - (if ede--disable-inode - (let ((ans nil)) - ;; Try to find the right project w/out inodes. - (ede-map-subprojects - proj - (lambda (SP) - (when (not ans) - (if (string= (file-truename dir) (oref SP :directory)) - (setq ans SP) - (ede-find-subproject-for-directory SP dir))))) - ans) - ;; We can use inodes, so let's try it. - (let ((ans nil) - (inode (ede--inode-for-dir dir))) - (ede-map-subprojects - proj - (lambda (SP) - (when (not ans) - (if (equal (ede--project-inode SP) inode) - (setq ans SP) - (setq ans (ede-find-subproject-for-directory SP dir)))))) - ans))) +;; Why INODEs? +;; An inode represents a unique ID that transcends symlinks, hardlinks, etc. +;; so when we cache an inode in a project, and hash directories to inodes, we +;; can avoid costly filesystem queries and regex matches. -;;; DIRECTORY IN OPEN PROJECT -;; -;; These routines match some directory name to one of the many pre-existing -;; open projects. This should avoid hitting the disk, or asking lots of questions -;; if used throughout the other routines. (defvar ede-inode-directory-hash (make-hash-table ;; Note on test. Can we compare inodes or something? :test 'equal) @@ -147,6 +116,32 @@ of the anchor file for the project." (ede--put-inode-dir-hash dir (nth 10 fattr)) ))))) +(defmethod ede--project-inode ((proj ede-project-placeholder)) + "Get the inode of the directory project PROJ is in." + (if (slot-boundp proj 'dirinode) + (oref proj dirinode) + (oset proj dirinode (ede--inode-for-dir (oref proj :directory))))) + +(defun ede--inode-get-toplevel-open-project (inode) + "Return an already open toplevel project that is managing INODE. +Does not check subprojects." + (when (or (and (numberp inode) (/= inode 0)) + (consp inode)) + (let ((all ede-projects) + (found nil) + ) + (while (and all (not found)) + (when (equal inode (ede--project-inode (car all))) + (setq found (car all))) + (setq all (cdr all))) + found))) + +;;; DIRECTORY IN OPEN PROJECT +;; +;; These routines match some directory name to one of the many pre-existing +;; open projects. This should avoid hitting the disk, or asking lots of questions +;; if used throughout the other routines. + (defun ede-directory-get-open-project (dir &optional rootreturn) "Return an already open project that is managing DIR. Optional ROOTRETURN specifies a symbol to set to the root project. @@ -156,66 +151,105 @@ If DIR is the root project, then it is the same." (proj (ede--inode-get-toplevel-open-project inode)) (ans nil)) ;; Try file based search. - (when (not proj) + (when (or ede--disable-inode (not proj)) (setq proj (ede-directory-get-toplevel-open-project ft))) ;; Default answer is this project (setq ans proj) ;; Save. (when rootreturn (set rootreturn proj)) ;; Find subprojects. - (when (and proj (or ede--disable-inode - (not (equal inode (ede--project-inode proj))))) + (when (and proj (if ede--disable-inode + (not (string= ft (expand-file-name (oref proj :directory)))) + (not (equal inode (ede--project-inode proj))))) (setq ans (ede-find-subproject-for-directory proj ft))) ans)) -(defun ede--inode-get-toplevel-open-project (inode) - "Return an already open toplevel project that is managing INODE. -Does not check subprojects." - (when (or (and (numberp inode) (/= inode 0)) - (consp inode)) - (let ((all ede-projects) - (found nil) - ) - (while (and all (not found)) - (when (equal inode (ede--project-inode (car all))) - (setq found (car all))) - (setq all (cdr all))) - found))) - -(defun ede-directory-get-toplevel-open-project (dir) - "Return an already open toplevel project that is managing DIR." +;; Force all users to switch to `ede-directory-get-open-project' +;; for performance reasons. +(defun ede-directory-get-toplevel-open-project (dir &optional exact) + "Return an already open toplevel project that is managing DIR. +If optional EXACT is non-nil, only return exact matches for DIR." (let ((ft (file-name-as-directory (expand-file-name dir))) (all ede-projects) - (ans nil)) + (ans nil) + (shortans nil)) (while (and all (not ans)) ;; Do the check. - (let ((pd (oref (car all) :directory)) + (let ((pd (expand-file-name (oref (car all) :directory))) ) (cond ;; Exact text match. ((string= pd ft) (setq ans (car all))) ;; Some sub-directory - ((string-match (concat "^" (regexp-quote pd)) ft) - (setq ans (car all))) + ((and (not exact) (string-match (concat "^" (regexp-quote pd)) ft)) + (if (not shortans) + (setq shortans (car all)) + ;; We already have a short answer, so see if pd (the match we found) + ;; is longer. If it is longer, then it is more precise. + (when (< (length (oref shortans :directory)) + (length pd)) + (setq shortans (car all)))) + ) ;; Exact inode match. Useful with symlinks or complex automounters. - ((let ((pin (ede--project-inode (car all))) - (inode (ede--inode-for-dir dir))) - (and (not (eql pin 0)) (equal pin inode))) + ((and (not ede--disable-inode) + (let ((pin (ede--project-inode (car all))) + (inode (ede--inode-for-dir dir))) + (and (not (eql pin 0)) (equal pin inode)))) (setq ans (car all))) ;; Subdir via truename - slower by far, but faster than a traditional lookup. - ((let ((ftn (file-truename ft)) - (ptd (file-truename (oref (car all) :directory)))) - (string-match (concat "^" (regexp-quote ptd)) ftn)) - (setq ans (car all))) - )) + ;; Note that we must resort to truename in order to resolve issues such as + ;; cross-symlink projects. + ((and (not exact) + (let ((ftn (file-truename ft)) + (ptd (file-truename pd))) + (string-match (concat "^" (regexp-quote ptd)) ftn))) + (if (not shortans) + (setq shortans (car all)) + ;; We already have a short answer, so see if pd (the match we found) + ;; is longer. If it is longer, then it is more precise. + (when (< (length (expand-file-name (oref shortans :directory))) + (length pd)) + (setq shortans (car all)))) + ))) (setq all (cdr all))) - ans)) + ;; If we have an exact answer, use that, otherwise use + ;; the short answer we found -> ie - we are in a subproject. + (or ans shortans))) + +(defmethod ede-find-subproject-for-directory ((proj ede-project-placeholder) + dir) + "Find a subproject of PROJ that corresponds to DIR." + (if ede--disable-inode + (let ((ans nil) + (fulldir (file-truename dir))) + ;; Try to find the right project w/out inodes. + (ede-map-subprojects + proj + (lambda (SP) + (when (not ans) + (if (string= fulldir (file-truename (oref SP :directory))) + (setq ans SP) + (ede-find-subproject-for-directory SP dir))))) + ans) + ;; We can use inodes, so let's try it. + (let ((ans nil) + (inode (ede--inode-for-dir dir))) + (ede-map-subprojects + proj + (lambda (SP) + (when (not ans) + (if (equal (ede--project-inode SP) inode) + (setq ans SP) + (setq ans (ede-find-subproject-for-directory SP dir)))))) + ans))) -;;; DIRECTORY-PROJECT-P +;;; DIRECTORY HASH ;; -;; For a fresh buffer, or for a path w/ no open buffer, use this -;; routine to determine if there is a known project type here. +;; The directory hash matches expanded directory names to already detected +;; projects. By hashing projects to directories, we can detect projects in +;; places we have been before much more quickly. + (defvar ede-project-directory-hash (make-hash-table ;; Note on test. Can we compare inodes or something? :test 'equal) @@ -237,7 +271,7 @@ Do this only when developing new projects that are incorrectly putting "Reset the directory hash for DIR. Do this whenever a new project is created, as opposed to loaded." ;; TODO - Use maphash, and delete by regexp, not by dir searching! - + (setq dir (expand-file-name dir)) (when (fboundp 'remhash) (remhash (file-name-as-directory dir) ede-project-directory-hash) ;; Look for all subdirs of D, and remove them. @@ -248,98 +282,95 @@ Do this whenever a new project is created, as opposed to loaded." ede-project-directory-hash)) )) -(defun ede-directory-project-from-hash (dir) +(defun ede--directory-project-from-hash (dir) "If there is an already loaded project for DIR, return it from the hash." (when (fboundp 'gethash) + (setq dir (expand-file-name dir)) (gethash dir ede-project-directory-hash nil))) -(defun ede-directory-project-add-description-to-hash (dir desc) +(defun ede--directory-project-add-description-to-hash (dir desc) "Add to the EDE project hash DIR associated with DESC." (when (fboundp 'puthash) + (setq dir (expand-file-name dir)) (puthash dir desc ede-project-directory-hash) desc)) +;;; DIRECTORY-PROJECT-P, -CONS +;; +;; These routines are useful for detecting if a project exists +;; in a provided directory. +;; +;; Note that -P provides less information than -CONS, so use -CONS +;; instead so that -P can be obsoleted. (defun ede-directory-project-p (dir &optional force) - "Return a project description object if DIR has a project. + "Return a project description object if DIR is in a project. Optional argument FORCE means to ignore a hash-hit of 'nomatch. This depends on an up to date `ede-project-class-files' variable. Any directory that contains the file .ede-ignore will always -return nil." +return nil. + +Consider using `ede-directory-project-cons' instead if the next +question you want to ask is where the root of found project is." + ;; @TODO - We used to have a full impl here, but moved it all + ;; to ede-directory-project-cons, and now hash contains only + ;; the results of detection which includes the root dir. + ;; Perhaps we can eventually remove this fcn? + (let ((detect (ede-directory-project-cons dir force))) + (cdr detect))) + +(defun ede-directory-project-cons (dir &optional force) + "Return a project CONS (ROOTDIR . AUTOLOAD) for DIR. +If there is no project in DIR, return nil. +Optional FORCE means to ignore the hash of known directories." (when (not (file-exists-p (expand-file-name ".ede-ignore" dir))) (let* ((dirtest (expand-file-name dir)) - (match (ede-directory-project-from-hash dirtest))) + (match (ede--directory-project-from-hash dirtest))) (cond ((and (eq match 'nomatch) (not force)) nil) ((and match (not (eq match 'nomatch))) match) (t - (let ((types ede-project-class-files) - (ret nil)) - ;; Loop over all types, loading in the first type that we find. - (while (and types (not ret)) - (if (ede-dir-to-projectfile (car types) dirtest) - (progn - ;; We found one! Require it now since we will need it. - (require (oref (car types) file)) - (setq ret (car types)))) - (setq types (cdr types))) - (ede-directory-project-add-description-to-hash dirtest (or ret 'nomatch)) - ret)))))) + ;; First time here? Use the detection code to identify if we have + ;; a project here. + (let* ((detect (ede-detect-directory-for-project dirtest)) + (autoloader (cdr detect))) ;; autoloader + (when autoloader (require (oref autoloader file))) + (ede--directory-project-add-description-to-hash dirtest (or detect 'nomatch)) + detect) + ))))) + ;;; TOPLEVEL ;; ;; These utilities will identify the "toplevel" of a project. ;; -(defun ede-toplevel-project-or-nil (dir) - "Starting with DIR, find the toplevel project directory, or return nil. -nil is returned if the current directory is not a part of a project." - (let* ((ans (ede-directory-get-toplevel-open-project dir))) - (if ans - (oref ans :directory) - (if (ede-directory-project-p dir) - (ede-toplevel-project dir) - nil)))) +;; NOTE: These two -toplevel- functions return a directory even though +;; the function name implies a project. (defun ede-toplevel-project (dir) - "Starting with DIR, find the toplevel project directory." - (if (and (string= dir default-directory) + "Starting with DIR, find the toplevel project directory. +If DIR is not part of a project, return nil." + (let ((ans nil)) + + (cond + ;; Check if it is cached in the current buffer. + ((and (string= dir default-directory) ede-object-root-project) ;; Try the local buffer cache first. - (oref ede-object-root-project :directory) - ;; Otherwise do it the hard way. - (let* ((thisdir (ede-directory-project-p dir)) - (ans (ede-directory-get-toplevel-open-project dir))) - (if (and ans ;; We have an answer - (or (not thisdir) ;; this dir isn't setup - (and (object-of-class-p ;; Same as class for this dir? - ans (oref thisdir :class-sym))) - )) - (oref ans :directory) - (let* ((toppath (expand-file-name dir)) - (newpath toppath) - (proj (ede-directory-project-p dir)) - (ans nil)) - (if proj - ;; If we already have a project, ask it what the root is. - (setq ans (ede-project-root-directory proj))) - - ;; If PROJ didn't know, or there is no PROJ, then - - ;; Loop up to the topmost project, and then load that single - ;; project, and its sub projects. When we are done, identify the - ;; sub-project object belonging to file. - (while (and (not ans) newpath proj) - (setq toppath newpath - newpath (ede-up-directory toppath)) - (when newpath - (setq proj (ede-directory-project-p newpath))) - - (when proj - ;; We can home someone in the middle knows too. - (setq ans (ede-project-root-directory proj))) - ) - (or ans toppath)))))) + (oref ede-object-root-project :directory)) + + ;; See if there is an existing project in DIR. + ((setq ans (ede-directory-get-toplevel-open-project dir)) + (oref ans :directory)) + + ;; Detect using our file system detector. + ((setq ans (ede-detect-directory-for-project dir)) + (car ans)) + + (t nil)))) + +(defalias 'ede-toplevel-project-or-nil 'ede-toplevel-project) ;;; DIRECTORY CONVERSION STUFF ;; @@ -509,25 +540,6 @@ Argument DIR is the directory to trim upwards." nil fnd))) -(defun ede-find-project-root (prj-file-name &optional dir) - "Tries to find directory with given project file" - (let ((prj-dir (locate-dominating-file (or dir default-directory) - prj-file-name))) - (when prj-dir - (expand-file-name prj-dir)))) - -(defun ede-files-find-existing (dir prj-list) - "Find a project in the list of projects stored in given variable. -DIR is the directory to search from." - (let ((projs prj-list) - (ans nil)) - (while (and projs (not ans)) - (let ((root (ede-project-root-directory (car projs)))) - (when (string-match (concat "^" (regexp-quote root)) dir) - (setq ans (car projs)))) - (setq projs (cdr projs))) - ans)) - (provide 'ede/files) diff --git a/lisp/cedet/ede/generic.el b/lisp/cedet/ede/generic.el index bbe37908c45..4d1e0e20707 100644 --- a/lisp/cedet/ede/generic.el +++ b/lisp/cedet/ede/generic.el @@ -78,61 +78,18 @@ ;; the above described support features. (require 'eieio-opt) -(require 'ede) +(require 'ede/config) (require 'ede/shell) (require 'semantic/db) ;;; Code: ;; ;; Start with the configuration system -(defclass ede-generic-config (eieio-persistent) - ((extension :initform ".ede") - (file-header-line :initform ";; EDE Generic Project Configuration") - (project :initform nil - :documentation - "The project this config is bound to.") - ;; Generic customizations - (build-command :initarg :build-command - :initform "make -k" - :type string - :custom string - :group (default build) - :documentation - "Command used for building this project.") - (debug-command :initarg :debug-command - :initform "gdb " - :type string - :custom string - :group (default build) - :documentation - "Command used for debugging this project.") - (run-command :initarg :run-command - :initform nil - :type (or null string) - :custom string - :group (default build) - :documentation - "Command used to run something related to this project.") - ;; C target customizations - (c-include-path :initarg :c-include-path - :initform nil - :type list - :custom (repeat (string :tag "Path")) - :group c - :documentation - "The include path used by C/C++ projects.") - (c-preprocessor-table :initarg :c-preprocessor-table - :initform nil - :type list - :custom (repeat (cons (string :tag "Macro") - (string :tag "Value"))) - :group c - :documentation - "Preprocessor Symbols for this project.") - (c-preprocessor-files :initarg :c-preprocessor-files - :initform nil - :type list - :custom (repeat (string :tag "Include File"))) +(defclass ede-generic-config (ede-extra-config + ede-extra-config-build + ede-extra-config-program + ede-extra-config-c) + ((file-header-line :initform ";; EDE Generic Project Configuration") ) "User Configuration object for a generic project.") @@ -142,23 +99,24 @@ Return nil if there isn't one. Argument DIR is the directory it is created for. ROOTPROJ is nil, since there is only one project." ;; Doesn't already exist, so let's make one. - (let* ((alobj ede-constructing) - (this nil)) + (let* ((alobj ede-constructing)) (when (not alobj) (error "Cannot load generic project without the autoload instance")) - - (setq this - (funcall (oref alobj class-sym) - (symbol-name (oref alobj class-sym)) - :name (file-name-nondirectory - (directory-file-name dir)) - :version "1.0" - :directory (file-name-as-directory dir) - :file (expand-file-name (oref alobj :proj-file)) )) - (ede-add-project-to-global-list this) + ;;; + ;; TODO - find the root dir. + (let ((rootdir dir)) + (funcall (oref alobj class-sym) + (symbol-name (oref alobj class-sym)) + :name (file-name-nondirectory (directory-file-name dir)) + :version "1.0" + :directory (file-name-as-directory rootdir) + :file (expand-file-name (oref alobj :proj-file) + rootdir))) )) ;;; Base Classes for the system -(defclass ede-generic-target (ede-target) +(defclass ede-generic-target (ede-target-with-config + ede-target-with-config-build + ede-target-with-config-program) ((shortname :initform "" :type string :allocation :class @@ -174,16 +132,18 @@ subclasses of this base target will override the default value.") "Baseclass for all targets belonging to the generic ede system." :abstract t) -(defclass ede-generic-project (ede-project) - ((buildfile :initform "" +(defclass ede-generic-project (ede-project-with-config + ede-project-with-config-build + ede-project-with-config-program + ede-project-with-config-c + ede-project-with-config-java) + ((config-class :initform ede-generic-config) + (config-file-basename :initform "EDEConfig.el") + (buildfile :initform "" :type string :allocation :class :documentation "The file name that identifies a project of this type. The class allocated value is replace by different sub classes.") - (config :initform nil - :type (or null ede-generic-config) - :documentation - "The configuration object for this project.") ) "The baseclass for all generic EDE project types." :abstract t) @@ -196,37 +156,18 @@ The class allocated value is replace by different sub classes.") (oset this :targets nil)) ) -(defmethod ede-generic-get-configuration ((proj ede-generic-project)) - "Return the configuration for the project PROJ." - (let ((config (oref proj config))) - (when (not config) - (let ((fname (expand-file-name "EDEConfig.el" - (oref proj :directory)))) - (if (file-exists-p fname) - ;; Load in the configuration - (setq config (eieio-persistent-read fname 'ede-generic-config)) - ;; Create a new one. - (setq config (ede-generic-config - "Configuration" - :file fname)) - ;; Set initial values based on project. - (ede-generic-setup-configuration proj config)) - ;; Link things together. - (oset proj config config) - (oset config project proj))) - config)) - -(defmethod ede-generic-setup-configuration ((proj ede-generic-project) config) - "Default configuration setup method." - nil) - -(defmethod ede-commit-project ((proj ede-generic-project)) - "Commit any change to PROJ to its file." - (let ((config (ede-generic-get-configuration proj))) - (ede-commit config))) +(defmethod ede-project-root ((this ede-generic-project)) + "Return my root." + this) + +(defmethod ede-find-subproject-for-directory ((proj ede-generic-project) + dir) + "Return PROJ, for handling all subdirs below DIR." + proj) ;;; A list of different targets -(defclass ede-generic-target-c-cpp (ede-generic-target) +(defclass ede-generic-target-c-cpp (ede-generic-target + ede-target-with-config-c) ((shortname :initform "C/C++") (extension :initform "\\([ch]\\(pp\\|xx\\|\\+\\+\\)?\\|cc\\|hh\\|CC?\\)")) "EDE Generic Project target for C and C++ code. @@ -250,6 +191,13 @@ All directories need at least one target.") "EDE Generic Project target for texinfo code. All directories need at least one target.") +(defclass ede-generic-target-java (ede-generic-target + ede-target-with-config-java) + ((shortname :initform "Java") + (extension :initform "java")) + "EDE Generic Project target for texinfo code. +All directories need at least one target.") + ;; MISC must always be last since it will always match the file. (defclass ede-generic-target-misc (ede-generic-target) ((shortname :initform "Misc") @@ -284,7 +232,7 @@ If one doesn't exist, create a new one for this directory." (let* ((classsym (intern (car C))) (extreg (oref classsym extension))) (when (and (not (string= extreg "")) - (string-match (concat "^" extreg "$") ext)) + (string-match (concat "\\`\\(?:" extreg "\\)\\'") ext)) (setq cls classsym))))) (when (not cls) (setq cls 'ede-generic-target-misc)) ;; find a pre-existing matching target @@ -300,103 +248,6 @@ If one doesn't exist, create a new one for this directory." ) ans)) -;;; C/C++ support -(defmethod ede-preprocessor-map ((this ede-generic-target-c-cpp)) - "Get the pre-processor map for some generic C code." - (let* ((proj (ede-target-parent this)) - (root (ede-project-root proj)) - (config (ede-generic-get-configuration proj)) - filemap - ) - ;; Preprocessor files - (dolist (G (oref config :c-preprocessor-files)) - (let ((table (semanticdb-file-table-object - (ede-expand-filename root G)))) - (when table - (when (semanticdb-needs-refresh-p table) - (semanticdb-refresh-table table)) - (setq filemap (append filemap (oref table lexical-table))) - ))) - ;; The core table - (setq filemap (append filemap (oref config :c-preprocessor-table))) - - filemap - )) - -(defmethod ede-system-include-path ((this ede-generic-target-c-cpp)) - "Get the system include path used by project THIS." - (let* ((proj (ede-target-parent this)) - (config (ede-generic-get-configuration proj))) - (oref config c-include-path))) - -;;; Commands -;; -(defmethod project-compile-project ((proj ede-generic-project) &optional command) - "Compile the entire current project PROJ. -Argument COMMAND is the command to use when compiling." - (let* ((config (ede-generic-get-configuration proj)) - (comp (oref config :build-command))) - (compile comp))) - -(defmethod project-compile-target ((obj ede-generic-target) &optional command) - "Compile the current target OBJ. -Argument COMMAND is the command to use for compiling the target." - (project-compile-project (ede-current-project) command)) - -(defmethod project-debug-target ((target ede-generic-target)) - "Run the current project derived from TARGET in a debugger." - (let* ((proj (ede-target-parent target)) - (config (ede-generic-get-configuration proj)) - (debug (oref config :debug-command)) - (cmd (read-from-minibuffer - "Debug Command: " - debug)) - (cmdsplit (split-string cmd " " t)) - ;; @TODO - this depends on the user always typing in something good - ;; like "gdb" or "dbx" which also exists as a useful Emacs command. - ;; Is there a better way? - (cmdsym (intern-soft (car cmdsplit)))) - (call-interactively cmdsym t))) - -(defmethod project-run-target ((target ede-generic-target)) - "Run the current project derived from TARGET." - (let* ((proj (ede-target-parent target)) - (config (ede-generic-get-configuration proj)) - (run (concat "./" (oref config :run-command))) - (cmd (read-from-minibuffer "Run (like this): " run))) - (ede-shell-run-something target cmd))) - -;;; Customization -;; -(defmethod ede-customize ((proj ede-generic-project)) - "Customize the EDE project PROJ." - (let ((config (ede-generic-get-configuration proj))) - (eieio-customize-object config))) - -(defmethod ede-customize ((target ede-generic-target)) - "Customize the EDE TARGET." - ;; Nothing unique for the targets, use the project. - (ede-customize-project)) - -(defmethod eieio-done-customizing ((config ede-generic-config)) - "Called when EIEIO is done customizing the configuration object. -We need to go back through the old buffers, and update them with -the new configuration." - (ede-commit config) - ;; Loop over all the open buffers, and re-apply. - (ede-map-targets - (oref config project) - (lambda (target) - (ede-map-target-buffers - target - (lambda (b) - (with-current-buffer b - (ede-apply-target-options))))))) - -(defmethod ede-commit ((config ede-generic-config)) - "Commit all changes to the configuration to disk." - (eieio-persistent-save config)) - ;;; Creating Derived Projects: ;; ;; Derived projects need an autoloader so that EDE can find the @@ -415,13 +266,16 @@ the class `ede-generic-project' project." :name external-name :file 'ede/generic :proj-file projectfile + :root-only nil :load-type 'ede-generic-load :class-sym class :new-p nil - :safe-p nil) ; @todo - could be - ; safe if we do something - ; about the loading of the - ; generic config file. + ;; NOTE: This project type is SAFE because it handles + ;; the user-query before loading its config file. These + ;; project types are useful without the config file so + ;; do the safe part until the user creates a saved config + ;; file for it. + :safe-p t) ;; Generics must go at the end, since more specific types ;; can create Makefiles also. 'generic)) @@ -436,6 +290,25 @@ the class `ede-generic-project' project." "SConstruct" 'ede-generic-scons-project) (ede-generic-new-autoloader "generic-cmake" "CMake" "CMakeLists" 'ede-generic-cmake-project) + + ;; Super Generic found via revision control tags. + (ede-generic-new-autoloader "generic-git" "Git" + ".git" 'ede-generic-vc-project) + (ede-generic-new-autoloader "generic-bzr" "Bazaar" + ".bzr" 'ede-generic-vc-project) + (ede-generic-new-autoloader "generic-hg" "Mercurial" + ".hg" 'ede-generic-vc-project) + (ede-generic-new-autoloader "generic-svn" "Subversions" + ".svn" 'ede-generic-vc-project) + (ede-generic-new-autoloader "generic-cvs" "CVS" + "CVS" 'ede-generic-vc-project) + + ;; Take advantage of existing 'projectile' based projects. + ;; @TODO - if projectile supports compile commands etc, can we + ;; read that out? Howto if projectile is not part of core emacs. + (ede-generic-new-autoloader "generic-projectile" ".projectile" + ".projectile" 'ede-generic-vc-project) + ) @@ -481,6 +354,15 @@ the class `ede-generic-project' project." (oset config debug-command "gdb ") ) +;;; Generic Version Control System +(defclass ede-generic-vc-project (ede-generic-project) + () + "Generic project found via Version Control files.") + +(defmethod ede-generic-setup-configuration ((proj ede-generic-vc-project) config) + "Setup a configuration for projects identified by revision control." + ) + (provide 'ede/generic) ;; Local variables: diff --git a/lisp/cedet/ede/linux.el b/lisp/cedet/ede/linux.el index a6bb104698b..c962724ce08 100644 --- a/lisp/cedet/ede/linux.el +++ b/lisp/cedet/ede/linux.el @@ -73,37 +73,6 @@ :group 'project-linux :type 'string) -(defvar ede-linux-project-list nil - "List of projects created by option `ede-linux-project'.") - -(defun ede-linux-file-existing (dir) - "Find a Linux project in the list of Linux projects. -DIR is the directory to search from." - (let ((projs ede-linux-project-list) - (ans nil)) - (while (and projs (not ans)) - (let ((root (ede-project-root-directory (car projs)))) - (when (string-match (concat "^" (regexp-quote root)) dir) - (setq ans (car projs)))) - (setq projs (cdr projs))) - ans)) - -;;;###autoload -(defun ede-linux-project-root (&optional dir) - "Get the root directory for DIR." - (when (not dir) (setq dir default-directory)) - (let ((case-fold-search t) - (proj (ede-linux-file-existing dir))) - (if proj - (ede-up-directory (file-name-directory - (oref proj :file))) - ;; No pre-existing project. Let's take a wild-guess if we have - ;; an Linux project here. - (when (string-match "linux[^/]*" dir) - (let ((base (substring dir 0 (match-end 0)))) - (when (file-exists-p (expand-file-name "scripts/ver_linux" base)) - base)))))) - (defun ede-linux-version (dir) "Find the Linux version for the Linux src in DIR." (let ((buff (get-buffer-create " *linux-query*"))) @@ -124,9 +93,8 @@ DIR is the directory to search from." (kill-buffer buff) ))))) -(defclass ede-linux-project (ede-project eieio-instance-tracker) - ((tracking-symbol :initform 'ede-linux-project-list) - (build-directory :initarg :build-directory +(defclass ede-linux-project (ede-project) + ((build-directory :initarg :build-directory :type string :documentation "Build directory.") (architecture :initarg :architecture @@ -226,22 +194,20 @@ until Linux is built for the first time." Return nil if there isn't one. Argument DIR is the directory it is created for. ROOTPROJ is nil, since there is only one project." - (or (ede-linux-file-existing dir) - ;; Doesn't already exist, so let's make one. - (let* ((bdir (ede-linux--get-build-directory dir)) - (arch (ede-linux--get-architecture dir bdir)) - (include-path (ede-linux--include-path dir bdir arch)) - (proj (ede-linux-project - "Linux" - :name "Linux" - :version (ede-linux-version dir) - :directory (file-name-as-directory dir) - :file (expand-file-name "scripts/ver_linux" - dir) - :build-directory bdir - :architecture arch - :include-path include-path))) - (ede-add-project-to-global-list proj)))) + ;; Doesn't already exist, so let's make one. + (let* ((bdir (ede-linux--get-build-directory dir)) + (arch (ede-linux--get-architecture dir bdir)) + (include-path (ede-linux--include-path dir bdir arch))) + (ede-linux-project + "Linux" + :name "Linux" + :version (ede-linux-version dir) + :directory (file-name-as-directory dir) + :file (expand-file-name "scripts/ver_linux" + dir) + :build-directory bdir + :architecture arch + :include-path include-path))) ;;;###autoload (ede-add-project-autoload @@ -249,8 +215,6 @@ ROOTPROJ is nil, since there is only one project." :name "LINUX ROOT" :file 'ede/linux :proj-file "scripts/ver_linux" - :proj-root-dirmatch "linux[^/]*" - :proj-root 'ede-linux-project-root :load-type 'ede-linux-load :class-sym 'ede-linux-project :new-p nil @@ -376,6 +340,8 @@ Knows about how the Linux source tree is organized." (t nil)))) (or F (call-next-method)))) +;;; Command Support +;; (defmethod project-compile-project ((proj ede-linux-project) &optional command) "Compile the entire current project. @@ -412,6 +378,19 @@ Argument COMMAND is the command to use for compiling the target." (compile command))) +(defmethod project-rescan ((this ede-linux-project)) + "Rescan this Linux project from the sources." + (let* ((dir (ede-project-root-directory this)) + (bdir (ede-linux--get-build-directory dir)) + (arch (ede-linux--get-architecture dir bdir)) + (inc (ede-linux--include-path dir bdir arch)) + (ver (ede-linux-version dir))) + (oset this version ver) + (oset this :build-directory bdir) + (oset this :architecture arch) + (oset this :include-path inc) + )) + (provide 'ede/linux) ;; Local variables: diff --git a/lisp/cedet/ede/pconf.el b/lisp/cedet/ede/pconf.el index 0c482112830..b22cd87e1ea 100644 --- a/lisp/cedet/ede/pconf.el +++ b/lisp/cedet/ede/pconf.el @@ -100,7 +100,7 @@ don't do it. A value of nil means to just do it.") (ede-map-targets this 'ede-proj-tweak-autoconf))) ;; Now save (save-buffer) - (setq postcmd "autoreconf -i;") + (setq postcmd "autoreconf -f -i;") ;; Verify a bunch of files that are required by automake. (ede-proj-configure-test-required-file this "AUTHORS") @@ -173,11 +173,14 @@ By flushing, remove any cruft that may be in the file. Subsequent calls to `ede-proj-tweak-autoconf' can restore items removed by flush." nil) + +;; @TODO - No-one calls this ??? (defmethod ede-proj-configure-add-missing ((this ede-proj-target)) "Query if any files needed by THIS provided by automake are missing. Results in --add-missing being passed to automake." nil) +;; @TODO - No-one implements this yet. (defmethod ede-proj-configure-create-missing ((this ede-proj-target)) "Add any missing files for THIS by creating them." nil) diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el index e007528c90a..8e01445233e 100644 --- a/lisp/cedet/ede/proj-elisp.el +++ b/lisp/cedet/ede/proj-elisp.el @@ -267,7 +267,8 @@ is found, such as a `-version' variable, or the standard header." (while paths (ede-proj-elisp-add-path (car paths)) (setq paths (cdr paths)))) - (save-buffer)) ))) + (save-buffer) + (kill-buffer))))) (defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp)) "Flush the configure file (current buffer) to accommodate THIS." diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el index ca039d07115..fd789b3857d 100644 --- a/lisp/cedet/ede/proj.el +++ b/lisp/cedet/ede/proj.el @@ -297,7 +297,7 @@ for the tree being read in. If ROOTPROJ is nil, then assume that the PROJECT being read in is the root project." (save-excursion (let ((ret (eieio-persistent-read (concat project "Project.ede") - ede-proj-project)) + 'ede-proj-project)) (subdirs (directory-files project nil "[^.].*" nil))) (if (not (object-of-class-p ret 'ede-proj-project)) (error "Corrupt project file")) @@ -310,7 +310,7 @@ the PROJECT being read in is the root project." (let ((sd (file-name-as-directory (expand-file-name (car subdirs) project)))) (if (and (file-directory-p sd) - (ede-directory-project-p sd)) + (file-exists-p (expand-file-name "Project.ede" sd))) (oset ret subproj (cons (ede-proj-load sd (or rootproj ret)) (oref ret subproj)))) @@ -690,7 +690,10 @@ Optional argument FORCE will force items to be regenerated." "Rescan the EDE proj project THIS." (let ((root (or (ede-project-root this) this)) ) - (setq ede-projects (delq root ede-projects)) + ;; @TODO - VERIFY THE BELOW WORKS + (ede-project-directory-remove-hash + (file-name-directory (ede-project-root-directory root))) + (ede-delete-project-from-global-list root) ;; NOTE : parent function double-checks that this dir was ;; already in memory once. (ede-load-project-file (ede-project-root-directory root)) diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el index 3a66a49e432..d0ca8091c90 100644 --- a/lisp/cedet/ede/project-am.el +++ b/lisp/cedet/ede/project-am.el @@ -409,7 +409,7 @@ Argument COMMAND is the command to use for compiling the target." (setq default-directory dd) (setq cmd (read-from-minibuffer "Run (like this): " - (concat (ede-target-name obj)))) + (concat "./" (ede-target-name obj)))) (ede-shell-run-something obj cmd)) (kill-buffer tb)))) @@ -428,12 +428,8 @@ Argument COMMAND is the command to use for compiling the target." If a given set of projects has already been loaded, then do nothing but return the project for the directory given. Optional ROOTPROJ is the root EDE project." - (let* ((ede-constructing t) - (amo (object-assoc (expand-file-name "Makefile.am" directory) - 'file ede-projects))) - (when (not amo) - (setq amo (project-am-load-makefile directory))) - amo)) + ;; Just jump into creating the project from the Makefiles. + (project-am-load-makefile directory)) (defun project-am-find-topmost-level (dir) "Find the topmost automakefile starting with DIR." @@ -857,13 +853,13 @@ Argument FILE is the file to extract the end directory name from." (defun project-am-preferred-target-type (file) "For FILE, return the preferred type for that file." (cond ((string-match "\\.texi?\\(nfo\\)$" file) - project-am-texinfo) + 'project-am-texinfo) ((string-match "\\.[0-9]$" file) - project-am-man) + 'project-am-man) ((string-match "\\.el$" file) - project-am-lisp) + 'project-am-lisp) (t - project-am-program))) + 'project-am-program))) (defmethod ede-buffer-header-file((this project-am-objectcode) buffer) "There are no default header files." diff --git a/lisp/cedet/ede/shell.el b/lisp/cedet/ede/shell.el index 1f94e0d2f92..e15ca19ac54 100644 --- a/lisp/cedet/ede/shell.el +++ b/lisp/cedet/ede/shell.el @@ -42,10 +42,15 @@ COMMAND is a text string representing the thing to be run." ;; Show the new buffer. (when (not (get-buffer-window buff)) (switch-to-buffer-other-window buff t)) - ;; Force a shell into the buffer. - (shell buff) - (while (eq (point-min) (point)) - (accept-process-output)) + ;; Force a shell into the buffer, but only if the buffer + ;; doesn't already have a shell in it. + ;; Newer versions of `shell' pop the window forward. + (set-buffer buff) + (when (not (eq major-mode 'shell-mode)) + (shell buff) + ;; Make sure the shell has started. + (while (eq (point-min) (point)) + (accept-process-output))) ;; Change the default directory (if (not (string= (file-name-as-directory (expand-file-name default-directory)) (file-name-as-directory (expand-file-name dd)))) diff --git a/lisp/cedet/ede/speedbar.el b/lisp/cedet/ede/speedbar.el index fc26ec948a2..e08562a3738 100644 --- a/lisp/cedet/ede/speedbar.el +++ b/lisp/cedet/ede/speedbar.el @@ -121,9 +121,9 @@ Argument DIR is the directory from which to derive the list of objects." (let ((obj (eieio-speedbar-find-nearest-object))) (if (not (eieio-object-p obj)) nil - (cond ((obj-of-class-p obj ede-project) + (cond ((obj-of-class-p obj 'ede-project) (project-compile-project obj)) - ((obj-of-class-p obj ede-target) + ((obj-of-class-p obj 'ede-target) (project-compile-target obj)) (t (error "Error in speedbar structure")))))) @@ -133,9 +133,9 @@ Argument DIR is the directory from which to derive the list of objects." (let ((obj (eieio-speedbar-find-nearest-object))) (if (not (eieio-object-p obj)) (error "Error in speedbar or ede structure") - (if (obj-of-class-p obj ede-target) + (if (obj-of-class-p obj 'ede-target) (setq obj (ede-target-parent obj))) - (if (obj-of-class-p obj ede-project) + (if (obj-of-class-p obj 'ede-project) obj (error "Error in speedbar or ede structure"))))) diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el index e4d338ee58b..89d44c20a6f 100644 --- a/lisp/cedet/pulse.el +++ b/lisp/cedet/pulse.el @@ -227,13 +227,15 @@ Optional argument FACE specifies the face to do the highlighting." (defun pulse-momentary-highlight-one-line (point &optional face) "Highlight the line around POINT, unhighlighting before next command. Optional argument FACE specifies the face to do the highlighting." - (let ((start (point-at-bol)) - (end (save-excursion - (end-of-line) - (when (not (eobp)) - (forward-char 1)) - (point)))) - (pulse-momentary-highlight-region start end face))) + (save-excursion + (goto-char point) + (let ((start (point-at-bol)) + (end (save-excursion + (end-of-line) + (when (not (eobp)) + (forward-char 1)) + (point)))) + (pulse-momentary-highlight-region start end face)))) (defun pulse-momentary-highlight-region (start end &optional face) "Highlight between START and END, unhighlighting before next command. diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index 5fc96ad6148..81a97884554 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -382,7 +382,7 @@ Arguments START and END bound the time being calculated." (defun bovinate (&optional clear) "Parse the current buffer. Show output in a temp buffer. Optional argument CLEAR will clear the cache before parsing. -If CLEAR is negative, it will do a full reparse, and also not display +If CLEAR is negative, it will do a full reparse, and also display the output buffer." (interactive "P") (if clear (semantic-clear-toplevel-cache)) @@ -392,7 +392,8 @@ the output buffer." (end (current-time))) (message "Retrieving tags took %.2f seconds." (semantic-elapsed-time start end)) - (when (or (null clear) (not (listp clear))) + (when (or (null clear) (not (listp clear)) + (and (numberp clear) (< 0 clear))) (pop-to-buffer "*Parser Output*") (require 'pp) (erase-buffer) @@ -572,6 +573,7 @@ string." ;; The best way to call the parser from programs is via ;; `semantic-fetch-tags'. This, in turn, uses other internal ;; API functions which plug-in parsers can take advantage of. +(defvar semantic-parser-warnings) (defun semantic-fetch-tags () "Fetch semantic tags from the current buffer. @@ -601,49 +603,49 @@ was marked unparseable, then do nothing, and return the cache." (garbage-collect) (cond -;;;; Try the incremental parser to do a fast update. - ((semantic-parse-tree-needs-update-p) - (setq res (semantic-parse-changes)) - (if (semantic-parse-tree-needs-rebuild-p) - ;; If the partial reparse fails, jump to a full reparse. - (semantic-fetch-tags) - ;; Clear the cache of unmatched syntax tokens - ;; - ;; NOTE TO SELF: - ;; - ;; Move this into the incremental parser. This is a bug. - ;; - (semantic-clear-unmatched-syntax-cache) - (run-hook-with-args ;; Let hooks know the updated tags - 'semantic-after-partial-cache-change-hook res)) - (setq semantic--completion-cache nil)) - -;;;; Parse the whole system. - ((semantic-parse-tree-needs-rebuild-p) - ;; Use Emacs's built-in progress-reporter (only interactive). - (if noninteractive - (setq res (semantic-parse-region (point-min) (point-max))) - (let ((semantic--progress-reporter - (and (>= (point-max) semantic-minimum-working-buffer-size) - (eq semantic-working-type 'percent) - (make-progress-reporter - (semantic-parser-working-message (buffer-name)) - 0 100)))) - (setq res (semantic-parse-region (point-min) (point-max))) - (if semantic--progress-reporter - (progress-reporter-done semantic--progress-reporter)))) - - ;; Clear the caches when we see there were no errors. - ;; But preserve the unmatched syntax cache and warnings! - (let (semantic-unmatched-syntax-cache - semantic-unmatched-syntax-cache-check - semantic-parser-warnings) - (semantic-clear-toplevel-cache)) - ;; Set up the new overlays - (semantic--tag-link-list-to-buffer res) - ;; Set up the cache with the new results - (semantic--set-buffer-cache res) - )))) + ;; Try the incremental parser to do a fast update. + ((semantic-parse-tree-needs-update-p) + (setq res (semantic-parse-changes)) + (if (semantic-parse-tree-needs-rebuild-p) + ;; If the partial reparse fails, jump to a full reparse. + (semantic-fetch-tags) + ;; Clear the cache of unmatched syntax tokens + ;; + ;; NOTE TO SELF: + ;; + ;; Move this into the incremental parser. This is a bug. + ;; + (semantic-clear-unmatched-syntax-cache) + (run-hook-with-args ;; Let hooks know the updated tags + 'semantic-after-partial-cache-change-hook res)) + (setq semantic--completion-cache nil)) + + ;; Parse the whole system. + ((semantic-parse-tree-needs-rebuild-p) + ;; Use Emacs's built-in progress-reporter (only interactive). + (if noninteractive + (setq res (semantic-parse-region (point-min) (point-max))) + (let ((semantic--progress-reporter + (and (>= (point-max) semantic-minimum-working-buffer-size) + (eq semantic-working-type 'percent) + (make-progress-reporter + (semantic-parser-working-message (buffer-name)) + 0 100)))) + (setq res (semantic-parse-region (point-min) (point-max))) + (if semantic--progress-reporter + (progress-reporter-done semantic--progress-reporter)))) + + ;; Clear the caches when we see there were no errors. + ;; But preserve the unmatched syntax cache and warnings! + (let (semantic-unmatched-syntax-cache + semantic-unmatched-syntax-cache-check + semantic-parser-warnings) + (semantic-clear-toplevel-cache)) + ;; Set up the new overlays + (semantic--tag-link-list-to-buffer res) + ;; Set up the cache with the new results + (semantic--set-buffer-cache res) + )))) ;; Always return the current parse tree. semantic--buffer-cache) @@ -1126,8 +1128,16 @@ Semantic mode. ;; Add semantic-ia-complete-symbol to ;; completion-at-point-functions, so that it is run from ;; M-TAB. + ;; + ;; Note: The first entry added is the last entry run, so the + ;; most specific entry should be last. (add-hook 'completion-at-point-functions - 'semantic-completion-at-point-function) + 'semantic-analyze-nolongprefix-completion-at-point-function) + (add-hook 'completion-at-point-functions + 'semantic-analyze-notc-completion-at-point-function) + (add-hook 'completion-at-point-functions + 'semantic-analyze-completion-at-point-function) + (if global-ede-mode (define-key cedet-menu-map [cedet-menu-separator] '("--"))) (dolist (b (buffer-list)) @@ -1139,7 +1149,12 @@ Semantic mode. ;; Semantic can be re-activated cleanly. (remove-hook 'mode-local-init-hook 'semantic-new-buffer-fcn) (remove-hook 'completion-at-point-functions - 'semantic-completion-at-point-function) + 'semantic-analyze-completion-at-point-function) + (remove-hook 'completion-at-point-functions + 'semantic-analyze-notc-completion-at-point-function) + (remove-hook 'completion-at-point-functions + 'semantic-analyze-nolongprefix-completion-at-point-function) + (remove-hook 'after-change-functions 'semantic-change-function) (define-key cedet-menu-map [cedet-menu-separator] nil) @@ -1155,8 +1170,56 @@ Semantic mode. ;; re-activated. (setq semantic-new-buffer-fcn-was-run nil))) -(defun semantic-completion-at-point-function () - 'semantic-ia-complete-symbol) +;;; Completion At Point functions +(defun semantic-analyze-completion-at-point-function () + "Return possible analysis completions at point. +The completions provided are via `semantic-analyze-possible-completions'. +This function can be used by `completion-at-point-functions'." + (when (semantic-active-p) + (let* ((ctxt (semantic-analyze-current-context)) + (possible (semantic-analyze-possible-completions ctxt))) + + ;; The return from this is either: + ;; nil - not applicable here. + ;; A list: (START END COLLECTION . PROPS) + (when possible + (list (car (oref ctxt bounds)) + (cdr (oref ctxt bounds)) + possible)) + ))) + +(defun semantic-analyze-notc-completion-at-point-function () + "Return possible analysis completions at point. +The completions provided are via `semantic-analyze-possible-completions', +but with the 'no-tc option passed in, which means constraints based +on what is being assigned to are ignored. +This function can be used by `completion-at-point-functions'." + (when (semantic-active-p) + (let* ((ctxt (semantic-analyze-current-context)) + (possible (semantic-analyze-possible-completions ctxt 'no-tc))) + + (when possible + (list (car (oref ctxt bounds)) + (cdr (oref ctxt bounds)) + possible)) + ))) + +(defun semantic-analyze-nolongprefix-completion-at-point-function () + "Return possible analysis completions at point. +The completions provided are via `semantic-analyze-possible-completions', +but with the 'no-tc and 'no-longprefix option passed in, which means +constraints resulting in a long multi-symbol dereference are ignored. +This function can be used by `completion-at-point-functions'." + (when (semantic-active-p) + (let* ((ctxt (semantic-analyze-current-context)) + (possible (semantic-analyze-possible-completions + ctxt 'no-tc 'no-longprefix))) + + (when possible + (list (car (oref ctxt bounds)) + (cdr (oref ctxt bounds)) + possible)) + ))) ;;; Autoload some functions that are not in semantic/loaddefs diff --git a/lisp/cedet/semantic/analyze.el b/lisp/cedet/semantic/analyze.el index caf42dec93f..846501e13cc 100644 --- a/lisp/cedet/semantic/analyze.el +++ b/lisp/cedet/semantic/analyze.el @@ -226,8 +226,8 @@ Optional argument DESIRED-TYPE may be a non-type tag to analyze." ;; by an application that doesn't need to calculate the full ;; context. -(define-overloadable-function semantic-analyze-find-tag-sequence (sequence &optional - scope typereturn throwsym) +(define-overloadable-function semantic-analyze-find-tag-sequence + (sequence &optional scope typereturn throwsym &rest flags) "Attempt to find all tags in SEQUENCE. Optional argument LOCALVAR is the list of local variables to use when finding the details on the first element of SEQUENCE in case @@ -237,53 +237,67 @@ scoped. These are not local variables, but symbols available in a structure which doesn't need to be dereferenced. Optional argument TYPERETURN is a symbol in which the types of all found will be stored. If nil, that data is thrown away. -Optional argument THROWSYM specifies a symbol the throw on non-recoverable error.") +Optional argument THROWSYM specifies a symbol the throw on non-recoverable error. +Remaining arguments FLAGS are additional flags to apply when searching.") -(defun semantic-analyze-find-tag-sequence-default (sequence &optional - scope typereturn - throwsym) +(defun semantic-analyze-find-tag-sequence-default + ;; Note: overloadable fcn uses &rest, but it is a list already, so we don't need + ;; to do that in the -default. + (sequence &optional scope typereturn throwsym flags) "Attempt to find all tags in SEQUENCE. SCOPE are extra tags which are in scope. TYPERETURN is a symbol in which to place a list of tag classes that are found in SEQUENCE. -Optional argument THROWSYM specifies a symbol the throw on non-recoverable error." +Optional argument THROWSYM specifies a symbol the throw on non-recoverable error. +Remaining arguments FLAGS are additional flags to apply when searching. +This function knows of flags: + 'mustbeclassvariable" (let ((s sequence) ; copy of the sequence (tmp nil) ; tmp find variable (tag nil) ; tag return list (tagtype nil) ; tag types return list (fname nil) (miniscope (when scope (clone scope))) + (tagclass (if (memq 'mustbeclassvariable flags) + 'variable nil)) ) ;; First order check. Is this wholly contained in the typecache? (setq tmp (semanticdb-typecache-find sequence)) - - (if tmp - (progn + + (when tmp + (if (or (not tagclass) (semantic-tag-of-class-p tmp tagclass)) ;; We are effectively done... - (setq s nil) - (setq tag (list tmp))) - - ;; For the first entry, it better be a variable, but it might - ;; be in the local context too. - ;; NOTE: Don't forget c++ namespace foo::bar. - (setq tmp (or - ;; Is this tag within our scope. Scopes can sometimes - ;; shadow other things, so it goes first. - (and scope (semantic-scope-find (car s) nil scope)) - ;; Find the tag out there... somewhere, but not in scope - (semantic-analyze-find-tag (car s)) - )) - - (if (and (listp tmp) (semantic-tag-p (car tmp))) - (setq tmp (semantic-analyze-select-best-tag tmp))) - (if (not (semantic-tag-p tmp)) - (if throwsym - (throw throwsym "Cannot find definition") - (error "Cannot find definition for \"%s\"" (car s)))) - (setq s (cdr s)) - (setq tag (cons tmp tag)) ; tag is nil here... - (setq fname (semantic-tag-file-name tmp)) - ) + (setq s nil + tag (list tmp)) + ;; tagclass doesn't match, so fail this. + (setq tmp nil))) + + (unless tmp + ;; For tag class filtering, only apply the filter if the first entry + ;; is also the only entry. + (let ((lftagclass (if (= (length s) 1) tagclass))) + + ;; For the first entry, it better be a variable, but it might + ;; be in the local context too. + ;; NOTE: Don't forget c++ namespace foo::bar. + (setq tmp (or + ;; Is this tag within our scope. Scopes can sometimes + ;; shadow other things, so it goes first. + (and scope (semantic-scope-find (car s) lftagclass scope)) + ;; Find the tag out there... somewhere, but not in scope + (semantic-analyze-find-tag (car s) lftagclass) + )) + + (if (and (listp tmp) (semantic-tag-p (car tmp))) + (setq tmp (semantic-analyze-select-best-tag tmp lftagclass))) + (if (not (semantic-tag-p tmp)) + (if throwsym + (throw throwsym "Cannot find definition") + (error "Cannot find definition for \"%s\"" (car s)))) + (setq s (cdr s)) + (setq tag (cons tmp tag)) ; tag is nil here... + (setq fname (semantic-tag-file-name tmp)) + )) ;; For the middle entries (while s @@ -382,7 +396,8 @@ searches use the same arguments." ;; Search in the typecache. First entries in a sequence are ;; often there. (setq retlist (semanticdb-typecache-find name)) - (if retlist + (if (and retlist (or (not tagclass) + (semantic-tag-of-class-p retlist 'tagclass))) retlist (semantic-analyze-select-best-tag (semanticdb-strip-find-results @@ -647,7 +662,7 @@ Returns an object based on symbol `semantic-analyze-context'." ;; We have some sort of an assignment (condition-case err (setq asstag (semantic-analyze-find-tag-sequence - assign scope)) + assign scope nil nil 'mustbeclassvariable)) (error (semantic-analyze-push-error err) nil))) @@ -746,22 +761,26 @@ Some useful functions are found in `semantic-format-tag-functions'." "Send the tag SEQUENCE to standard out. Use PREFIX as a label. Use BUFF as a source of override methods." + ;; If there is no sequence, at least show the field as being empty. + (unless sequence (princ prefix) (princ "<none>\n")) + + ;; Display the sequence column aligned. (while sequence - (princ prefix) - (cond - ((semantic-tag-p (car sequence)) - (princ (funcall semantic-analyze-summary-function - (car sequence)))) - ((stringp (car sequence)) - (princ "\"") - (princ (semantic--format-colorize-text (car sequence) 'variable)) - (princ "\"")) - (t - (princ (format "'%S" (car sequence))))) - (princ "\n") - (setq sequence (cdr sequence)) - (setq prefix (make-string (length prefix) ? )) - )) + (princ prefix) + (cond + ((semantic-tag-p (car sequence)) + (princ (funcall semantic-analyze-summary-function + (car sequence)))) + ((stringp (car sequence)) + (princ "\"") + (princ (semantic--format-colorize-text (car sequence) 'variable)) + (princ "\"")) + (t + (princ (format "'%S" (car sequence))))) + (princ "\n") + (setq sequence (cdr sequence)) + (setq prefix (make-string (length prefix) ? )) + )) (defmethod semantic-analyze-show ((context semantic-analyze-context)) "Insert CONTEXT into the current buffer in a nice way." diff --git a/lisp/cedet/semantic/analyze/complete.el b/lisp/cedet/semantic/analyze/complete.el index a6ac05e0114..c47b57336c5 100644 --- a/lisp/cedet/semantic/analyze/complete.el +++ b/lisp/cedet/semantic/analyze/complete.el @@ -112,8 +112,9 @@ in a buffer." Argument CONTEXT is an object specifying the locally derived context. The optional argument FLAGS changes which return options are returned. FLAGS can be any number of: - 'no-tc - do not apply data-type constraint. - 'no-unique - do not apply unique by name filtering." + 'no-tc - do not apply data-type constraint. + 'no-longprefix - ignore long multi-symbol prefixes. + 'no-unique - do not apply unique by name filtering." (let* ((a context) (desired-type (semantic-analyze-type-constraint a)) (desired-class (oref a prefixclass)) @@ -127,9 +128,16 @@ FLAGS can be any number of: (c nil) (any nil) (do-typeconstraint (not (memq 'no-tc flags))) + (do-longprefix (not (memq 'no-longprefix flags))) (do-unique (not (memq 'no-unique flags))) ) + (when (not do-longprefix) + ;; If we are not doing the long prefix, shorten all the key + ;; elements. + (setq prefix (list (car (reverse prefix))) + prefixtypes nil)) + ;; Calculate what our prefix string is so that we can ;; find all our matching text. (setq completetext (car (reverse prefix))) diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el index e3d78bfad79..aa93e246cc8 100644 --- a/lisp/cedet/semantic/bovine/c.el +++ b/lisp/cedet/semantic/bovine/c.el @@ -270,7 +270,7 @@ Return the defined symbol as a special spp lex token." (if (looking-back "/\\*.*" beginning-of-define) (progn (goto-char (match-beginning 0)) - (1- (point))) + (point)) (point))))) ) @@ -501,7 +501,13 @@ code to parse." (hif-canonicalize) (error nil)))) - (let ((eval-form (eval parsedtokelist))) + (let ((eval-form (condition-case err + (eval parsedtokelist) + (error + (semantic-push-parser-warning + (format "Hideif forms produced an error. Assuming false.\n%S" err) + (point) (1+ (point))) + nil)))) (if (or (not eval-form) (and (numberp eval-form) (equal eval-form 0)));; ifdef line resulted in false diff --git a/lisp/cedet/semantic/bovine/grammar.el b/lisp/cedet/semantic/bovine/grammar.el index b26f6d92f6c..ebe2fd1d82e 100644 --- a/lisp/cedet/semantic/bovine/grammar.el +++ b/lisp/cedet/semantic/bovine/grammar.el @@ -395,16 +395,33 @@ manual." (insert ")\n") (buffer-string)))) +(defun bovine-grammar-calculate-source-on-path () + "Calculate the location of the source for current buffer. +The source directory is relative to some root in the load path." + (condition-case nil + (let* ((dir (nreverse (split-string (buffer-file-name) "/"))) + (newdir (car dir))) + (setq dir (cdr dir)) + ;; Keep trying the file name until it is on the path. + (while (and (not (locate-library newdir)) dir) + (setq newdir (concat (car dir) "/" newdir) + dir (cdr dir))) + (if (not dir) + (buffer-name) + newdir)) + (error (buffer-name)))) + (defun bovine-grammar-setupcode-builder () "Return the text of the setup code." (format "(setq semantic--parse-table %s\n\ semantic-debug-parser-source %S\n\ semantic-debug-parser-class 'semantic-bovine-debug-parser + semantic-debug-parser-debugger-source 'semantic/bovine/debug semantic-flex-keywords-obarray %s\n\ %s)" (semantic-grammar-parsetable) - (buffer-name) + (bovine-grammar-calculate-source-on-path) (semantic-grammar-keywordtable) (let ((mode (semantic-grammar-languagemode))) ;; Is there more than one major mode? diff --git a/lisp/cedet/semantic/bovine/make.el b/lisp/cedet/semantic/bovine/make.el index 6ba02ee2006..c001a4dab5f 100644 --- a/lisp/cedet/semantic/bovine/make.el +++ b/lisp/cedet/semantic/bovine/make.el @@ -178,9 +178,8 @@ This is the same as a regular prototype." makefile-mode (context) "Return a list of possible completions in a Makefile. Uses default implementation, and also gets a list of filenames." - (save-excursion - (require 'semantic/analyze/complete) - (set-buffer (oref context buffer)) + (require 'semantic/analyze/complete) + (with-current-buffer (oref context buffer) (let* ((normal (semantic-analyze-possible-completions-default context)) (classes (oref context :prefixclass)) (filetags nil)) diff --git a/lisp/cedet/semantic/bovine/scm.el b/lisp/cedet/semantic/bovine/scm.el index b6578430268..8b99e700920 100644 --- a/lisp/cedet/semantic/bovine/scm.el +++ b/lisp/cedet/semantic/bovine/scm.el @@ -69,7 +69,7 @@ Attempts a simple prototype for calling or using TAG." ;; Note: Analyzer from Henry S. Thompson (define-lex-regex-analyzer semantic-lex-scheme-symbol "Detect and create symbol and keyword tokens." - "\\(\\sw\\([:]\\|\\sw\\|\\s_\\)+\\)" + "\\(\\sw\\([:]\\|\\sw\\|\\s_\\)*\\)" ;; (message (format "symbol: %s" (match-string 0))) (semantic-lex-push-token (semantic-lex-token diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el index 18d9bc2146d..3f726ee56fd 100644 --- a/lisp/cedet/semantic/complete.el +++ b/lisp/cedet/semantic/complete.el @@ -118,6 +118,7 @@ (eval-when-compile ;; For the semantic-find-tags-for-completion macro. (require 'semantic/find)) +(require 'semantic/db-find) ;For type semanticdb-find-result-with-nil. ;;; Code: @@ -187,6 +188,8 @@ Value should be a ... what?") "Default history variable for any unhistoried prompt. Keeps STRINGS only in the history.") +(defvar semantic-complete-active-default) +(defvar semantic-complete-current-matched-tag) (defun semantic-complete-read-tag-engine (collector displayor prompt default-tag initial-input @@ -1870,7 +1873,7 @@ completion text in ghost text." (list 'const :tag doc1 C))) - (eieio-build-class-alist semantic-displayor-abstract t)) + (eieio-build-class-alist 'semantic-displayor-abstract t)) ) "Possible options for inline completion displayors. Use this to enable custom editing.") diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el index 6ed3cdb7eb5..2590dd1208d 100644 --- a/lisp/cedet/semantic/db-ebrowse.el +++ b/lisp/cedet/semantic/db-ebrowse.el @@ -192,7 +192,7 @@ is specified by `semanticdb-default-save-directory'." If DIRECTORY is found to be defunct, it won't load the DB, and will warn instead." (if (file-directory-p directory) - (semanticdb-create-database semanticdb-project-database-ebrowse + (semanticdb-create-database 'semanticdb-project-database-ebrowse directory) (let* ((BF (semanticdb-ebrowse-file-for-directory directory)) (BFL (concat BF "-load.el")) diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el index bd65f49023c..be9ffe31b87 100644 --- a/lisp/cedet/semantic/db-el.el +++ b/lisp/cedet/semantic/db-el.el @@ -223,7 +223,9 @@ TOKTYPE is a hint to the type of tag desired." (symbol-name sym) "class" (semantic-elisp-desymbolify - (eieio--class-public-a (class-v semanticdb-project-database))) ;; slots + ;; FIXME: This only gives the instance slots and ignores the + ;; class-allocated slots. + (eieio--class-public-a (find-class 'semanticdb-project-database))) ;; slots ;FIXME: eieio-- (semantic-elisp-desymbolify (eieio-class-parents sym)) ;; parents )) ((not toktype) diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el index 5b76d851b1d..0360e0680e7 100644 --- a/lisp/cedet/semantic/db-file.el +++ b/lisp/cedet/semantic/db-file.el @@ -158,7 +158,8 @@ If DIRECTORY doesn't exist, create a new one." (defun semanticdb-load-database (filename) "Load the database FILENAME." (condition-case foo - (let* ((r (eieio-persistent-read filename semanticdb-project-database-file)) + (let* ((r (eieio-persistent-read filename + 'semanticdb-project-database-file)) (c (semanticdb-get-database-tables r)) (tv (oref r semantic-tag-version)) (fv (oref r semanticdb-version)) diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el index 08a22fb3b85..dd36cc1a01e 100644 --- a/lisp/cedet/semantic/db-find.el +++ b/lisp/cedet/semantic/db-find.el @@ -1114,7 +1114,7 @@ for backward compatibility. If optional argument BRUTISH is non-nil, then ignore include statements, and search all tables in this project tree." (let (found match) - (save-excursion + (save-current-buffer ;; If path is a buffer, set ourselves up in that buffer ;; so that the override methods work correctly. (when (bufferp path) (set-buffer path)) @@ -1127,7 +1127,7 @@ and search all tables in this project tree." ;; databases and not associated with a file. (unless (and find-file-match (obj-of-class-p - (car tableandtags) semanticdb-search-results-table)) + (car tableandtags) 'semanticdb-search-results-table)) (when (setq match (funcall function (car tableandtags) (cdr tableandtags))) (when find-file-match @@ -1144,7 +1144,7 @@ and search all tables in this project tree." ;; `semanticdb-search-results-table', since those are system ;; databases and not associated with a file. (unless (and find-file-match - (obj-of-class-p table semanticdb-search-results-table)) + (obj-of-class-p table 'semanticdb-search-results-table)) (when (and table (setq match (funcall function table nil))) (semanticdb-find-log-activity table match) (when find-file-match diff --git a/lisp/cedet/semantic/db-typecache.el b/lisp/cedet/semantic/db-typecache.el index eb00a57cddd..723b7bd28bc 100644 --- a/lisp/cedet/semantic/db-typecache.el +++ b/lisp/cedet/semantic/db-typecache.el @@ -180,7 +180,7 @@ If there is no table, create one, and fill it in." (defmethod semanticdb-get-typecache ((db semanticdb-project-database)) "Retrieve the typecache from the semantic database DB. If there is no table, create one, and fill it in." - (semanticdb-cache-get db semanticdb-database-typecache) + (semanticdb-cache-get db 'semanticdb-database-typecache) ) diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el index 7a73cee68c9..b2c1252c502 100644 --- a/lisp/cedet/semantic/db.el +++ b/lisp/cedet/semantic/db.el @@ -124,6 +124,18 @@ for a new table not associated with a buffer." If the buffer is not in memory, load it with `find-file-noselect'." nil) +;; This generic method allows for sloppier coding. Many +;; functions treat "table" as something that could be a buffer, +;; file name, or other. This makes use of table more robust. +(defmethod semanticdb-full-filename (buffer-or-string) + "Fetch the full filename that BUFFER-OR-STRING refers to. +This uses semanticdb to get a better file name." + (cond ((bufferp buffer-or-string) + (with-current-buffer buffer-or-string + (semanticdb-full-filename semanticdb-current-table))) + ((and (stringp buffer-or-string) (file-exists-p buffer-or-string)) + (expand-file-name buffer-or-string)))) + (defmethod semanticdb-full-filename ((obj semanticdb-abstract-table)) "Fetch the full filename that OBJ refers to. Abstract tables do not have file names associated with them." @@ -318,6 +330,10 @@ Adds the number of tags in this file to the object print name." ;;; DATABASE BASE CLASS ;; +(unless (fboundp 'semanticdb-abstract-table-list-p) + (cl-deftype semanticdb-abstract-table-list () + '(list-of semanticdb-abstract-table))) + (defclass semanticdb-project-database (eieio-instance-tracker) ((tracking-symbol :initform semanticdb-database-list) (reference-directory :type string @@ -469,7 +485,7 @@ other than :table." (let ((cache (oref table cache)) (obj nil)) (while (and (not obj) cache) - (if (eq (eieio--object-class (car cache)) desired-class) + (if (eq (eieio-object-class (car cache)) desired-class) (setq obj (car cache))) (setq cache (cdr cache))) (if obj @@ -520,7 +536,7 @@ other than :table." (let ((cache (oref db cache)) (obj nil)) (while (and (not obj) cache) - (if (eq (eieio--object-class (car cache)) desired-class) + (if (eq (eieio-object-class (car cache)) desired-class) (setq obj (car cache))) (setq cache (cdr cache))) (if obj diff --git a/lisp/cedet/semantic/debug.el b/lisp/cedet/semantic/debug.el index 9f5bb709332..9168af59dd4 100644 --- a/lisp/cedet/semantic/debug.el +++ b/lisp/cedet/semantic/debug.el @@ -57,6 +57,12 @@ to one of the parser generators.") ;;;###autoload (make-variable-buffer-local 'semantic-debug-parser-class) +;;;###autoload +(defvar semantic-debug-parser-debugger-source nil + "Location of the debug parser class.") +;;;###autoload +(make-variable-buffer-local 'semantic-debug-parser-source) + (defvar semantic-debug-enabled nil "Non-nil when debugging a parser.") @@ -104,6 +110,7 @@ These buffers are brought into view when layout occurs.") "The currently displayed frame.") (overlays :type list :initarg nil + :initform nil :documentation "Any active overlays being used to show the debug position.") ) @@ -323,15 +330,18 @@ Argument ONOFF is non-nil when we are entering debug mode. (oref semantic-debug-current-interface parser-buffer) (use-local-map (oref semantic-debug-current-interface parser-local-map)) + (setq buffer-read-only nil) ) (with-current-buffer (oref semantic-debug-current-interface source-buffer) (use-local-map (oref semantic-debug-current-interface source-local-map)) + (setq buffer-read-only nil) ) (run-hooks 'semantic-debug-exit-hook) ))) +;;;###autoload (defun semantic-debug () "Parse the current buffer and run in debug mode." (interactive) @@ -341,6 +351,9 @@ Argument ONOFF is non-nil when we are entering debug mode. (error "This major mode does not support parser debugging")) ;; Clear the cache to force a full reparse. (semantic-clear-toplevel-cache) + ;; Load in the debugger for this file. + (when semantic-debug-parser-debugger-source + (require semantic-debug-parser-debugger-source)) ;; Do the parse (let ((semantic-debug-enabled t) ;; Create an interface diff --git a/lisp/cedet/semantic/doc.el b/lisp/cedet/semantic/doc.el index e08254790a5..874763f0a7f 100644 --- a/lisp/cedet/semantic/doc.el +++ b/lisp/cedet/semantic/doc.el @@ -118,7 +118,8 @@ If NOSNARF is 'lex, then return the lex token." (setq ct (concat (substring ct 0 (match-beginning 0)) (substring ct (match-end 0))))) ;; Remove comment delimiter at the end of the string. - (when (string-match (concat (regexp-quote comment-end) "$") ct) + (when (and comment-end (not (string= comment-end "")) + (string-match (concat (regexp-quote comment-end) "$") ct)) (setq ct (substring ct 0 (match-beginning 0))))) ;; Now return the text. ct)))) diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el index dc3dfa7f55a..67f0cfeea6d 100644 --- a/lisp/cedet/semantic/ede-grammar.el +++ b/lisp/cedet/semantic/ede-grammar.el @@ -213,7 +213,7 @@ Argument THIS is the target that should insert stuff." ;; "Target class for Emacs/Semantic grammar files." nil nil) (ede-proj-register-target "semantic grammar" - semantic-ede-proj-target-grammar) + 'semantic-ede-proj-target-grammar) (provide 'semantic/ede-grammar) diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index 56adf3a6e81..a0c36944d48 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el @@ -378,11 +378,11 @@ If FORMS includes a call to `semantic-throw-on-input', then if a user presses any key during execution, this form macro will exit with the value passed to `semantic-throw-on-input'. If FORMS completes, then the return value is the same as `progn'." + (declare (indent 1)) `(let ((semantic-current-input-throw-symbol ,symbol) (semantic--on-input-start-marker (point-marker))) (catch ,symbol ,@forms))) -(put 'semantic-exit-on-input 'lisp-indent-function 1) (defmacro semantic-throw-on-input (from) "Exit with `throw' when in `semantic-exit-on-input' on user input. @@ -391,15 +391,14 @@ to pass to `throw'. It is recommended to use the name of the function calling this one." `(when (and semantic-current-input-throw-symbol (or (input-pending-p) - (save-excursion - ;; Timers might run during accept-process-output. - ;; If they redisplay, point must be where the user - ;; expects. (Bug#15045) - (set-buffer (marker-buffer - semantic--on-input-start-marker)) - (goto-char (marker-position - semantic--on-input-start-marker)) - (accept-process-output)))) + (with-current-buffer + ;; Timers might run during accept-process-output. + ;; If they redisplay, point must be where the user + ;; expects. (Bug#15045) + (marker-buffer semantic--on-input-start-marker) + (save-excursion + (goto-char semantic--on-input-start-marker) + (accept-process-output))))) (throw semantic-current-input-throw-symbol ,from))) diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index fc62b221665..7a92a12ed53 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -1665,13 +1665,14 @@ Select the buffer containing the tag's definition, and move point there." (declare-function eldoc-get-fnsym-args-string "eldoc") (declare-function eldoc-get-var-docstring "eldoc") +(defvar semantic-grammar-eldoc-last-data (cons nil nil)) + (defun semantic-grammar-eldoc-get-macro-docstring (macro expander) "Return a one-line docstring for the given grammar MACRO. EXPANDER is the name of the function that expands MACRO." (require 'eldoc) - (if (and (eq expander (aref eldoc-last-data 0)) - (eq 'function (aref eldoc-last-data 2))) - (aref eldoc-last-data 1) + (if (eq expander (car semantic-grammar-eldoc-last-data)) + (cdr semantic-grammar-eldoc-last-data) (let ((doc (help-split-fundoc (documentation expander t) expander))) (cond (doc @@ -1684,7 +1685,7 @@ EXPANDER is the name of the function that expands MACRO." (setq doc (eldoc-docstring-format-sym-doc macro (format "==> %s %s" expander doc) 'default)) - (eldoc-last-data-store expander doc 'function)) + (setq semantic-grammar-eldoc-last-data (cons expander doc))) doc))) (define-mode-local-override semantic-idle-summary-current-symbol-info diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el index 5f1f837eac5..2216fa9e964 100644 --- a/lisp/cedet/semantic/ia.el +++ b/lisp/cedet/semantic/ia.el @@ -150,45 +150,47 @@ Completion options are calculated with `semantic-analyze-possible-completions'." :group 'semantic :type semantic-format-tag-custom-list) -;; Disabled - see http://debbugs.gnu.org/14522 -;; ;;;###autoload -;; (defun semantic-ia-complete-symbol-menu (point) -;; "Complete the current symbol via a menu based at POINT. -;; Completion options are calculated with `semantic-analyze-possible-completions'." -;; (interactive "d") -;; (require 'imenu) -;; (let* ((a (semantic-analyze-current-context point)) -;; (syms (semantic-analyze-possible-completions a)) -;; ) -;; ;; Complete this symbol. -;; (if (not syms) -;; (progn -;; (message "No smart completions found. Trying Senator.") -;; (when (semantic-analyze-context-p a) -;; ;; This is a quick way of getting a nice completion list -;; ;; in the menu if the regular context mechanism fails. -;; (senator-completion-menu-popup))) -;; -;; (let* ((menu -;; (mapcar -;; (lambda (tag) -;; (cons -;; (funcall semantic-ia-completion-menu-format-tag-function tag) -;; (vector tag))) -;; syms)) -;; (ans -;; (imenu--mouse-menu -;; ;; XEmacs needs that the menu has at least 2 items. So, -;; ;; include a nil item that will be ignored by imenu. -;; (cons nil menu) -;; (senator-completion-menu-point-as-event) -;; "Completions"))) -;; (when ans -;; (if (not (semantic-tag-p ans)) -;; (setq ans (aref (cdr ans) 0))) -;; (delete-region (car (oref a bounds)) (cdr (oref a bounds))) -;; (semantic-ia-insert-tag ans)) -;; )))) +;;;###autoload +(defun semantic-ia-complete-symbol-menu (point) + "Complete the current symbol via a menu based at POINT. +Completion options are calculated with `semantic-analyze-possible-completions'." + (interactive "d") + (require 'imenu) + (let* ((a (semantic-analyze-current-context point)) + (syms (semantic-analyze-possible-completions a)) + ) + ;; Complete this symbol. + (if (not syms) + (progn + (message "No smart completions found.") + ;; Disabled - see http://debbugs.gnu.org/14522 + ;; (message "No smart completions found. Trying Senator.") + ;; (when (semantic-analyze-context-p a) + ;; ;; This is a quick way of getting a nice completion list + ;; ;; in the menu if the regular context mechanism fails. + ;; (senator-completion-menu-popup)) + ) + + (let* ((menu + (mapcar + (lambda (tag) + (cons + (funcall semantic-ia-completion-menu-format-tag-function tag) + (vector tag))) + syms)) + (ans + (imenu--mouse-menu + ;; XEmacs needs that the menu has at least 2 items. So, + ;; include a nil item that will be ignored by imenu. + (cons nil menu) + `(down-mouse-1 ,(posn-at-point)) + "Completions"))) + (when ans + (if (not (semantic-tag-p ans)) + (setq ans (aref (cdr ans) 0))) + (delete-region (car (oref a bounds)) (cdr (oref a bounds))) + (semantic-ia-insert-tag ans)) + )))) ;;; Completions Tip ;; diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index 8ccfd12c56d..0aa2f9504d9 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -823,7 +823,7 @@ ARGVALUES are values for any arg list, or nil." ;; An analyzer that will push tokens from a macro in place ;; of the macro symbol. ;; -(defun semantic-lex-spp-anlyzer-do-replace (sym val beg end) +(defun semantic-lex-spp-analyzer-do-replace (sym val beg end) "Do the lexical replacement for SYM with VAL. Argument BEG and END specify the bounds of SYM in the buffer." (if (not val) @@ -863,6 +863,9 @@ Argument BEG and END specify the bounds of SYM in the buffer." (setq semantic-lex-end-point end) ) )) +(define-obsolete-function-alias + 'semantic-lex-spp-anlyzer-do-replace + 'semantic-lex-spp-analyzer-do-replace "25.1") (defvar semantic-lex-spp-replacements-enabled t "Non-nil means do replacements when finding keywords. diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el index 2c0dea20107..c56cbc3c126 100644 --- a/lisp/cedet/semantic/scope.el +++ b/lisp/cedet/semantic/scope.el @@ -134,7 +134,7 @@ Saves scoping information between runs of the analyzer.") "Get the current cached scope, and reset it." (when semanticdb-current-table (let ((co (semanticdb-cache-get semanticdb-current-table - semantic-scope-cache))) + 'semantic-scope-cache))) (semantic-reset co)))) (defmethod semantic-scope-set-typecache ((cache semantic-scope-cache) @@ -706,7 +706,7 @@ The class returned from the scope calculation is variable (let* ((TAG (semantic-current-tag)) (scopecache (semanticdb-cache-get semanticdb-current-table - semantic-scope-cache)) + 'semantic-scope-cache)) ) (when (not (semantic-equivalent-tag-p TAG (oref scopecache tag))) (semantic-reset scopecache)) diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el index e0ab868d004..170495e5d61 100644 --- a/lisp/cedet/semantic/symref.el +++ b/lisp/cedet/semantic/symref.el @@ -333,6 +333,25 @@ Use the `semantic-symref-hit-tags' method to get this list.") ) )) +(defvar semantic-symref-recently-opened-buffers nil + "List of buffers opened by `semantic-symref-result-get-tags'.") + +(defun semantic-symref-cleanup-recent-buffers-fcn () + "Hook function to be used in 'post-command-hook' to cleanup buffers. +Buffers collected during symref can result in some files being +opened multiple times for one operation. This will keep buffers open +until the next command is executed." + ;;(message "To Clean Up: %S" semantic-symref-recently-opened-buffers) + (mapc (lambda (buff) + ;; Don't delete any buffers which are being used + ;; upon completion of some command. + (when (not (get-buffer-window buff)) + (kill-buffer buff))) + semantic-symref-recently-opened-buffers) + (setq semantic-symref-recently-opened-buffers nil) + (remove-hook 'post-command-hook 'semantic-symref-cleanup-recent-buffers-fcn) + ) + (defmethod semantic-symref-result-get-tags ((result semantic-symref-result) &optional open-buffers) "Get the list of tags from the symref result RESULT. @@ -347,75 +366,19 @@ already." (txt (oref (oref result :created-by) :searchfor)) (searchtype (oref (oref result :created-by) :searchtype)) (ans nil) - (out nil) - (buffs-to-kill nil)) + (out nil)) (save-excursion - (setq - ans - (mapcar - (lambda (hit) - (let* ((line (car hit)) - (file (cdr hit)) - (buff (find-buffer-visiting file)) - (tag nil) - ) - (cond - ;; We have a buffer already. Check it out. - (buff - (set-buffer buff)) - - ;; We have a table, but it needs a refresh. - ;; This means we should load in that buffer. - (t - (let ((kbuff - (if open-buffers - ;; Even if we keep the buffers open, don't - ;; let EDE ask lots of questions. - (let ((ede-auto-add-method 'never)) - (find-file-noselect file t)) - ;; When not keeping the buffers open, then - ;; don't setup all the fancy froo-froo features - ;; either. - (semantic-find-file-noselect file t)))) - (set-buffer kbuff) - (setq buffs-to-kill (cons kbuff buffs-to-kill)) - (semantic-fetch-tags) - )) - ) - - ;; Too much baggage in goto-line - ;; (goto-line line) - (goto-char (point-min)) - (forward-line (1- line)) - - ;; Search forward for the matching text - (when (re-search-forward (regexp-quote txt) - (point-at-eol) - t) - (goto-char (match-beginning 0)) - ) - - (setq tag (semantic-current-tag)) - - ;; If we are searching for a tag, but bound the tag we are looking - ;; for, see if it resides in some other parent tag. - ;; - ;; If there is no parent tag, then we still need to hang the originator - ;; in our list. - (when (and (eq searchtype 'symbol) - (string= (semantic-tag-name tag) txt)) - (setq tag (or (semantic-current-tag-parent) tag))) - - ;; Copy the tag, which adds a :filename property. - (when tag - (setq tag (semantic-tag-copy tag nil t)) - ;; Ad this hit to the tag. - (semantic--tag-put-property tag :hit (list line))) - tag)) - lines))) + (setq ans (mapcar + (lambda (hit) + (semantic-symref-hit-to-tag-via-buffer + hit txt searchtype open-buffers)) + lines))) ;; Kill off dead buffers, unless we were requested to leave them open. - (when (not open-buffers) - (mapc 'kill-buffer buffs-to-kill)) + (if (not open-buffers) + (add-hook 'post-command-hook 'semantic-symref-cleanup-recent-buffers-fcn) + ;; Else, just clear the saved buffers so they aren't deleted later. + (setq semantic-symref-recently-opened-buffers nil) + ) ;; Strip out duplicates. (dolist (T ans) (if (and T (not (semantic-equivalent-tag-p (car out) T))) @@ -429,6 +392,111 @@ already." ;; Out is reversed... twice (oset result :hit-tags (nreverse out))))) +(defun semantic-symref-hit-to-tag-via-db (hit searchtxt searchtype) + "Convert the symref HIT into a TAG by looking up the tag via a database. +Return the Semantic tag associated with HIT. +SEARCHTXT is the text that is being searched for. +Used to narrow the in-buffer search. +SEARCHTYPE is the type of search (such as 'symbol or 'tagname). +If there is no database, of if the searchtype is wrong, return nil." + ;; Allowed search types for this mechanism: + ;; tagname, tagregexp, tagcompletions + (if (not (memq searchtype '(tagname tagregexp tagcompletions))) + nil + (let* ((line (car hit)) + (file (cdr hit)) + ;; FAIL here vv - don't load is not obeyed if no table found. + (db (semanticdb-file-table-object file t)) + (found nil) + (hit nil) + ) + (cond ((eq searchtype 'tagname) + (setq found (semantic-find-tags-by-name searchtxt db))) + ((eq searchtype 'tagregexp) + (setq found (semantic-find-tags-by-name-regexp searchtxt db))) + ((eq searchtype 'tagcompletions) + (setq found (semantic-find-tags-for-completion searchtxt db))) + ) + ;; Loop over FOUND to see if we can line up a match with a line number. + (when (= (length found) 1) + (setq hit (car found))) + + ;; FAIL here ^^ - symref finds line numbers, but our DB uses character locations. + ;; as such, this is a cheat and we will need to give up. + hit))) + +(defun semantic-symref-hit-to-tag-via-buffer (hit searchtxt searchtype &optional open-buffers) + "Convert the symref HIT into a TAG by looking up the tag via a buffer. +Return the Semantic tag associated with HIT. +SEARCHTXT is the text that is being searched for. +Used to narrow the in-buffer search. +SEARCHTYPE is the type of search (such as 'symbol or 'tagname). +Optional OPEN-BUFFERS, when nil will use a faster version of +`find-file' when a file needs to be opened. If non-nil, then +normal buffer initialization will be used. +This function will leave buffers loaded from a file open, but +will add buffers that must be opened to `semantic-symref-recently-opened-buffers'. +Any caller MUST deal with that variable, either clearing it, or deleting the +buffers that were opened." + (let* ((line (car hit)) + (file (cdr hit)) + (buff (find-buffer-visiting file)) + (tag nil) + ) + (cond + ;; We have a buffer already. Check it out. + (buff + (set-buffer buff)) + + ;; We have a table, but it needs a refresh. + ;; This means we should load in that buffer. + (t + (let ((kbuff + (if open-buffers + ;; Even if we keep the buffers open, don't + ;; let EDE ask lots of questions. + (let ((ede-auto-add-method 'never)) + (find-file-noselect file t)) + ;; When not keeping the buffers open, then + ;; don't setup all the fancy froo-froo features + ;; either. + (semantic-find-file-noselect file t)))) + (set-buffer kbuff) + (push kbuff semantic-symref-recently-opened-buffers) + (semantic-fetch-tags) + )) + ) + + ;; Too much baggage in goto-line + ;; (goto-line line) + (goto-char (point-min)) + (forward-line (1- line)) + + ;; Search forward for the matching text + (when (re-search-forward (regexp-quote searchtxt) + (point-at-eol) + t) + (goto-char (match-beginning 0)) + ) + + (setq tag (semantic-current-tag)) + + ;; If we are searching for a tag, but bound the tag we are looking + ;; for, see if it resides in some other parent tag. + ;; + ;; If there is no parent tag, then we still need to hang the originator + ;; in our list. + (when (and (eq searchtype 'symbol) + (string= (semantic-tag-name tag) searchtxt)) + (setq tag (or (semantic-current-tag-parent) tag))) + + ;; Copy the tag, which adds a :filename property. + (when tag + (setq tag (semantic-tag-copy tag nil t)) + ;; Ad this hit to the tag. + (semantic--tag-put-property tag :hit (list line))) + tag)) + ;;; SYMREF TOOLS ;; ;; The base symref tool provides something to hang new tools off of diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el index 9eadbc9be38..2e4072f89b4 100644 --- a/lisp/cedet/semantic/wisent/comp.el +++ b/lisp/cedet/semantic/wisent/comp.el @@ -41,6 +41,7 @@ ;;; Code: (require 'semantic/wisent) +(eval-when-compile (require 'cl)) ;;;; ------------------- ;;;; Misc. useful things @@ -66,18 +67,23 @@ (defmacro wisent-defcontext (name &rest vars) "Define a context NAME that will bind variables VARS." + (declare (indent 1)) (let* ((context (wisent-context-name name)) - (bindings (mapcar #'(lambda (v) (list 'defvar v)) vars))) - `(eval-when-compile - ,@bindings - (defvar ,context ',vars)))) -(put 'wisent-defcontext 'lisp-indent-function 1) + (declarations (mapcar #'(lambda (v) (list 'defvar v)) vars))) + `(progn + ,@declarations + (eval-when-compile + (defvar ,context ',vars))))) (defmacro wisent-with-context (name &rest body) "Bind variables in context NAME then eval BODY." - `(let* ,(wisent-context-bindings name) - ,@body)) -(put 'wisent-with-context 'lisp-indent-function 1) + (declare (indent 1)) + (let ((bindings (wisent-context-bindings name))) + `(progn + ,@(mapcar (lambda (binding) `(defvar ,(or (car-safe binding) binding))) + bindings) + (let* ,bindings + ,@body)))) ;; A naive implementation of data structures! But it suffice here ;-) @@ -2896,7 +2902,7 @@ references found in BODY, and XBODY is BODY expression with (progn (if (wisent-check-$N body n) ;; Accumulate $i symbol - (add-to-list 'found body)) + (pushnew body found :test #'equal)) (cons found body)) ;; BODY is a list, expand inside it (let (xbody sexpr) @@ -2916,7 +2922,7 @@ references found in BODY, and XBODY is BODY expression with ;; $i symbol ((wisent-check-$N sexpr n) ;; Accumulate $i symbol - (add-to-list 'found sexpr)) + (pushnew sexpr found :test #'equal)) ) ;; Accumulate expanded forms (setq xbody (nconc xbody (list sexpr)))) diff --git a/lisp/cedet/srecode/args.el b/lisp/cedet/srecode/args.el index 1d72ced666e..2cb2396092a 100644 --- a/lisp/cedet/srecode/args.el +++ b/lisp/cedet/srecode/args.el @@ -101,35 +101,35 @@ do not contain any text from preceding or following text." (defun srecode-semantic-handle-:time (dict) "Add macros into the dictionary DICT based on the current :time." ;; DATE Values - (srecode-dictionary-set-value - dict "YEAR" (format-time-string "%Y" (current-time))) - (srecode-dictionary-set-value - dict "MONTHNAME" (format-time-string "%B" (current-time))) - (srecode-dictionary-set-value - dict "MONTH" (format-time-string "%m" (current-time))) - (srecode-dictionary-set-value - dict "DAY" (format-time-string "%d" (current-time))) - (srecode-dictionary-set-value - dict "WEEKDAY" (format-time-string "%a" (current-time))) - ;; Time Values - (srecode-dictionary-set-value - dict "HOUR" (format-time-string "%H" (current-time))) - (srecode-dictionary-set-value - dict "HOUR12" (format-time-string "%l" (current-time))) - (srecode-dictionary-set-value - dict "AMPM" (format-time-string "%p" (current-time))) - (srecode-dictionary-set-value - dict "MINUTE" (format-time-string "%M" (current-time))) - (srecode-dictionary-set-value - dict "SECOND" (format-time-string "%S" (current-time))) - (srecode-dictionary-set-value - dict "TIMEZONE" (format-time-string "%Z" (current-time))) - ;; Convenience pre-packed date/time - (srecode-dictionary-set-value - dict "DATE" (format-time-string "%D" (current-time))) - (srecode-dictionary-set-value - dict "TIME" (format-time-string "%X" (current-time))) - ) + (let ((now (current-time))) + (srecode-dictionary-set-value + dict "YEAR" (format-time-string "%Y" now)) + (srecode-dictionary-set-value + dict "MONTHNAME" (format-time-string "%B" now)) + (srecode-dictionary-set-value + dict "MONTH" (format-time-string "%m" now)) + (srecode-dictionary-set-value + dict "DAY" (format-time-string "%d" now)) + (srecode-dictionary-set-value + dict "WEEKDAY" (format-time-string "%a" now)) + ;; Time Values + (srecode-dictionary-set-value + dict "HOUR" (format-time-string "%H" now)) + (srecode-dictionary-set-value + dict "HOUR12" (format-time-string "%l" now)) + (srecode-dictionary-set-value + dict "AMPM" (format-time-string "%p" now)) + (srecode-dictionary-set-value + dict "MINUTE" (format-time-string "%M" now)) + (srecode-dictionary-set-value + dict "SECOND" (format-time-string "%S" now)) + (srecode-dictionary-set-value + dict "TIMEZONE" (format-time-string "%Z" now)) + ;; Convenience pre-packed date/time + (srecode-dictionary-set-value + dict "DATE" (format-time-string "%D" now)) + (srecode-dictionary-set-value + dict "TIME" (format-time-string "%X" now)))) ;;; :file ARGUMENT HANDLING ;; diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el index d899b42b1e1..782121ef5b5 100644 --- a/lisp/cedet/srecode/compile.el +++ b/lisp/cedet/srecode/compile.el @@ -87,10 +87,10 @@ for push, pop, and peek for the active template.") Useful if something goes wrong in SRecode, and the active template stack is broken." (interactive) - (if (oref srecode-template active) + (if (oref-default 'srecode-template active) (when (y-or-n-p (format "%d active templates. Flush? " - (length (oref srecode-template active)))) - (oset-default srecode-template active nil)) + (length (oref-default 'srecode-template active)))) + (oset-default 'srecode-template active nil)) (message "No active templates to flush.")) ) @@ -514,7 +514,7 @@ to the inserter constructor." ;;(message "Compile: %s %S" name props) (if (not key) (apply 'srecode-template-inserter-variable name props) - (let ((classes (eieio-class-children srecode-template-inserter)) + (let ((classes (eieio-class-children 'srecode-template-inserter)) (new nil)) ;; Loop over the various subclasses and ;; create the correct inserter. diff --git a/lisp/cedet/srecode/fields.el b/lisp/cedet/srecode/fields.el index 20852f78b41..f473a0d8261 100644 --- a/lisp/cedet/srecode/fields.el +++ b/lisp/cedet/srecode/fields.el @@ -237,7 +237,7 @@ If SET-TO is a string, then replace the text of OLAID wit SET-TO." (defsubst srecode-active-template-region () "Return the active region for template fields." - (oref srecode-template-inserted-region active-region)) + (oref-default 'srecode-template-inserted-region active-region)) (defun srecode-field-post-command () "Srecode field handler in the post command hook." diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el index f1f23bc6f1d..78ec1658859 100644 --- a/lisp/cedet/srecode/insert.el +++ b/lisp/cedet/srecode/insert.el @@ -211,7 +211,7 @@ insertions." (propertize " (most recent at bottom)" 'face '(:slant italic)) ":\n") (data-debug-insert-stuff-list - (reverse (oref srecode-template active)) "> ") + (reverse (oref-default 'srecode-template active)) "> ") ;; Show the current dictionary. (insert (propertize "Dictionary" 'face '(:weight bold)) "\n") (data-debug-insert-thing dictionary "" "> ") @@ -396,7 +396,7 @@ Specify the :blank argument to enable this inserter.") (pm (point-marker))) (when (and inbuff ;; Don't do this if we are not the active template. - (= (length (oref srecode-template active)) 1)) + (= (length (oref-default 'srecode-template active)) 1)) (when (and (eq i t) inbuff (not (eq (oref sti where) 'begin))) (indent-according-to-mode) @@ -773,7 +773,7 @@ generalized marker will do something else. See ;; valid. Compare this to the actual template nesting depth and ;; maybe use the override function which is stored in the cdr. (if (and srecode-template-inserter-point-override - (<= (length (oref srecode-template active)) + (<= (length (oref-default 'srecode-template active)) (car srecode-template-inserter-point-override))) ;; Disable the old override while we do this. (let ((over (cdr srecode-template-inserter-point-override)) @@ -943,7 +943,7 @@ this template instance." ;; Calculate and store the discovered template (let ((tmpl (srecode-template-get-table (srecode-table) templatenamepart)) - (active (oref srecode-template active)) + (active (oref-default 'srecode-template active)) ctxt) (when (not tmpl) ;; If it isn't just available, scan back through @@ -1053,7 +1053,7 @@ template where a ^ inserter occurs." (lexical-let ((inserter1 sti)) (cons ;; DEPTH - (+ (length (oref srecode-template active)) 1) + (+ (length (oref-default 'srecode-template active)) 1) ;; FUNCTION (lambda (dict) (let ((srecode-template-inserter-point-override nil)) diff --git a/lisp/cedet/srecode/java.el b/lisp/cedet/srecode/java.el index 2a26ca212c0..d812df1c935 100644 --- a/lisp/cedet/srecode/java.el +++ b/lisp/cedet/srecode/java.el @@ -40,16 +40,15 @@ FILENAME_AS_CLASS - file converted to a Java class name." (fnox (file-name-sans-extension fsym)) (dir (file-name-directory (buffer-file-name))) (fpak fsym) + (proj (ede-current-project)) + (pths (ede-source-paths proj 'java-mode)) ) (while (string-match "\\.\\| " fpak) (setq fpak (replace-match "_" t t fpak))) ;; We can extract package from: ;; 1) a java EDE project source paths, - (cond ((ede-current-project) - (let* ((proj (ede-current-project)) - (pths (ede-source-paths proj 'java-mode)) - (pth) - (res)) + (cond ((and proj pths) + (let* ((pth) (res)) (while (and (not res) (setq pth (expand-file-name (car pths)))) (when (string-match pth dir) diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el index 7224d5942f6..cc0c4ae4427 100644 --- a/lisp/cedet/srecode/map.el +++ b/lisp/cedet/srecode/map.el @@ -298,7 +298,7 @@ if that file is NEW, otherwise assume the mode has not changed." (when (not srecode-current-map) (condition-case nil (setq srecode-current-map - (eieio-persistent-read srecode-map-save-file srecode-map)) + (eieio-persistent-read srecode-map-save-file 'srecode-map)) (error ;; There was an error loading the old map. Create a new one. (setq srecode-current-map diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el index cc148c28434..79672ec3b1b 100644 --- a/lisp/cedet/srecode/srt-mode.el +++ b/lisp/cedet/srecode/srt-mode.el @@ -233,7 +233,7 @@ we can tell font lock about them.") "Provide help for working with macros in a template." (interactive) (let* ((root 'srecode-template-inserter) - (chl (eieio--class-children (class-v root))) + (chl (eieio-class-children root)) (ess (srecode-template-get-escape-start)) (ees (srecode-template-get-escape-end)) ) @@ -249,7 +249,7 @@ we can tell font lock about them.") (showexample t) ) (setq chl (cdr chl)) - (setq chl (append (eieio--class-children (class-v C)) chl)) + (setq chl (append (eieio-class-children C) chl)) (catch 'skip (when (eq C 'srecode-template-inserter-section-end) diff --git a/lisp/comint.el b/lisp/comint.el index f33034bdb57..30c4dda5c0f 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -746,11 +746,11 @@ The buffer name is made by surrounding the file name of PROGRAM with `*'s. The file name is used to make a symbol name, such as `comint-sh-hook', and any hooks on this symbol are run in the buffer. See `make-comint' and `comint-exec'." + (declare (interactive-only make-comint)) (interactive "sRun program: ") (let ((name (file-name-nondirectory program))) (switch-to-buffer (make-comint name program)) (run-hooks (intern-soft (concat "comint-" name "-hook"))))) -(put 'comint-run 'interactive-only 'make-comint) (defun comint-exec (buffer name command startfile switches) "Start up a process named NAME in buffer BUFFER for Comint modes. @@ -1775,6 +1775,12 @@ If the Comint is Lucid Common Lisp, Similarly for Soar, Scheme, etc." (interactive) + ;; If we're currently completing, stop. We're definitely done + ;; completing, and by sending the input, we might cause side effects + ;; that will confuse the code running in the completion + ;; post-command-hook. + (when completion-in-region-mode + (completion-in-region-mode -1)) ;; Note that the input string does not include its terminal newline. (let ((proc (get-buffer-process (current-buffer)))) (if (not proc) (user-error "Current buffer has no process") diff --git a/lisp/completion.el b/lisp/completion.el index d02f6129e06..d3f118705b7 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -373,7 +373,7 @@ Used to decide whether to save completions.") (defvar cmpl-preceding-syntax) -(defvar completion-string) +(defvar cmpl--completion-string) ;;--------------------------------------------------------------------------- ;; Low level tools @@ -435,8 +435,7 @@ Used to decide whether to save completions.") (defun cmpl-hours-since-origin () - (let ((time (current-time))) - (floor (+ (* 65536.0 (nth 0 time)) (nth 1 time)) 3600))) + (floor (float-time) 3600)) ;;--------------------------------------------------------------------------- ;; "Symbol" parsing functions @@ -1083,7 +1082,7 @@ Must be called after `find-exact-completion'." (cmpl-db-debug-p ;; not found, error if debug mode (error "Completion entry exists but not on prefix list - %s" - completion-string)) + cmpl--completion-string)) (inside-locate-completion-entry ;; recursive error: really scrod (locate-completion-db-error)) @@ -1150,73 +1149,75 @@ COMPLETION-STRING must be longer than `completion-prefix-min-length'. Updates the saved string with the supplied string. This must be very fast. Returns the completion entry." - ;; Handle pending acceptance - (if completion-to-accept (accept-completion)) - ;; test if already in database - (if (setq cmpl-db-entry (find-exact-completion completion-string)) - ;; found - (let* ((prefix-entry (find-cmpl-prefix-entry - (substring cmpl-db-downcase-string 0 - completion-prefix-min-length))) - (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)) - (cmpl-ptr (cdr splice-ptr))) - ;; update entry - (set-completion-string cmpl-db-entry completion-string) - ;; move to head (if necessary) - (cond (splice-ptr - ;; These should all execute atomically but it is not fatal if - ;; they don't. - ;; splice it out - (or (setcdr splice-ptr (cdr cmpl-ptr)) - ;; fix up tail if necessary - (set-cmpl-prefix-entry-tail prefix-entry splice-ptr)) - ;; splice in at head - (setcdr cmpl-ptr (cmpl-prefix-entry-head prefix-entry)) - (set-cmpl-prefix-entry-head prefix-entry cmpl-ptr))) - cmpl-db-entry) - ;; not there - (let (;; create an entry - (entry (list (make-completion completion-string))) - ;; setup the prefix - (prefix-entry (find-cmpl-prefix-entry - (substring cmpl-db-downcase-string 0 - completion-prefix-min-length)))) - (cond (prefix-entry - ;; Splice in at head - (setcdr entry (cmpl-prefix-entry-head prefix-entry)) - (set-cmpl-prefix-entry-head prefix-entry entry)) - (t - ;; Start new prefix entry - (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry)))) - ;; Add it to the symbol - (set cmpl-db-symbol (car entry))))) + (let ((cmpl--completion-string completion-string)) + ;; Handle pending acceptance + (if completion-to-accept (accept-completion)) + ;; test if already in database + (if (setq cmpl-db-entry (find-exact-completion completion-string)) + ;; found + (let* ((prefix-entry (find-cmpl-prefix-entry + (substring cmpl-db-downcase-string 0 + completion-prefix-min-length))) + (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)) + (cmpl-ptr (cdr splice-ptr))) + ;; update entry + (set-completion-string cmpl-db-entry completion-string) + ;; move to head (if necessary) + (cond (splice-ptr + ;; These should all execute atomically but it is not fatal if + ;; they don't. + ;; splice it out + (or (setcdr splice-ptr (cdr cmpl-ptr)) + ;; fix up tail if necessary + (set-cmpl-prefix-entry-tail prefix-entry splice-ptr)) + ;; splice in at head + (setcdr cmpl-ptr (cmpl-prefix-entry-head prefix-entry)) + (set-cmpl-prefix-entry-head prefix-entry cmpl-ptr))) + cmpl-db-entry) + ;; not there + (let ( ;; create an entry + (entry (list (make-completion completion-string))) + ;; setup the prefix + (prefix-entry (find-cmpl-prefix-entry + (substring cmpl-db-downcase-string 0 + completion-prefix-min-length)))) + (cond (prefix-entry + ;; Splice in at head + (setcdr entry (cmpl-prefix-entry-head prefix-entry)) + (set-cmpl-prefix-entry-head prefix-entry entry)) + (t + ;; Start new prefix entry + (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry)))) + ;; Add it to the symbol + (set cmpl-db-symbol (car entry)))))) (defun delete-completion (completion-string) "Delete the completion from the database. String must be longer than `completion-prefix-min-length'." ;; Handle pending acceptance - (if completion-to-accept (accept-completion)) - (if (setq cmpl-db-entry (find-exact-completion completion-string)) - ;; found - (let* ((prefix-entry (find-cmpl-prefix-entry - (substring cmpl-db-downcase-string 0 - completion-prefix-min-length))) - (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry))) - ;; delete symbol reference - (set cmpl-db-symbol nil) - ;; remove from prefix list - (cond (splice-ptr - ;; not at head - (or (setcdr splice-ptr (cdr (cdr splice-ptr))) - ;; fix up tail if necessary - (set-cmpl-prefix-entry-tail prefix-entry splice-ptr))) - (t - ;; at head - (or (set-cmpl-prefix-entry-head + (let ((cmpl--completion-string completion-string)) + (if completion-to-accept (accept-completion)) + (if (setq cmpl-db-entry (find-exact-completion completion-string)) + ;; found + (let* ((prefix-entry (find-cmpl-prefix-entry + (substring cmpl-db-downcase-string 0 + completion-prefix-min-length))) + (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry))) + ;; delete symbol reference + (set cmpl-db-symbol nil) + ;; remove from prefix list + (cond (splice-ptr + ;; not at head + (or (setcdr splice-ptr (cdr (cdr splice-ptr))) + ;; fix up tail if necessary + (set-cmpl-prefix-entry-tail prefix-entry splice-ptr))) + (t + ;; at head + (or (set-cmpl-prefix-entry-head prefix-entry (cdr (cmpl-prefix-entry-head prefix-entry))) - ;; List is now empty - (set cmpl-db-prefix-symbol nil))))) - (error "Unknown completion `%s'" completion-string))) + ;; List is now empty + (set cmpl-db-prefix-symbol nil))))) + (error "Unknown completion `%s'" completion-string)))) ;; Tests -- ;; - Add and Find - @@ -1312,7 +1313,7 @@ are specified." (delete-completion string)) (defun accept-completion () - "Accepts the pending completion in `completion-to-accept'. + "Accept the pending completion in `completion-to-accept'. This bumps num-uses. Called by `add-completion-to-head' and `completion-search-reset'." (let ((string completion-to-accept) @@ -1950,7 +1951,7 @@ If file name is not specified, use `save-completions-file-name'." (kept-old-versions 0) (kept-new-versions completions-file-versions-kept) last-use-time - (current-time (cmpl-hours-since-origin)) + (this-use-time (cmpl-hours-since-origin)) (total-in-db 0) (total-perm 0) (total-saved 0) @@ -1982,13 +1983,13 @@ If file name is not specified, use `save-completions-file-name'." ;; or if (if (> (completion-num-uses completion) 0) ;; it's been used - (setq last-use-time current-time) + (setq last-use-time this-use-time) ;; or it was saved before and (and last-use-time ;; save-completions-retention-time is nil (or (not save-completions-retention-time) ;; or time since last use is < ...retention-time* - (< (- current-time last-use-time) + (< (- this-use-time last-use-time) save-completions-retention-time))))) ;; write to file (setq total-saved (1+ total-saved)) @@ -2157,26 +2158,27 @@ Patched to remove the most recent completion." ;; to work) ;; All common separators (eg. space "(" ")" """) characters go through a -;; function to add new words to the list of words to complete from: -;; COMPLETION-SEPARATOR-SELF-INSERT-COMMAND (arg). +;; function to add new words to the list of words to complete from. ;; If the character before this was an alpha-numeric then this adds the ;; symbol before point to the completion list (using ADD-COMPLETION). -(defun completion-separator-self-insert-command (arg) - (interactive "p") - (if (command-remapping 'self-insert-command) - (funcall (command-remapping 'self-insert-command) arg) - (use-completion-before-separator) - (self-insert-command arg))) - -(defun completion-separator-self-insert-autofilling (arg) - (interactive "p") - (if (command-remapping 'self-insert-command) - (funcall (command-remapping 'self-insert-command) arg) - (use-completion-before-separator) - (self-insert-command arg) - (and auto-fill-function - (funcall auto-fill-function)))) +(defvar completion-separator-chars + (append " !%^&()=`|{}[];\\'#,?" + ;; We include period and colon even though they are symbol + ;; chars because : + ;; - in text we want to pick up the last word in a sentence. + ;; - in C pointer refs. we want to pick up the first symbol + ;; - it won't make a difference for lisp mode (package names + ;; are short) + ".:" nil)) + +(defun completion--post-self-insert () + (when (memq last-command-event completion-separator-chars) + (let ((after-pos (electric--after-char-pos))) + (when after-pos + (save-excursion + (goto-char (1- after-pos)) + (use-completion-before-separator)))))) ;;----------------------------------------------- ;; Wrapping Macro @@ -2245,9 +2247,8 @@ TYPE is the type of the wrapper to be added. Can be :before or :under." (completion-def-wrapper 'electric-c-semi :separator) (defun completion-c-mode-hook () (setq completion-syntax-table completion-c-syntax-table) - (local-set-key "+" 'completion-separator-self-insert-command) - (local-set-key "*" 'completion-separator-self-insert-command) - (local-set-key "/" 'completion-separator-self-insert-command)) + (setq-local completion-separator-chars + (append "+*/" completion-separator-chars))) ;; FORTRAN mode diffs. (these are defined when fortran is called) @@ -2260,10 +2261,8 @@ TYPE is the type of the wrapper to be added. Can be :before or :under." (defun completion-setup-fortran-mode () (setq completion-syntax-table completion-fortran-syntax-table) - (local-set-key "+" 'completion-separator-self-insert-command) - (local-set-key "-" 'completion-separator-self-insert-command) - (local-set-key "*" 'completion-separator-self-insert-command) - (local-set-key "/" 'completion-separator-self-insert-command)) + (setq-local completion-separator-chars + (append "+-*/" completion-separator-chars))) ;; Enable completion mode. @@ -2282,15 +2281,16 @@ if ARG is omitted or nil." ;; This is always good, not specific to dynamic-completion-mode. (define-key function-key-map [C-return] [?\C-\r]) - (dolist (x '((find-file-hook . completion-find-file-hook) - (pre-command-hook . completion-before-command) + (dolist (x `((find-file-hook . ,#'completion-find-file-hook) + (pre-command-hook . ,#'completion-before-command) ;; Save completions when killing Emacs. - (kill-emacs-hook . kill-emacs-save-completions) + (kill-emacs-hook . ,#'kill-emacs-save-completions) + (post-self-insert-hook . ,#'completion--post-self-insert) ;; Install the appropriate mode tables. - (lisp-mode-hook . completion-lisp-mode-hook) - (c-mode-hook . completion-c-mode-hook) - (fortran-mode-hook . completion-setup-fortran-mode))) + (lisp-mode-hook . ,#'completion-lisp-mode-hook) + (c-mode-hook . ,#'completion-c-mode-hook) + (fortran-mode-hook . ,#'completion-setup-fortran-mode))) (if dynamic-completion-mode (add-hook (car x) (cdr x)) (remove-hook (car x) (cdr x)))) @@ -2316,44 +2316,7 @@ if ARG is omitted or nil." ;; cumb ;; Patches to standard keymaps insert completions - ([remap kill-region] . completion-kill-region) - - ;; Separators - ;; We've used the completion syntax table given as a guide. - ;; - ;; Global separator chars. - ;; We left out <tab> because there are too many special - ;; cases for it. Also, in normal coding it's rarely typed - ;; after a word. - (" " . completion-separator-self-insert-autofilling) - ("!" . completion-separator-self-insert-command) - ("%" . completion-separator-self-insert-command) - ("^" . completion-separator-self-insert-command) - ("&" . completion-separator-self-insert-command) - ("(" . completion-separator-self-insert-command) - (")" . completion-separator-self-insert-command) - ("=" . completion-separator-self-insert-command) - ("`" . completion-separator-self-insert-command) - ("|" . completion-separator-self-insert-command) - ("{" . completion-separator-self-insert-command) - ("}" . completion-separator-self-insert-command) - ("[" . completion-separator-self-insert-command) - ("]" . completion-separator-self-insert-command) - (";" . completion-separator-self-insert-command) - ("\"". completion-separator-self-insert-command) - ("'" . completion-separator-self-insert-command) - ("#" . completion-separator-self-insert-command) - ("," . completion-separator-self-insert-command) - ("?" . completion-separator-self-insert-command) - - ;; We include period and colon even though they are symbol - ;; chars because : - ;; - in text we want to pick up the last word in a sentence. - ;; - in C pointer refs. we want to pick up the first symbol - ;; - it won't make a difference for lisp mode (package names - ;; are short) - ("." . completion-separator-self-insert-command) - (":" . completion-separator-self-insert-command))) + ([remap kill-region] . completion-kill-region))) (push (cons (car binding) (lookup-key global-map (car binding))) completion-saved-bindings) (global-set-key (car binding) (cdr binding))) diff --git a/lisp/composite.el b/lisp/composite.el index d92f282a98b..4ab31d775a0 100644 --- a/lisp/composite.el +++ b/lisp/composite.el @@ -671,6 +671,49 @@ All non-spacing characters have this function in (setq i (1+ i)))) gstring)))))) +(defun compose-gstring-for-dotted-circle (gstring) + (let* ((dc (lgstring-glyph gstring 0)) ; glyph of dotted-circle + (dc-id (lglyph-code dc)) + (fc (lgstring-glyph gstring 1)) ; glyph of the following char + (fc-id (lglyph-code fc)) + (gstr (and nil (font-shape-gstring gstring)))) + (if (and gstr + (or (= (lgstring-glyph-len gstr) 1) + (and (= (lgstring-glyph-len gstr) 2) + (= (lglyph-to (lgstring-glyph gstr 0)) + (lglyph-to (lgstring-glyph gstr 1)))))) + ;; It seems that font-shape-gstring has composed glyphs. + gstr + ;; Artificially compose the following glyph with the preceding + ;; dotted-circle. + (setq dc (lgstring-glyph gstring 0) + fc (lgstring-glyph gstring 1)) + (let ((dc-width (lglyph-width dc)) + (fc-width (- (lglyph-rbearing fc) (lglyph-lbearing fc))) + (from (lglyph-from dc)) + (to (lglyph-to fc)) + (xoff 0) (yoff 0) (width 0)) + (if (and (< (lglyph-descent fc) 0) + (> (lglyph-ascent dc) (- (lglyph-descent fc)))) + ;; Set YOFF so that the following glyph is put on top of + ;; the dotted-circle. + (setq yoff (- (- (lglyph-descent fc)) (lglyph-ascent dc)))) + (if (> (lglyph-width fc) 0) + (setq xoff (- (lglyph-rbearing fc)))) + (if (< dc-width fc-width) + ;; The following glyph is wider, but we don't know how to + ;; align both glyphs. So, try the easiest method; + ;; i.e. align left edges of the glyphs. + (setq xoff (- xoff (- dc-width) (- (lglyph-lbearing fc ))) + width (- fc-width dc-width))) + (if (or (/= xoff 0) (/= yoff 0) (/= width 0) (/= (lglyph-width fc) 0)) + (lglyph-set-adjustment fc xoff yoff width)) + (lglyph-set-from-to dc from to) + (lglyph-set-from-to fc from to)) + (if (> (lgstring-glyph-len gstring) 2) + (lgstring-set-glyph gstring 2 nil)) + gstring))) + ;; Allow for bootstrapping without uni-*.el. (when unicode-category-table (let ((elt `([,(purecopy "\\c.\\c^+") 1 compose-gstring-for-graphic] @@ -679,7 +722,10 @@ All non-spacing characters have this function in #'(lambda (key val) (if (memq val '(Mn Mc Me)) (set-char-table-range composition-function-table key elt))) - unicode-category-table))) + unicode-category-table)) + ;; for dotted-circle + (aset composition-function-table #x25CC + `([,(purecopy ".\\c^") 0 compose-gstring-for-dotted-circle]))) (defun compose-gstring-for-terminal (gstring) "Compose glyph-string GSTRING for terminal display. diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el index 453b15ddcea..b8a9eb82655 100644 --- a/lisp/cus-dep.el +++ b/lisp/cus-dep.el @@ -62,7 +62,8 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" (while (setq subdir (pop command-line-args-left)) (message "Directory %s" subdir) (let ((files (directory-files subdir nil "\\`[^=.].*\\.el\\'")) - (default-directory (expand-file-name subdir)) + (default-directory + (file-name-as-directory (expand-file-name subdir))) (preloaded (concat "\\`\\(\\./+\\)?" (regexp-opt preloaded-file-list t) "\\.el\\'"))) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 4a5a9bfa7d9..f56fb6a649e 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1356,12 +1356,10 @@ suggest to customize that face, if it's customizable." (or (face-at-point t t) "all faces") t))) (customize-face face t)) -(defalias 'customize-customized 'customize-unsaved) - -;;;###autoload -(defun customize-unsaved () - "Customize all options and faces set in this session but not saved." - (interactive) +(defun custom-unsaved-options () + "List of options and faces set in this session but not saved. +Each entry is of the form (SYMBOL TYPE), where TYPE is one of the +symbols `custom-face' or `custom-variable'." (let ((found nil)) (mapatoms (lambda (symbol) (and (or (get symbol 'customized-face) @@ -1372,6 +1370,15 @@ suggest to customize that face, if it's customizable." (get symbol 'customized-variable-comment)) (boundp symbol) (push (list symbol 'custom-variable) found)))) + found)) + +(defalias 'customize-customized 'customize-unsaved) + +;;;###autoload +(defun customize-unsaved () + "Customize all options and faces set in this session but not saved." + (interactive) + (let ((found (custom-unsaved-options))) (if (not found) (error "No user options are set but unsaved") (custom-buffer-create (custom-sort-items found t nil) @@ -1477,6 +1484,16 @@ If TYPE is `groups', include only groups." (interactive (list (apropos-read-pattern "groups"))) (customize-apropos regexp 'groups)) +;;;###autoload +(defun custom-prompt-customize-unsaved-options () + "Prompt user to customize any unsaved customization options. +Return non-nil if user chooses to customize, for use in +`kill-emacs-query-functions'." + (not (and (custom-unsaved-options) + (yes-or-no-p "Some customized options have not been saved; Examine? ") + (customize-unsaved) + t))) + ;;; Buffer. (defcustom custom-buffer-style 'links diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 7ade7ed152a..71506cb680e 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -198,6 +198,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of ;; editfns.c (user-full-name mail string) + ;; emacs.c + (report-emacs-bug-address emacsbug string) ;; eval.c (max-specpdl-size limits integer) (max-lisp-eval-depth limits integer) @@ -272,7 +274,13 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (tool-bar-mode (frames mouse) boolean nil ; :initialize custom-initialize-default :set custom-set-minor-mode) - (frame-resize-pixelwise windows boolean "24.4") + (frame-resize-pixelwise frames boolean "24.4") + (frame-inhibit-implied-resize frames + (choice + (const :tag "Never" nil) + (const :tag "Always" t) + (repeat (symbol :tag "Parameter"))) + "25.1") ;; fringe.c (overflow-newline-into-fringe fringe boolean) ;; image.c @@ -402,7 +410,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (ns-antialias-text ns boolean "23.1") (ns-auto-hide-menu-bar ns boolean "24.1") (ns-use-native-fullscreen ns boolean "24.4") - (ns-use-srgb-colorspace ns boolean "24.4") + (ns-use-fullscreen-animation ns boolean "25.1") + (ns-use-srgb-colorspace ns boolean "24.4") ;; process.c (delete-exited-processes processes-basics boolean) ;; syntax.c @@ -412,6 +421,12 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of "21.1") ;; term.c (visible-cursor cursor boolean "22.1") + ;; terminal.c + (ring-bell-function display + (choice + (const :tag "Default" nil) + (const :tag "Silent" ignore) + function)) ;; undo.c (undo-limit undo integer) (undo-strong-limit undo integer) @@ -451,6 +466,7 @@ since it could result in memory overflow and make Emacs crash." :value display-buffer) (other :tag "Always (t)" :value t)) "24.3") + (fast-but-imprecise-scrolling scrolling boolean "25.1") (window-resize-pixelwise windows boolean "24.4") ;; xdisp.c ;; The whitespace group is for whitespace.el. @@ -510,7 +526,12 @@ since it could result in memory overflow and make Emacs crash." (const :tag "Hourglass" :value hourglass))) (display-hourglass cursor boolean) (hourglass-delay cursor number) - + (resize-mini-windows + windows (choice + (const :tag "Off (nil)" :value nil) + (const :tag "Fit (t)" :value t) + (const :tag "Grow only" :value grow-only)) + "25.1") ;; xfaces.c (scalable-fonts-allowed display boolean "22.1") ;; xfns.c @@ -519,7 +540,6 @@ since it could result in memory overflow and make Emacs crash." (x-gtk-use-old-file-dialog menu boolean "22.1") (x-gtk-show-hidden-files menu boolean "22.1") (x-gtk-file-dialog-help-text menu boolean "22.1") - (x-gtk-whole-detached-tool-bar x boolean "22.1") (x-gtk-use-system-tooltips tooltip boolean "23.3") ;; xterm.c (x-use-underline-position-properties display boolean "22.1") diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 489d570440f..d6f64c77e61 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -434,13 +434,26 @@ relevant to POS." code (encode-char char charset))) (setq code char)) (cond - ;; Append a PDF character to directional embeddings and - ;; overrides, to prevent potential messup of the following - ;; text. - ((memq char '(?\x202a ?\x202b ?\x202d ?\x202e)) + ;; Append a PDF character to left-to-right directional + ;; embeddings and overrides, to prevent potential messup of the + ;; following text. + ((memq char '(?\x202a ?\x202d)) (setq char-description (concat char-description (propertize (string ?\x202c) 'invisible t)))) + ;; Append a PDF character followed by LRM to right-to-left + ;; directional embeddings and overrides, to prevent potential + ;; messup of the following numerical text. + ((memq char '(?\x202b ?\x202e)) + (setq char-description + (concat char-description + (propertize (string ?\x202c ?\x200e) 'invisible t)))) + ;; Append a PDI character to directional isolate initiators, to + ;; prevent potential messup of the following numerical text + ((memq char '(?\x2066 ?\x2067 ?\x2068)) + (setq char-description + (concat char-description + (propertize (string ?\x2069) 'invisible t)))) ;; Append a LRM character to any strong character to avoid ;; messing up the numerical codepoint. ((memq (get-char-code-property char 'bidi-class) '(R AL)) @@ -812,6 +825,102 @@ relevant to POS." (define-obsolete-function-alias 'describe-char-after 'describe-char "22.1") +;;; Describe-Char-ElDoc + +(defun describe-char-eldoc--truncate (name width) + "Truncate NAME at white spaces such that it is no longer than WIDTH. + +Split NAME on white space character and return string with as +many leading words of NAME as possible without exceeding WIDTH +characters. If NAME consists of white space characters only, +return an empty string. Three dots (\"...\") are appended to +returned string if some of the words from NAME have been omitted. + +NB: Function may return string longer than WIDTH if name consists +of a single word, or it's first word is longer than WIDTH +characters." + (let ((words (split-string name))) + (if words + (let ((last words)) + (setq width (- width (length (car words)))) + (while (and (cdr last) + (<= (+ (length (cadr last)) (if (cddr last) 4 1)) width)) + (setq last (cdr last)) + (setq width (- width (length (car last)) 1))) + (let ((ellipsis (and (cdr last) "..."))) + (setcdr last nil) + (concat (mapconcat 'identity words " ") ellipsis))) + ""))) + +(defun describe-char-eldoc--format (ch &optional width) + "Format a description for character CH which is no more than WIDTH characters. + +Full description message has a \"U+HEX: NAME (GC: GENERAL-CATEGORY)\" +format where: +- HEX is a hexadecimal codepoint of the character (zero-padded to at + least four digits), +- NAME is name of the character. +- GC is a two-letter abbreviation of the general-category of the + character, and +- GENERAL-CATEGORY is full name of the general-category of the + character. + +If WIDTH is non-nil some elements of the description may be +omitted to accommodate the length restriction. Under certain +condition, the function may return string longer than WIDTH, see +`describe-char-eldoc--truncate'." + (let ((name (get-char-code-property ch 'name))) + (when name + (let* ((code (propertize (format "U+%04X" ch) + 'face 'font-lock-constant-face)) + (gc (get-char-code-property ch 'general-category)) + (gc-desc (char-code-property-description 'general-category gc))) + + (unless (or (not width) (<= (length name) width)) + (setq name (describe-char-eldoc--truncate name width))) + (setq name (concat (substring name 0 1) (downcase (substring name 1)))) + (setq name (propertize name 'face 'font-lock-variable-name-face)) + + (setq gc (propertize (symbol-name gc) 'face 'font-lock-comment-face)) + (when gc-desc + (setq gc-desc (propertize gc-desc 'face 'font-lock-comment-face))) + + (let ((lcode (length code)) + (lname (length name)) + (lgc (length gc)) + (lgc-desc (and gc-desc (length gc-desc)))) + (cond + ((and gc-desc + (or (not width) (<= (+ lcode lname lgc lgc-desc 7) width))) + (concat code ": " name " (" gc ": " gc-desc ")")) + ((and gc-desc (<= (+ lcode lname lgc-desc 5) width)) + (concat code ": " name " (" gc-desc ")")) + ((or (not width) (<= (+ lcode lname lgc 5) width)) + (concat code ": " name " (" gc ")")) + ((<= (+ lname lgc 3) width) + (concat name " (" gc ")")) + (t name))))))) + +;;;###autoload +(defun describe-char-eldoc () + "Return a description of character at point for use by ElDoc mode. + +Return nil if character at point is a printable ASCII +character (i.e. codepoint between 32 and 127 inclusively). +Otherwise return a description formatted by +`describe-char-eldoc--format' function taking into account value +of `eldoc-echo-area-use-multiline-p' variable and width of +minibuffer window for width limit. + +This function is meant to be used as a value of +`eldoc-documentation-function' variable." + (let ((ch (following-char))) + (when (and (not (zerop ch)) (or (< ch 32) (> ch 127))) + (describe-char-eldoc--format + ch + (unless (eq eldoc-echo-area-use-multiline-p t) + (1- (window-width (minibuffer-window)))))))) + (provide 'descr-text) ;;; descr-text.el ends here diff --git a/lisp/desktop.el b/lisp/desktop.el index 25311f8e052..c355d7f080f 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -941,7 +941,7 @@ Frames with a non-nil `desktop-dont-save' parameter are not saved." (and desktop-restore-frames (frameset-save nil :app desktop--app-id - :name (concat user-login-name "@" system-name) + :name (concat user-login-name "@" (system-name)) :predicate #'desktop--check-dont-save)))) ;;;###autoload @@ -1191,7 +1191,6 @@ Using it may cause conflicts. Use it anyway? " owner))))) (desktop-auto-save-enable) t)) ;; No desktop file found. - (desktop-clear) (let ((default-directory desktop-dirname)) (run-hooks 'desktop-no-desktop-file-hook)) (message "No desktop file.") @@ -1414,8 +1413,8 @@ after that many seconds of idle time." (if (consp desktop-buffer-mark) (progn (move-marker (mark-marker) (car desktop-buffer-mark)) - ;; FIXME: Should we call (de)activate-mark instead? - (setq mark-active (car (cdr desktop-buffer-mark)))) + (if (car (cdr desktop-buffer-mark)) + (activate-mark 'dont-touch-tmm))) (move-marker (mark-marker) desktop-buffer-mark))) ;; Never override file system if the file really is read-only marked. (when desktop-buffer-read-only (setq buffer-read-only desktop-buffer-read-only)) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index f627fc1246f..b4e2dc0a937 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -215,19 +215,24 @@ condition. Two file items are considered to match if they are equal (dolist (file1 list1) (unless (let ((list list2)) (while (and list - (not (let* ((file2 (car list)) - (fa1 (car (cddr file1))) - (fa2 (car (cddr file2))) - (size1 (nth 7 fa1)) - (size2 (nth 7 fa2)) - (mtime1 (float-time (nth 5 fa1))) - (mtime2 (float-time (nth 5 fa2)))) - (and - (equal (car file1) (car file2)) - (not (eval predicate)))))) + (let* ((file2 (car list)) + (fa1 (car (cddr file1))) + (fa2 (car (cddr file2)))) + (or + (not (equal (car file1) (car file2))) + (eval predicate + `((fa1 . ,fa1) + (fa2 . ,fa2) + (size1 . ,(nth 7 fa1)) + (size2 . ,(nth 7 fa2)) + (mtime1 + . ,(float-time (nth 5 fa1))) + (mtime2 + . ,(float-time (nth 5 fa2))) + ))))) (setq list (cdr list))) list) - (setq res (cons file1 res)))) + (push file1 res))) (nreverse res)))) (defun dired-files-attributes (dir) @@ -2057,7 +2062,10 @@ See Info node `(emacs)Subdir switches' for more details." ;; inserted *after* opoint. (setq dirname (file-name-as-directory dirname)) (or (and (not switches) - (dired-goto-subdir dirname)) + (when (dired-goto-subdir dirname) + (unless (dired-subdir-hidden-p dirname) + (dired-initial-position dirname)) + t)) (dired-insert-subdir dirname switches no-error-if-not-dir-p)) ;; Push mark so that it's easy to find back. Do this after the ;; insert message so that the user sees the `Mark set' message. diff --git a/lisp/dired.el b/lisp/dired.el index 211f9242e80..2b3e7832166 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1912,7 +1912,7 @@ Type \\[dired-mark] to Mark a file or subdirectory for later commands. to see why something went wrong. Type \\[dired-unmark] to Unmark a file or all files of an inserted subdirectory. Type \\[dired-unmark-backward] to back up one line and unmark or unflag. -Type \\[dired-do-flagged-delete] to delete (eXecute) the files flagged `D'. +Type \\[dired-do-flagged-delete] to delete (eXpunge) the files flagged `D'. Type \\[dired-find-file] to Find the current line's file (or dired it in another buffer, if it is a directory). Type \\[dired-find-file-other-window] to find file or Dired directory in Other window. @@ -3059,7 +3059,7 @@ or \"* [3 files]\"." (when dired-shrink-to-fit ;; Try to not delete window when we want to display less than ;; `window-min-height' lines. - (fit-window-to-buffer (get-buffer-window buf) nil 1))) + (fit-window-to-buffer (get-buffer-window buf) nil 1 nil nil t))) (defcustom dired-no-confirm nil "A list of symbols for commands Dired should not confirm, or t. @@ -3103,20 +3103,21 @@ argument or confirmation)." ;; Mark *Marked Files* window as softly-dedicated, to prevent ;; other buffers e.g. *Completions* from reusing it (bug#17554). (display-buffer-mark-dedicated 'soft)) - (with-current-buffer buffer - (with-current-buffer-window - buffer - (cons 'display-buffer-below-selected - '((window-height . fit-window-to-buffer))) - #'(lambda (window _value) - (with-selected-window window - (unwind-protect - (apply function args) - (when (window-live-p window) - (quit-restore-window window 'kill))))) - ;; Handle (t FILE) just like (FILE), here. That value is - ;; used (only in some cases), to mean just one file that was - ;; marked, rather than the current line file. + (with-displayed-buffer-window + buffer + (cons 'display-buffer-below-selected + '((window-height . fit-window-to-buffer) + (preserve-size . (nil . t)))) + #'(lambda (window _value) + (with-selected-window window + (unwind-protect + (apply function args) + (when (window-live-p window) + (quit-restore-window window 'kill))))) + ;; Handle (t FILE) just like (FILE), here. That value is + ;; used (only in some cases), to mean just one file that was + ;; marked, rather than the current line file. + (with-current-buffer buffer (dired-format-columns-of-files (if (eq (car files) t) (cdr files) files)) (remove-text-properties (point-min) (point-max) @@ -3883,7 +3884,7 @@ Ask means pop up a menu for the user to select one of copy, move or link." ;;; Start of automatically extracted autoloads. -;;;### (autoloads nil "dired-aux" "dired-aux.el" "ff408a17776696840db60d57b10ec2f4") +;;;### (autoloads nil "dired-aux" "dired-aux.el" "65f8aa57ace423283926d92dff903ca7") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\ diff --git a/lisp/dnd.el b/lisp/dnd.el index 0f47d3ea1e4..3e161dcfb51 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -122,17 +122,18 @@ Return nil if URI is not a local file." ;; The hostname may be our hostname, in that case, convert to a local ;; file. Otherwise return nil. TODO: How about an IP-address as hostname? - (let ((hostname (when (string-match "^file://\\([^/]*\\)" uri) + (let ((sysname (system-name))) + (let ((hostname (when (string-match "^file://\\([^/]*\\)" uri) (downcase (match-string 1 uri)))) - (system-name-no-dot - (downcase (if (string-match "^[^\\.]+" system-name) - (match-string 0 system-name) - system-name)))) - (when (and hostname - (or (string-equal "localhost" hostname) - (string-equal (downcase system-name) hostname) - (string-equal system-name-no-dot hostname))) - (concat "file://" (substring uri (+ 7 (length hostname))))))) + (sysname-no-dot + (downcase (if (string-match "^[^\\.]+" sysname) + (match-string 0 sysname) + sysname)))) + (when (and hostname + (or (string-equal "localhost" hostname) + (string-equal (downcase sysname) hostname) + (string-equal sysname-no-dot hostname))) + (concat "file://" (substring uri (+ 7 (length hostname)))))))) (defsubst dnd-unescape-uri (uri) (replace-regexp-in-string diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 6bfe2100c17..0e63d37adc5 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -336,7 +336,7 @@ of the page moves to the previous page." ;; Don't do it if there's a conversion is running, since in that case, it ;; will be done later. (with-selected-window (car winprops) - (doc-view-goto-page 1))))) + (doc-view-goto-page (image-mode-window-get 'page t)))))) (defvar-local doc-view--current-files nil "Only used internally.") @@ -654,16 +654,10 @@ at the top edge of the page moves to the previous page." (defun doc-view-make-safe-dir (dir) (condition-case nil - (let ((umask (default-file-modes))) - (unwind-protect - (progn - ;; Create temp files with strict access rights. It's easy to - ;; loosen them later, whereas it's impossible to close the - ;; time-window of loose permissions otherwise. - (set-default-file-modes #o0700) - (make-directory dir)) - ;; Reset the umask. - (set-default-file-modes umask))) + ;; Create temp files with strict access rights. It's easy to + ;; loosen them later, whereas it's impossible to close the + ;; time-window of loose permissions otherwise. + (with-file-modes #o0700 (make-directory dir)) (file-already-exists (when (file-symlink-p dir) (error "Danger: %s points to a symbolic link" dir)) @@ -1641,25 +1635,26 @@ If BACKWARD is non-nil, jump to the previous match." "Figure out the current document type (`doc-view-doc-type')." (let ((name-types (when buffer-file-name - (cdr (assoc-ignore-case (file-name-extension buffer-file-name) - '( - ;; DVI - ("dvi" dvi) - ;; PDF - ("pdf" pdf) ("epdf" pdf) - ;; PostScript - ("ps" ps) ("eps" ps) - ;; DjVu - ("djvu" djvu) - ;; OpenDocument formats - ("odt" odf) ("ods" odf) ("odp" odf) ("odg" odf) - ("odc" odf) ("odi" odf) ("odm" odf) ("ott" odf) - ("ots" odf) ("otp" odf) ("otg" odf) - ;; Microsoft Office formats (also handled - ;; by the odf conversion chain) - ("doc" odf) ("docx" odf) ("xls" odf) ("xlsx" odf) - ("ppt" odf) ("pptx" odf) - ("ppt" odf) ("pps" odf) ("pptx" odf)))))) + (cdr (assoc-string + (file-name-extension buffer-file-name) + '( + ;; DVI + ("dvi" dvi) + ;; PDF + ("pdf" pdf) ("epdf" pdf) + ;; PostScript + ("ps" ps) ("eps" ps) + ;; DjVu + ("djvu" djvu) + ;; OpenDocument formats. + ("odt" odf) ("ods" odf) ("odp" odf) ("odg" odf) + ("odc" odf) ("odi" odf) ("odm" odf) ("ott" odf) + ("ots" odf) ("otp" odf) ("otg" odf) + ;; Microsoft Office formats (also handled by the odf + ;; conversion chain). + ("doc" odf) ("docx" odf) ("xls" odf) ("xlsx" odf) + ("ppt" odf) ("pps" odf) ("pptx" odf)) + t)))) (content-types (save-excursion (goto-char (point-min)) diff --git a/lisp/dom.el b/lisp/dom.el new file mode 100644 index 00000000000..11357e88804 --- /dev/null +++ b/lisp/dom.el @@ -0,0 +1,230 @@ +;;; dom.el --- XML/HTML (etc.) DOM manipulation and searching functions + +;; Copyright (C) 2014-2015 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> +;; Keywords: xml, html + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'cl-lib) + +(defsubst dom-tag (node) + "Return the NODE tag." + ;; Called on a list of nodes. Use the first. + (if (consp (car node)) + (caar node) + (car node))) + +(defsubst dom-attributes (node) + "Return the NODE attributes." + ;; Called on a list of nodes. Use the first. + (if (consp (car node)) + (cadr (car node)) + (cadr node))) + +(defsubst dom-children (node) + "Return the NODE children." + ;; Called on a list of nodes. Use the first. + (if (consp (car node)) + (cddr (car node)) + (cddr node))) + +(defun dom-non-text-children (node) + "Return all non-text-node children of NODE." + (cl-loop for child in (dom-children node) + unless (stringp child) + collect child)) + +(defun dom-set-attributes (node attributes) + "Set the attributes of NODE to ATTRIBUTES." + (setq node (dom-ensure-node node)) + (setcar (cdr node) attributes)) + +(defun dom-set-attribute (node attribute value) + "Set ATTRIBUTE in NODE to VALUE." + (setq node (dom-ensure-node node)) + (let ((old (assoc attribute (cadr node)))) + (if old + (setcdr old value) + (setcar (cdr node) (nconc (cadr node) (list (cons attribute value))))))) + +(defmacro dom-attr (node attr) + "Return the attribute ATTR from NODE. +A typical attribute is `href'." + `(cdr (assq ,attr (dom-attributes ,node)))) + +(defun dom-text (node) + "Return all the text bits in the current node concatenated." + (mapconcat 'identity (cl-remove-if-not 'stringp (dom-children node)) " ")) + +(defun dom-texts (node &optional separator) + "Return all textual data under NODE concatenated with SEPARATOR in-between." + (mapconcat + 'identity + (mapcar + (lambda (elem) + (if (stringp elem) + elem + (dom-texts elem separator))) + (dom-children node)) + (or separator " "))) + +(defun dom-child-by-tag (dom tag) + "Return the first child of DOM that is of type TAG." + (assoc tag (dom-children dom))) + +(defun dom-by-tag (dom tag) + "Return elements in DOM that is of type TAG. +A name is a symbol like `td'." + (let ((matches (cl-loop for child in (dom-children dom) + for matches = (and (not (stringp child)) + (dom-by-tag child tag)) + when matches + append matches))) + (if (equal (dom-tag dom) tag) + (cons dom matches) + matches))) + +(defun dom-strings (dom) + "Return elements in DOM that are strings." + (cl-loop for child in (dom-children dom) + if (stringp child) + collect child + else + append (dom-strings child))) + +(defun dom-by-class (dom match) + "Return elements in DOM that have a class name that matches regexp MATCH." + (dom-elements dom 'class match)) + +(defun dom-by-style (dom match) + "Return elements in DOM that have a style that matches regexp MATCH." + (dom-elements dom 'style match)) + +(defun dom-by-id (dom match) + "Return elements in DOM that have an ID that matches regexp MATCH." + (dom-elements dom 'id match)) + +(defun dom-elements (dom attribute match) + "Find elements matching MATCH (a regexp) in ATTRIBUTE. +ATTRIBUTE would typically be `class', `id' or the like." + (let ((matches (cl-loop for child in (dom-children dom) + for matches = (and (not (stringp child)) + (dom-elements child attribute + match)) + when matches + append matches)) + (attr (dom-attr dom attribute))) + (if (and attr + (string-match match attr)) + (cons dom matches) + matches))) + +(defun dom-parent (dom node) + "Return the parent of NODE in DOM." + (if (memq node (dom-children dom)) + dom + (let ((result nil)) + (dolist (elem (dom-children dom)) + (when (and (not result) + (not (stringp elem))) + (setq result (dom-parent elem node)))) + result))) + +(defun dom-node (tag &optional attributes &rest children) + "Return a DOM node with TAG and ATTRIBUTES." + (if children + `(,tag ,attributes ,@children) + (list tag attributes))) + +(defun dom-append-child (node child) + "Append CHILD to the end of NODE's children." + (setq node (dom-ensure-node node)) + (nconc node (list child))) + +(defun dom-add-child-before (node child &optional before) + "Add CHILD to NODE's children before child BEFORE. +If BEFORE is nil, make CHILD NODE's first child." + (setq node (dom-ensure-node node)) + (let ((children (dom-children node))) + (when (and before + (not (memq before children))) + (error "%s does not exist as a child" before)) + (let ((pos (if before + (cl-position before children) + 0))) + (if (zerop pos) + ;; First child. + (setcdr (cdr node) (cons child (cddr node))) + (setcdr (nthcdr (1- pos) children) + (cons child (nthcdr pos children)))))) + node) + +(defun dom-ensure-node (node) + "Ensure that NODE is a proper DOM node." + ;; Add empty attributes, if none. + (when (consp (car node)) + (setq node (car node))) + (when (= (length node) 1) + (setcdr node (list nil))) + node) + +(defun dom-pp (dom &optional remove-empty) + "Pretty-print DOM at point. +If REMOVE-EMPTY, ignore textual nodes that contain just +white-space." + (let ((column (current-column))) + (insert (format "(%S " (dom-tag dom))) + (let* ((attr (dom-attributes dom)) + (times (length attr)) + (column (1+ (current-column)))) + (if (null attr) + (insert "nil") + (insert "(") + (dolist (elem attr) + (insert (format "(%S . %S)" (car elem) (cdr elem))) + (if (zerop (cl-decf times)) + (insert ")") + (insert "\n" (make-string column ? )))))) + (let* ((children (if remove-empty + (cl-remove-if + (lambda (child) + (and (stringp child) + (string-match "\\`[\n\r\t ]*\\'" child))) + (dom-children dom)) + (dom-children dom))) + (times (length children))) + (if (null children) + (insert ")") + (insert "\n" (make-string (1+ column) ? )) + (dolist (child children) + (if (stringp child) + (if (or (not remove-empty) + (not (string-match "\\`[\n\r\t ]*\\'" child))) + (insert (format "%S" child))) + (dom-pp child remove-empty)) + (if (zerop (cl-decf times)) + (insert ")") + (insert "\n" (make-string (1+ column) ? )))))))) + +(provide 'dom) + +;;; dom.el ends here diff --git a/lisp/electric.el b/lisp/electric.el index 004e68ebff6..dd7767fd5eb 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -164,7 +164,10 @@ ;; Don't shrink the window, but expand it if necessary. (goto-char (point-min)) (unless (= (point-max) (window-end win t)) - (fit-window-to-buffer win max-height)) + ;; This call is executed even if the window existed before, was + ;; reused, ... contradicting a claim in the comment before this + ;; function. + (fit-window-to-buffer win max-height nil nil nil t)) win))) ;;; Electric keys. @@ -368,7 +371,7 @@ newline after CHAR but stay in the same place.") (setq pos (electric--after-char-pos)) ;; Not in a string or comment. (not (nth 8 (save-excursion (syntax-ppss pos))))) - (let ((end (copy-marker (point))) + (let ((end (point-marker)) (sym (if (functionp rule) (funcall rule) rule))) (set-marker-insertion-type end (not (eq sym 'after-stay))) (goto-char pos) diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el deleted file mode 100644 index e20ae9543cd..00000000000 --- a/lisp/emacs-lisp/authors.el +++ /dev/null @@ -1,1394 +0,0 @@ -;;; authors.el --- utility for maintaining Emacs's AUTHORS file -*-coding: utf-8 -*- - -;; Copyright (C) 2000-2015 Free Software Foundation, Inc. - -;; Author: Gerd Moellmann <gerd@gnu.org> -;; Maintainer: Kim F. Storm <storm@cua.dk> -;; Keywords: maint -;; Package: emacs - -;; 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 <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Use M-x authors RET to create an *Authors* buffer that can used as -;; or merged with Emacs's AUTHORS file. - -;;; Code: - -(defvar authors-coding-system 'utf-8 - "Coding system used in the AUTHORS file.") - -(defconst authors-many-files 20 - "Maximum number of files for which to print individual information. -If an author has modified more files, only the names of the most -frequently modified files are printed and a count of the additional -files.") - -(defconst authors-aliases - '( - ("Aaron S. Hawley" "Aaron Hawley") - ("Alexandru Harsanyi" "Alex Harsanyi") - ("Andrew Csillag" "Drew Csillag") - ("Anna M. Bigatti" "Anna Bigatti") - ("Barry A. Warsaw" "Barry A. Warsaw, Century Computing, Inc." - "Barry A. Warsaw, ITB" "Barry Warsaw") - ("Bill Carpenter" "WJ Carpenter") - ("Bill Mann" "William F. Mann") - ("Bill Rozas" "Guillermo J. Rozas") - ("Björn Torkelsson" "Bjorn Torkelsson") - ("Brian Fox" "Brian J. Fox") - ("Brian P Templeton" "BT Templeton") - ("Brian Sniffen" "Brian T. Sniffen") - ("David Abrahams" "Dave Abrahams") - ("David J. Biesack" "David Biesack") - ("David De La Harpe Golden" "David Golden") - ("David Gillespie" "Dave Gillespie") - ("David Kågedal" "David K..edal") - ("David M. Koppelman" "David Koppelman") - ("David M. Smith" "David Smith" "David M Smith") - ("David O'Toole" "David T. O'Toole") - ("Deepak Goel" "D. Goel") - ("Ed L. Cashin" "Ed L Cashin") - ("Edward M. Reingold" "Ed\\(ward\\( M\\)?\\)? Reingold" "Reingold Edward M") - ("Emilio C. Lopes" "Emilio Lopes") - ("Eric M. Ludlam" "Eric Ludlam") - ("Eric S. Raymond" "Eric Raymond") - ("Fabián Ezequiel Gallina" "Fabian Ezequiel Gallina" "Fabi.n E\\. Gallina") - ("Francis J. Wright" "Dr Francis J. Wright" "Francis Wright") - ("François Pinard" "Francois Pinard") - ("Francesco Potortì" "Francesco Potorti" "Francesco Potorti`") - ("Frederic Pierresteguy" "Fred Pierresteguy") - ("Gerd Möllmann" "Gerd Moellmann") - ("Hallvard B. Furuseth" "Hallvard B Furuseth" "Hallvard Furuseth") - ("Hrvoje Nikšić" "Hrvoje Niksic") - ;; lisp/org/ChangeLog 2010-11-11. - (nil "aaa bbb") - (nil "Code Extracted") ; lisp/newcomment.el's "Author:" header - ("Jaeyoun Chung" "Jae-youn Chung" "Jae-you Chung" "Chung Jae-youn") - ("Jan Djärv" "Jan D." "Jan Djarv") - ("Jay K. Adams" "Jay Adams") - ("Jérôme Marant" "Jérôme Marant" "Jerome Marant") - ("Jens-Ulrik Holger Petersen" "Jens-Ulrik Petersen") - ("Jeremy Bertram Maitin-Shepard" "Jeremy Maitin-Shepard") - ("Johan Bockgård" "Johan Bockgard") - ("John J Foerch" "John Foerch") - ("John W. Eaton" "John Eaton") - ("Jonathan I. Kamens" "Jonathan Kamens") - ("Jorgen Schäfer" "Jorgen Schaefer") - ("Joseph Arceneaux" "Joe Arceneaux") - ("Joseph M. Kelsey" "Joe Kelsey") ; FIXME ? - ("Juan León Lahoz García" "Juan-Leon Lahoz Garcia") - ("Jürgen Hötzel" "Juergen Hoetzel") - ("K. Shane Hartman" "Shane Hartman") - ("Kai Großjohann" "Kai Grossjohann") - ("Karl Berry" "K. Berry") - ("Károly Lőrentey" "Károly Lőrentey" "Lőrentey Károly") - ("Kazushi Marukawa" "Kazushi (Jam) Marukawa") - ("Ken Manheimer" "Kenneth Manheimer") - ("Kenichi Handa" "Ken'ichi Handa" "Kenichi HANDA" "K\\. Handa") - ("Kevin Greiner" "Kevin J. Greiner") - ("Kim F. Storm" "Kim Storm") - ("Kyle Jones" "Kyle E. Jones") - ("Lars Magne Ingebrigtsen" "Lars Ingebrigtsen") - ("Marcus G. Daniels" "Marcus Daniels") - ("Mark D. Baushke" "Mark D Baushke") - ("Mark E. Shoulson" "Mark Shoulson") - ("Marko Kohtala" "Kohtala Marko") - ("Agustín Martín" "Agustin Martin" "Agustín Martín Domingo") - ("Martin Lorentzon" "Martin Lorentzson") - ("Matt Swift" "Matthew Swift") - ("Maxime Edouard Robert Froumentin" "Max Froumentin") - ("Michael R. Mauger" "Michael Mauger") - ("Michael D. Ernst" "Michael Ernst") - ("Michaël Cadilhac" "Michael Cadilhac") - ("Michael I. Bushnell" "Michael I Bushnell" "Michael I. Bushnell, p/BSG") - ("Michael R. Cook" "Michael Cook") - ("Michael Sperber" "Michael Sperber \\[Mr. Preprocessor\\]") - ("Mikio Nakajima" "Nakajima Mikio") - ("Nelson Jose dos Santos Ferreira" "Nelson Ferreira") - ("Noorul Islam" "Noorul Islam K M") -;;; ("Tetsurou Okazaki" "OKAZAKI Tetsurou") ; FIXME? - ("Paul Eggert" "Paul R\\. Eggert") - ("Pavel Janík" "Pavel Janík Ml." "Pavel Janik Ml." "Pavel Janik") - ("Pavel Kobiakov" "Pavel Kobyakov") - ("Per Abrahamsen" "Per Abhiddenware") - ("Per Starbäck" "Per Starback") - ("Peter J. Weisberg" "PJ Weisberg") - ("Peter S. Galbraith" "Peter S Galbraith" "Peter Galbraith") - ("Peter Runestig" "Peter 'luna' Runestig") - ("Piotr Zieliński" "Piotr Zielinski") - ("Rainer Schöpf" "Rainer Schoepf") - ("Raja R. Harinath" "Raja R Harinath") - ("Richard G. Bielawski" "Richard G Bielawski" "Richard Bielawski") - ("Richard King" "Dick King") - ("Richard M. Stallman" "Richard Stallman" "rms@gnu.org") - ("Robert J. Chassell" "Bob Chassell") - ("Roberto Huelga Díaz" "Roberto Huelga") - ("Roland B. Roberts" "Roland B Roberts" "Roland Roberts") - ("Rui-Tao Dong" "Rui-Tao Dong ~{6-HpLN~}") - ("Sacha Chua" "Sandra Jean Chua") - ("Sam Steingold" "Sam Shteingold") - ("Satyaki Das" "Indexed search by Satyaki Das") - ("Sébastien Vauban" "Sebastien Vauban") - ("Sergey Litvinov" "Litvinov Sergey") - ;; There are other Stefans. -;;; ("Stefan Monnier" "Stefan") - ("Steven L. Baur" "SL Baur" "Steven L Baur") - ("Stewart M. Clamen" "Stewart Clamen") - ("Stuart D. Herring" "Stuart Herring" "Davis Herring") - ("T.V. Raman" "T\\. V\\. Raman") - ("Taichi Kawabata" "KAWABATA,? Taichi") - ("Takaaki Ota" "Tak Ota") - ("Takahashi Naoto" "Naoto Takahashi") - ("Teodor Zlatanov" "Ted Zlatanov") - ("Thomas Dye" "Tom Dye") - ("Thomas Horsley" "Tom Horsley") ; FIXME ? - ("Thomas Wurgler" "Tom Wurgler") - ("Toby Cubitt" "Toby S\\. Cubitt") - ("Tomohiko Morioka" "MORIOKA Tomohiko") - ("Torbjörn Axelsson" "Torbjvrn Axelsson") - ("Torbjörn Einarsson" "Torbj.*rn Einarsson") - ("Toru Tomabechi" "Toru TOMABECHI") - ("Tsugutomo Enami" "enami tsugutomo") - ("Ulrich Müller" "Ulrich Mueller") - ("Vincent Del Vecchio" "Vince Del Vecchio") - ("William M. Perry" "Bill Perry") - ("Wlodzimierz Bzyl" "W.*dek Bzyl") - ("Yoni Rabkin" "Yoni Rabkin Katzenell") - ("Yoshinori Koseki" "KOSEKI Yoshinori" "小関 吉則") - ("Yutaka NIIBE" "NIIBE Yutaka") - ) - "Alist of author aliases. - -Each entry is of the form (REALNAME REGEXP...). If an author's name -matches one of the REGEXPs, use REALNAME instead. -If REALNAME is nil, ignore that author.") - -;; FIXME seems it would be less fragile to check for O', Mc, etc. -(defconst authors-fixed-case - '("Barry O'Reilly" - "Brian van den Broek" - "Bryan O'Sullivan" - "Christian von Roques" - "Christophe de Dinechin" - "Craig McDaniel" - "Daniel LaLiberte" - "David J. MacKenzie" - "David McCabe" - "David O'Toole" - "Devon Sean McCullough" - "Dominique de Waleffe" - "Edward O'Connor" - "Exal de Jesus Garcia Carrillo" - "George McNinch" - "Greg McGary" - "Hans de Graaff" - "Ivan Vilata i Balaguer" - "Jae-hyeon Park" - "James TD Smith" - "Jay McCarthy" - "Joel N. Weber II" - "Matt McClure" - "Mike McLean" - "Michael McNamara" - "Mike McEwan" - "Nelson Jose dos Santos Ferreira" - "Peter von der Ahe" - "Peter O'Gorman" - "Piet van Oostrum" - "Roland McGrath" - "Santiago Payà i Miralta" - "Sean O'Halpin" - "Sean O'Rourke" - "Shun-ichi Goto" - "Thomas DeWeese" - "Tijs van Bakel" - "Yu-ji Hosokawa") - "List of authors whose names cannot be simply capitalized.") - -(defvar authors-public-domain-files - '("emerge\\.el" - "vi\\.el" - "feedmail\\.el" - "mailpost\\.el" - "hanoi\\.el" - "meese\\.el" - "studly\\.el" - "modula2\\.el" - "nnmaildir\\.el" - "nnil\\.el" - "b2m\\.c" - "unexhp9k800\\.c" - "emacsclient\\.1" - "check-doc-strings") - "List of regexps matching files for which the FSF doesn't need papers.") - - -(defvar authors-obsolete-files-regexps - '(".*loaddefs.el$" ; not obsolete, but auto-generated - "\\.\\(cvs\\|git\\)ignore$" ; obsolete or uninteresting - "\\.arch-inventory$" - "automated/data/" ; not interesting - ;; TODO lib/? Matches other things? - "build-aux/" "m4/" "Emacs.xcodeproj" "mapfiles" "\\.map\\'" - "preferences\\.\\(nib\\|gorm\\)" - ;; Generated files that have since been removed. - "\\(refcard\\(-de\\|-pl\\)?\\|calccard\\|dired-ref\\|orgcard\\|\ -gnus-booklet\\|fr-drdref\\)\\.p\\(df\\|s\\)\\'") - "List of regexps matching obsolete files. -Changes to files matching one of the regexps in this list are not listed.") - -(defconst authors-no-scan-regexps - '("etc/nxml/" - "automated/data/") - "Lists of regexps matching files not to scan for authorship.") - -(defconst authors-ignored-files - '("external-lisp" - "lock" "share-lib" "local-lisp" - "noleim-Makefile.in" - "NEWS" "ORDERS" "PROBLEMS" "FAQ" "AUTHORS" "FOR-RELEASE" "TODO" "todo" - "MACHINES" "SERVICE" - "README.unicode" "README.multi-tty" "TUTORIAL.translators" - "NEWS.unicode" "COPYING.DJ" "Makefile.old" "Makefile.am" - "NEWS.1" "OOOOONEWS...OONEWS" "OOOONEWS" "etc/NEWS" - "NEWS.1-17" "NEWS.18" "NEWS.19" "NEWS.20" "NEWS.21" "NEWS.22" - "MAINTAINERS" "MH-E-NEWS" - "install.sh" "install-sh" "missing" "mkinstalldirs" - "termcap.dat" "termcap.src" "termcap.ucb" "termcap" - "ChangeLog.nextstep" "Emacs.clr" "spec.txt" - "gfdl.1" - "texi/Makefile.in" - "Imakefile" "icons/sink.ico" "aixcc.lex" - "nxml/char-name/unicode" - "spec.txt" - "js2-mode.el" ; only installed very briefly, replaced by js.el - ;; In the old imported lisp/url ChangeLog, but never in Emacs. - "mule-sysdp.el" - ;; Only briefly present. - "tests/gnustest-nntp.el" "tests/gnustest-registry.el" - "cedet/tests/testtemplates.cpp" - "cedet/tests/testusing.cpp" - "cedet/tests/scopetest.cpp" - "cedet/tests/scopetest.java" - "cedet/tests/test.cpp" - "cedet/tests/test.py" - "cedet/tests/teststruct.cpp" - "*.el" - ;; Autogen: - "cus-load.el" "finder-inf.el" "ldefs-boot.el" "loaddefs-boot.el" - "compile" "config.guess" "config.sub" "depcomp" - "autogen/compile" "autogen/config.guess" "autogen/config.in" - "autogen/config.sub" "autogen/depcomp" "autogen/install-sh" - "autogen/missing" "autogen" - "autogen/copy_autogen" ; not generated, but trivial and now removed - "dir_top" - ;; Only existed briefly, then renamed: - "images/icons/allout-widgets-dark-bg" - "images/icons/allout-widgets-light-bg" - ;; Never had any meaningful changes logged, now deleted: - "unidata/bidimirror.awk" "unidata/biditype.awk" - "split-man" "Xkeymap.txt" "ms-7bkermit" "ulimit.hack" - "gnu-hp300" "refcard.bit" "ledit.l" "forms.README" "forms-d2.dat" - "CXTERM-DIC/PY.tit" "CXTERM-DIC/ZIRANMA.tit" - "CXTERM-DIC/CTLau.tit" "CXTERM-DIC/CTLauB.tit" - "copying.paper" "celibacy.1" "condom.1" "echo.msg" "sex.6" - "COOKIES" "INTERVIEW" "MAILINGLISTS" "MOTIVATION" - "NICKLES.WORTH" "INTERVAL.IDEAS" "RCP" - "3B-MAXMEM" "AIX.DUMP" "SUN-SUPPORT" "XENIX" - "CODINGS" "CHARSETS" - "calc/INSTALL" "calc/Makefile" "calc/README.prev" - "vms-pp.trans" "_emacs" "batcomp.com" "notes/cpp" ; admin/ - "emacsver.texi.in" - "vpath.sed" - "Cocoa/Emacs.base/Contents/Info.plist" - "Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings" - "GNUstep/Emacs.base/Resources/Info-gnustep.plist" - "GNUstep/Emacs.base/Resources/Emacs.desktop" - "Cocoa/Emacs.base/Contents/Resources/English.lproj" - ;; Only existed briefly, then deleted: - "coccinelle/overlay.cocci" "coccinelle/symbol.cocci" - ;; MH-E stuff not in Emacs: - "import-emacs" "release-utils" - ;; Erc stuff not in Emacs: - "ChangeLog.2001" "ChangeLog.2002" "ChangeLog.2003" "ChangeLog.2004" - "ChangeLog.2005" - "README.extras" "dir-template" "mkChangeLog" "MkChangeLog" "erc-auto.in" - "CREDITS" "HACKING" - "debian/changelog" - "debian/control" - "debian/copyright" - "debian/maint/conffiles" - "debian/maint/conffiles.in" - "debian/maint/postinst" - "debian/maint/postinst.in" - "debian/maint/prerm" - "debian/maint/prerm.in" - "debian/README.Debian" - "debian/README.erc-speak" - "debian/rules" - "debian/scripts/install" - "debian/scripts/install.in" - "debian/scripts/remove" - "debian/scripts/remove.in" - "debian/scripts/startup" - "debian/scripts/startup.erc" - "debian/scripts/startup.erc-speak" - ;; Used to be in admin, not very interesting. - "emacs-pretesters" "make-announcement" "make-changelog-diff" - ;; Textual comments that are not files. - "All" "Version" "Everywhere" "Many" "Various" "files" - ;; Directories. - "vms" "mac" "url" "tree-widget" - ) - "List of files and directories to ignore. -Changes to files in this list are not listed.") - -;; List via: find . -name '*.el' | sed 's/.*\///g' | sort | uniq -d -;; FIXME It would be better to discover these dynamically. -(defconst authors-ambiguous-files - '("Makefile.in" - "makefile.w32-in" - "chart.el" - "cl-lib.el" - "compile.el" - "complete.el" - "cpp.el" - "ctxt.el" - "custom.el" - "cyrillic.el" - "czech.el" - "debug.el" - "dired.el" - "el.el" - "eshell.el" - "ethiopic.el" - "f90.el" - "files.el" - "find.el" - "format.el" - "generic.el" - "georgian.el" - "grammar.el" - "greek.el" - "grep.el" - "hebrew.el" - "imenu.el" - "indian.el" - "info-xref.el" - "japanese.el" - "java.el" - "lao.el" - "linux.el" - "locate.el" - "make.el" - "mode.el" - "mule-util.el" - "python.el" - "rmailmm.el" - "semantic.el" - "shell.el" - "simple.el" - "slovak.el" - "sort.el" - "speedbar.el" - "srecode.el" - "table.el" - "texi.el" - "thai.el" - "thingatpt.el" - "tibetan.el" - "util.el" - "vc-bzr.el" - "wisent.el") - "List of basenames occurring more than once in the source.") - -;; FIXME :cowrote entries here can be overwritten by :wrote entries -;; derived from a file's Author: header (eg mh-e). This really means -;; the Author: header is erroneous. -(defconst authors-fixed-entries - '(("Richard M. Stallman" :wrote "[The original GNU Emacs and numerous files]") - ("Joseph Arceneaux" :wrote "xrdb.c") - ;; This refers to the obsolete Willisson (qv) version. -;;; ("Blitz Product Development Corporation" :wrote "ispell.el") - ("Frank Bresz" :wrote "diff.el") - ("David M. Brown" :wrote "array.el") - ;; No longer distributed. -;;; ("Gary Byers" :changed "xenix.h") - ;; No longer distributed: freebsd.h - ;; Only trivial pieces remain, merged into configure.ac. - ("Shawn M. Carey" :wrote "[some early FreeBSD support]") - ;; hp800.h renamed from hp9000s800.h, hpux.h merged into hpux10-20.h. - ;; FIXME overwritten by Author:. - ("Satyaki Das" :cowrote "mh-search.el") - ;; No longer distributed: hp800.h, hpux10-20.h. - ;; Only trivial pieces remain, merged into configure.ac. - ("Eric Decker" :changed "sysdep.c (and other files for HP-UX support)") - ("Lawrence R. Dodd" :cowrote "dired-x.el") - ;; No longer distributed. -;;; ("Viktor Dukhovni" :wrote "unexsunos4.c") - ("Paul Eggert" :wrote "rcs2log") ; "vcdiff" - ("Fred Fish" :changed "unexcoff.c") - ;; No longer distributed. -;;; ("Tim Fleehart" :wrote "makefile.nt") - ("Keith Gabryelski" :wrote "hexl.c") - ("Kevin Gallagher" :wrote "flow-ctrl.el") - ;; Also wrote an earlier version of disp-table.el, since replaced - ;; by Erik Naggum's version; also iso-syntax.el, later renamed to - ;; latin-1.el, since deleted. - ("Howard Gayle" :wrote "casetab.c") - ;; :wrote mh-pick.el, since merged into mh-search.el. - ;; Originally wrote mh-funcs.el, but it has been rewritten since. - ("Stephen Gildea" :wrote "refcard.tex" - :cowrote "mh-funcs.el" "mh-search.el") - ;; cl.texinfo renamed to cl.texi. - ("David Gillespie" :wrote "cl.texi") - ;; No longer distributed: emacsserver.c. - ("Hewlett-Packard" :changed "emacsclient.c" "server.el" "keyboard.c") - ;; No longer distributed. -;;; ("Thomas Horsley" :wrote "cxux.h" "cxux7.h") - ("Indiana University Foundation" :changed "buffer.c" "buffer.h" - "indent.c" "search.c" "xdisp.c" "region-cache.c" "region-cache.h") - ;; ibmrt.h, ibmrt-aix.h no longer distributed. - ("International Business Machines" :changed "emacs.c" "fileio.c" - "process.c" "sysdep.c" "unexcoff.c") - ;; No longer distributed. -;;; ("Ishikawa Chiaki" :changed "aviion.h" "dgux.h") - ;; No longer distributed: ymakefile, intel386.h, mem-limits.h, template.h, - ;; linux.h (was renamed to lignux.h, then to gnu-linux.h, then removed) - ("Michael K. Johnson" :changed "configure.ac" "emacs.c" - "process.c" "sysdep.c" "syssignal.h" "systty.h" "unexcoff.c") - ;; No longer distributed. -;;; ("Kyle Jones" :wrote "mldrag.el") - ("Henry Kautz" :wrote "bib-mode.el") - ;; No longer distributed: vms-pwd.h, vmsfns.c, uaf.h, - ;; dir.h (was renamed to vmsdir.h, then removed) - ("Joseph M. Kelsey" :changed "fileio.c") - ("Sam Kendall" :changed "etags.c" "etags.el") - ;; ack.texi: "We're not using his backquote.el any more." - ("Richard King" :wrote "userlock.el" "filelock.c") - ("Sebastian Kremer" :changed "add-log.el") - ("Mark Lambert" :changed "process.c" "process.h") - ("Aaron Larson" :changed "bibtex.el") - ;; It was :wrote, but it has been rewritten since. - ("James R. Larus" :cowrote "mh-e.el") - ("Lars Lindberg" :changed "dabbrev.el" :cowrote "imenu.el") - ;; No longer distributed: lselect.el. - ("Lucid, Inc." :changed "bytecode.c" "byte-opt.el" "byte-run.el" - "bytecomp.el" "delsel.el" "disass.el" "faces.el" "font-lock.el" - "lmenu.el" "mailabbrev.el" "select.el" "xfaces.c" "xselect.c") - ;; MCC. No longer distributed: emacsserver.c. - ("Microelectronics and Computer Technology Corporation" - :changed "etags.c" "emacsclient.c" "movemail.c" - "rmail.el" "rmailedit.el" "rmailkwd.el" - "rmailmsc.el" "rmailout.el" "rmailsum.el" "scribe.el" - ;; It was :wrote for xmenu.c, but it has been rewritten since. - "server.el" "lisp.h" "sysdep.c" "unexcoff.c" "xmenu.c") - ("Niall Mansfield" :changed "etags.c") - ("Brian Marick" :cowrote "hideif.el") - ("Marko Kohtala" :changed "info.el") - ("Sidney Markowitz" :changed "doctor.el") - ;; No longer distributed: env.c. - ("Richard Mlynarik" :wrote "ehelp.el") - ("Mosur Mohan" :changed "etags.c") - ("Jeff Morgenthaler" :changed "flow-ctrl.el" "vt200.el" "vt201.el" - "vt220.el" "vt240.el") - ("Motorola" :changed "buff-menu.el") - ("Hiroshi Nakano" :changed "ralloc.c") - ;; File removed in Emacs 24.1. -;;; ("Sundar Narasimhan" :changed "rnewspost.el") - ;; No longer distributed. -;;; ("NeXT, Inc." :wrote "unexnext.c") - ("Mark Neale" :changed "fortran.el") - ;; Renamed from sc.el. - ("Martin Neitzel" :changed "supercite.el") - ("Andrew Oram" :changed "calendar.texi (and other doc files)") - ("Frederic Pierresteguy" :wrote "widget.c") - ("Michael D. Prange" :changed "tex-mode.el") - ;; No longer distributed (dgux5-4r3.h was renamed to dgux5-4-3.h). -;;; ("Paul Reilly" :wrote "gux5-4r2.h" "dgux5-4-3.h") - ("Rob Riepel" :wrote "tpu-edt.doc") - ("Roland B. Roberts" :changed "files.el" "sort.el" - "buffer.h" "callproc.c" "dired.c" "process.c" "sysdep.c" "systty.h") - ;; No longer distributed. -;;; "vmspaths.h" "build.com" "compile.com" "kepteditor.com" "precomp.com" -;;; "vmsproc.el" :wrote "logout.com" "mailemacs.com") -;;; ("Guillermo J. Rozas" :wrote "fakemail.c") - ("Wolfgang Rupprecht" :changed "lisp-mode.el" "loadup.el" - "sort.el" "alloc.c" "callint.c" - ;; config.in renamed from config.h.in, now a generated file. - ;; ecrt0.c renamed from crt0.c, then removed. - "data.c" "fns.c" - "lisp.h" "lread.c" ; "sun3.h" "ymakefile" - no longer distributed - "print.c" :wrote "float-sup.el" "floatfns.c") - ("Schlumberger Technology Corporation" :changed "gud.el") - ;; Replaced by tcl.el. -;;; ("Gregor Schmid" :wrote "tcl-mode.el") - ;; No longer distributed since 24.1. -;;; ("Rainer Schöpf" :wrote "alpha.h" "unexalpha.c") - ;; No longer distributed: emacsserver.c. - ("William Sommerfeld" :wrote "emacsclient.c" "scribe.el") - ;; No longer distributed: emacsserver.c. - ("Leigh Stoller" :changed "emacsclient.c" "server.el") - ("Steve Strassmann" :wrote "spook.el") - ("Shinichirou Sugou" :changed "etags.c") - ;; No longer distributed: emacsserver.c. - ("Sun Microsystems, Inc" :changed "emacsclient.c" "server.el" - :wrote "emacs.icon" "sun.el") - ;; No longer distributed. -;;; "emacstool.1" "emacstool.c" "sun-curs.el" -;;; "sun-fns.el" "sun-mouse.el" "sunfns.c") - ;; Renamed from sc.el. - ("Kayvan Sylvan" :changed "supercite.el") - ;; No longer distributed: emacsserver.c, tcp.c. - ("Spencer Thomas" :changed "emacsclient.c" "server.el" - "dabbrev.el" "unexcoff.c" "gnus.texi") - ("Jonathan Vail" :changed "vc.el") - ;; No longer distributed: usg5-4.h - ("James Van Artsdalen" :changed "unexcoff.c") - ;; No longer distributed: src/makefile.nt, lisp/makefile.nt - ;; winnt.el renamed to w32-fns.el; nt.[ch] to w32.[ch]; - ;; ntheap.[ch] to w32heap.[ch]; ntinevt.c to w32inevt.c; - ;; ntproc.c to w32proc.c; ntterm.c to w32term.c; - ;; windowsnt.h to ms-w32.h. - ("Geoff Voelker" :wrote "w32-fns.el" "w32.c" "w32.h" "w32heap.c" - "w32heap.h" "w32inevt.c" "w32proc.c" "w32term.c" "ms-w32.h") - ("Morten Welinder" :wrote "dosfns.c" "[many MS-DOS files]" "msdos.h") - ("Eli Zaretskii" :wrote "bidi.c" "[bidirectional display in xdisp.c]" - "[tty menus in term.c]") - ;; Not using this version any more. -;;; ("Pace Willisson" :wrote "ispell.el") - ;; FIXME overwritten by Author:. - ("Bill Wohler" :cowrote "mh-e.el") - ("Garrett Wollman" :changed "sendmail.el") - ("Dale R. Worley" :changed "mail-extr.el") - ("Jamie Zawinski" :changed "bytecode.c" :wrote "tar-mode.el" - :cowrote "disass.el")) - "Actions taken from the original, manually (un)maintained AUTHORS file.") - - -(defconst authors-valid-file-names - '("aclocal.m4" - "build-ins.in" - "Makefile" - "Makefile.noleim" - "makedist.bat" - "makefile.def" - "makefile.nt" - "ns.mk" - "README" - ;; There were a few of these, not just the generated top-level one. - "configure" "config.h" - ;; nt/ - "ebuild.bat" "install.bat" "fast-install.bat" - "debug.bat.in" "emacs.bat.in" - "inc/sys/dir.h" "inc/gettext.h" - ".gdbinit-union" - "alloca.s" - "make-delta" - "config.w95" - "msysconfig.sh" - "emacstool.1" - "align.umax" - "cxux-crt0.s" - "gould-sigvec.s" - "getdate.y" - "ymakefile" - "permute-index" "index.perm" - "ibmrs6000.inp" - "b2m.c" "b2m.1" "b2m.pl" "rcs-checkin.1" - "emacs.bash" "emacs.csh" "ms-kermit" - "emacs.ico" - "emacs21.ico" - "emacs.py" "emacs2.py" "emacs3.py" - "BABYL" "LPF" "LEDIT" "OTHER.EMACSES" - "emacs16_mac.png" "emacs24_mac.png" - "emacs256_mac.png" "emacs32_mac.png" - "emacs48_mac.png" "emacs512_mac.png" - "ps-prin2.ps" "ps-prin3.ps" - "emacs.xbm" "gnu.xpm" "gnus-pointer.xbm" "gnus-pointer.xpm" - ;; Moved from etc/ to etc/images, and/or removed. - "gnus.pbm" "gnus.xbm" "gnus.xpm" "letter.pbm" "letter.xbm" "letter.xpm" - "splash.pbm" "splash.xbm" "splash.xpm" "splash8.xpm" - "images/execute.pbm" "images/execute.xpm" "images/fld-open.pbm" - "images/fld-open.xpm" "images/highlight.pbm" "images/highlight.xpm" - "images/mail.pbm" "images/mail.xpm" "images/mail/alias.pbm" - "images/mail/alias.xpm" "images/mail/refile.pbm" - "images/mail/refile.xpm" "images/page-down.pbm" - "images/page-down.xpm" "images/widen.pbm" "images/widen.xpm" - "images/gnus/bar.xbm" "images/gnus/bar.xpm" - "images/gnus/reverse-smile.xpm" - "revdiff" ; admin/ - "vcdiff" "rcs-checkin" "tindex.pl" - "mainmake" "sed1.inp" "sed2.inp" "sed3.inp" ; msdos/ - "mac-fix-env.m" - ;; Deleted vms stuff: - "temacs.opt" "descrip.mms" "compile.com" "link.com" - "compact.el" "fadr.el" - "calc/calc-maint.el" - "emacs-lisp/cl-specs.el" - "emacs-lisp/eieio-comp.el" - "erc-hecomplete.el" - "eshell/esh-maint.el" - "language/persian.el" - "ledit.el" "meese.el" "iswitchb.el" "longlines.el" - "mh-exec.el" "mh-init.el" "mh-customize.el" - "net/zone-mode.el" "xesam.el" - "term/mac-win.el" "sup-mouse.el" - "url-https.el" - "org-mac-message.el" "org-mew.el" "org-w3m.el" "org-vm.el" "org-wl.el" - "org-mks.el" "org-remember.el" "org-xoxo.el" "org-docbook.el" - "org-freemind.el" "ox-jsinfo.el" - "org-exp-blocks.el" ; maybe this is ob-exp now? dunno - "org-lparse.el" - "org-special-blocks.el" "org-taskjuggler.el" - ;; gnus - "nnwfm.el" "nnlistserv.el" "nnkiboze.el" "nndb.el" "nnsoup.el" - "netrc.el" "password.el" "sasl-cram.el" "sasl-digest.el" "sasl-ntlm.el" - "sasl.el" "dig.el" "dns.el" "hex-util.el" "sha1.el" "md4.el" - "hmac-def.el" "hmac-md5.el" "ntlm.el" "hashcash.el" "smime-ldap.el" - "assistant.el" "gnus-utils.el" "tls.el" "pgg-def.el" "pgg-gpg.el" - "gnus-compat.el" "pgg-parse.el" "pgg-pgp.el" "pgg-pgp5.el" "pgg.el" - "dns-mode.el" "run-at-time.el" "gnus-encrypt.el" "sha1-el.el" - "gnus-gl.el" "gnus.sum.el" "proto-stream.el" "color.el" "color-lab.el" - "eww.el" "shr-color.el" "shr.el" "earcon.el" "gnus-audio.el" "encrypt.el" - "format-spec.el" "gnus-move.el" - ;; doc - "getopt.c" "texindex.c" "news.texi" "vc.texi" "vc2-xtra.texi" - "back.texi" "vol1.texi" "vol2.texi" "elisp-covers.texi" "two.el" - "front-cover-1.texi" "locals.texi" "calendar.texi" "info-stnd.texi" - "tasks.texi" - "advice.texi" "picture.texi" "texinfo.tex" - ;; lwlib: - "dispatch.c" "dispatch.h" "xrdb-cpp.c" "xrdb.c" - "lwlib-Xol.c" "lwlib-Xol.h" "lwlib-Xolmb.c" "lwlib-Xolmb.h" - "lwlib-XolmbP.h" - ;; lib/ - "lib/stdio.c" "lib/gl_openssl.h" "lib/sigprocmask.c" - "lib/pthread_sigprocmask.c" "lib/ldtoastr.c" "lib/dummy.c" - "lib/ignore-value.h" - ;; lib-src/ - "cvtmail.c" "digest-doc.c" "emacsserver.c" "emacstool.c" "env.c" - "etags-vmslib.c" "fakemail.c" "getdate.c" "getopt.h" "getopt1.c" - "getopt_.h" "getopt_int.h" "gettext.h" "leditcfns.c" "loadst.c" - "make-path.c" "qsort.c" "sorted-doc.c" "tcp.c" "timer.c" "wakeup.c" - "yow.c" - ;; etc/ - "emacsclient.c" "etags.c" "hexl.c" "make-docfile.c" "movemail.c" - "test-distrib.c" "testfile" - "tpu-edt.doc" ; see below - ) - "File names which are valid, but no longer exist (or cannot be found) -in the repository.") - -;; Note that any directory part on the RHS is retained. -;; Cf authors-renamed-files-regexps. -;; NB So only add a directory if needed to disambiguate. -;; FIXME? -;; Although perhaps we could let authors-disambiguate-file-name do that? -(defconst authors-renamed-files-alist - '(("nt.c" . "w32.c") ("nt.h" . "w32.h") - ("ntheap.c" . "w32heap.c") ("ntheap.h" . "w32heap.h") - ("ntinevt.c" . "w32inevt.c") ("ntinevt.h" . "w32inevt.h") - ("ntproc.c" . "w32proc.c") - ("w32console.c" . "w32term.c") - ("unexnt.c" . "unexw32.c") - ("s/windowsnt.h" . "s/ms-w32.h") - ("s/ms-w32.h" . "inc/ms-w32.h") - ("src/config.h" . "config.h") - ("winnt.el" . "w32-fns.el") - ("linux.h" . "gnu-linux.h") - ("emacs.manifest" . "emacs-x86.manifest") - ("config.emacs" . "configure") - ("configure.in" . "configure.ac") - ("config.h.dist" . "config.in") - ("config.h-dist" . "config.in") - ("config.h.in" . "config.in") - ("debug.bat" . "debug.bat.in") - ("emacs.bat" . "emacs.bat.in") - ;; paths.h.dist -> paths.h-dist -> paths.h.in -> paths.in -> epaths.in. - ("paths.h.dist" . "epaths.in") - ("paths.h-dist" . "epaths.in") - ("paths.h.in" . "epaths.in") - ("paths.in" . "epaths.in") - ("patch1" . "sed1.inp") - ("INSTALL.MSYS" . "INSTALL") - ("server.c" . "emacsserver.c") - ("lib-src/etags.c" . "etags.c") - ;; msdos/ - ("is-exec.c" . "is_exec.c") - ("enriched.doc" . "enriched.txt") - ("GETTING.GNU.SOFTWARE" . "FTP") - ("etc/MACHINES" . "MACHINES") - ("ONEWS" . "NEWS.19") - ("ONEWS.1" . "NEWS.1-17") - ("ONEWS.2" . "NEWS.1-17") - ("ONEWS.3" . "NEWS.18") - ("ONEWS.4" . "NEWS.18") - ("ORDERS.USA" . "ORDERS") - ("EUROPE" . "ORDERS") - ("DIFF" . "OTHER.EMACSES") - ("CCADIFF" . "OTHER.EMACSES") - ("GOSDIFF" . "OTHER.EMACSES") - ;; Moved from lisp/tpu-doc.el to etc/tpu-edt.doc in Emacs 19.29. - ;; Removed in Emacs 19.30, replaced by new file etc/edt-user.doc - ;; (no associated ChangeLog entry). - ("tpu-doc.el" . "tpu-edt.doc") - ("Makefile.in.in" . "Makefile.in") - ("leim-Makefile" . "leim/Makefile") - ("leim-Makefile.in" . "leim/Makefile.in") - ("emacs-lisp/testcover-ses.el" . "tcover-ses.el") - ("emacs-lisp/testcover-unsafep.el" . "tcover-unsafep.el") - ("progmodes/dos.el" . "bat-mode.el") - ;; index and pick merged into search. - ("mh-index.el" . "mh-search.el") - ("mh-pick.el" . "mh-search.el") - ("font-setting.el" . "dynamic-setting.el") - ("help-funs.el" . "help-fns.el") - ("erc-notifications.el" . "erc-desktop-notifications.el") - ("org-complete.el" . "org-pcomplete.el") - ("org-export.el" . "ox.el") ; ? - ;; Was definitely renamed to org-latex.el, then... ? - ("org-export-latex.el" . "ox-latex.el") ; ? - ("org-exp.el" . "ox.el") ; ? - ("progmodes/cfengine3.el" . "cfengine.el") - ("progmodes/delphi.el" . "opascal.el") - ("octave-inf.el" . "octave.el") - ("octave-mod.el" . "octave.el") - ("progmodes/octave-inf.el" . "octave.el") - ("progmodes/octave-mod.el" . "octave.el") - ;; Obsolete. - ("emacs-lisp/assoc.el" . "assoc.el") - ("emacs-lisp/cust-print.el" . "cust-print.el") - ("mail/mailpost.el" . "mailpost.el") - ("play/bruce.el" . "bruce.el") - ("play/yow.el" . "yow.el") - ("patcomp.el" . "patcomp.el") - ;; From lisp to etc/forms. - ("forms-d2.el" . "forms-d2.el") - ("forms-pass.el" . "forms-pass.el") - ;; From lisp/ to etc/nxml. - ("nxml/test.invalid.xml" . "test-invalid.xml") - ("nxml/test.valid.xml" . "test-valid.xml") - ;; The one in lisp is eshell/eshell.el. - ("eshell.el" . "automated/eshell.el") - ("eshell/esh-test.el" . "automated/eshell.el") - ;; INSTALL-CVS -> .CVS -> .BZR -> .REPO - ("INSTALL-CVS" . "INSTALL.REPO") - ("INSTALL.CVS" . "INSTALL.REPO") - ("INSTALL.BZR" . "INSTALL.REPO") - ("gnus-logo.eps" . "gnus-logo.eps") ; moved to refcards/ - ("build-install" . "build-ins.in") - ("build-install.in" . "build-ins.in") - ("unidata/Makefile" . "unidata/Makefile.in") - ("mac/uvs.el" . "unidata/uvs.el") - ;; Moved from top to etc/ - ("CONTRIBUTE" . "CONTRIBUTE") - ("FTP" . "FTP") - ;; Moved from top to build-aux/ - ("move-if-change" . "move-if-change") - ("update-subdirs" . "update-subdirs") - ("emacs.tex" . "emacs.texi") - ("faq.texi" . "efaq.texi") - ("major.texi" . "modes.texi") - ;; And from emacs/ to misc/ and back again. - ("ns-emacs.texi" . "macos.texi") - ("overrides.texi" . "gnus-overrides.texi") - ("xresmini.texi" . "xresources.texi") - ;; Not renamed, but we only have the latter in the Emacs repo. - ("trampver.texi.in" . "trampver.texi") - ;; Renamed with same directory. - ("e/eterm" . "eterm-color") - ("e/eterm.ti" . "eterm-color.ti") - ("README.txt" . "README") - ("emacs.names" . "JOKES") - ("ED.WORSHIP" . "JOKES") - ("GNU.JOKES" . "JOKES") - ("CHARACTERS" . "TODO") - ("images/gnus/mail_send.xpm" . "mail-send.xpm") ; still in images/gnus - ;; Renamed within same directory. - ("schema/xhtml-basic-form.rnc" . "xhtml-bform.rnc" ) - ("schema/xhtml-basic-table.rnc" . "xhtml-btable.rnc") - ("schema/xhtml-list.rnc" . "xhtml-lst.rnc") - ("schema/xhtml-target.rnc" . "xhtml-tgt.rnc") - ("schema/xhtml-style.rnc" . "xhtml-xstyle.rnc") - ("schema/docbook-dyntbl.rnc" . "docbk-dyntbl.rnc") - ("schema/docbook-soextbl.rnc" . "docbk-soextbl.rn" ) - ("edt-user.doc" . "edt.texi") - ("DEV-NOTES" . "nextstep") - ("org/COPYRIGHT-AND-LICENSE" . "org/README") - ;; Moved to different directories. - ("ctags.1" . "ctags.1") - ("etags.1" . "etags.1") - ("emacs.1" . "emacs.1") - ("emacsclient.1" . "emacsclient.1") - ("icons/emacs21.ico" . "emacs21.ico") - ("ja-dic" . "leim/ja-dic") - ("quail" . "leim/quail") - ;; Moved from autogen/ to admin/. - ("autogen/update_autogen" . "update_autogen") - ;; Moved from etc/ to admin/. - ("grammars" . "grammars") - ;; From etc to lisp/cedet/semantic/. - ("grammars/bovine-grammar.el" . "bovine/grammar.el") - ("grammars/wisent-grammar.el" . "wisent/grammar.el") - ;; Moved from admin/nt/ to nt/. - ("nt/README.W32" . "README.W32") - ) - "Alist of files which have been renamed during their lifetime. -Elements are (OLDNAME . NEWNAME).") - -;; Should still test that the renamed file exists. Does it? -;; But it might be relative to a different ChangeLog... -;; -;; Note that only the basename of the RHS is used. -;; Cf authors-renamed-files-alist. -(defconst authors-renamed-files-regexps - '(("\\`\\(arg-nonnull\\|c\\+\\+defs\\|warn-on-use\\)\\.h\\'" - "build-aux/snippet/\\&") - ("\\`\\(ebuild\\|emacs\\|install\\|fast-install\\)\\.cmd\\'" "\\1.bat") - ("\\`\\(book-spine\\|cl\\|forms\\|functions\\|gnus\\|sc\\|texinfo\\|vip\\)\ -\\.texinfo\\'" "\\1.texi") - ("\\`\\(\\(calc\\|org\\|vip\\)card\\|viperCard\\|\ -\\(\\(cs\\|fr\\|sk\\)-\\)?dired-ref\\|\ -\\(\\(cs\\|de\\|fr\\|gnus\\|pl\\|pt-br\\|ru\\|sk\\)-\\)?refcard\\|\ -\\(\\(cs\\|fr\\|sk\\)-\\)?survival\\)\\.tex\\'" "refcards/\\&") - ("\\`refcard-\\(de\\|pl\\)\\.tex\\'" "refcards/\\1-refcard.tex") - ("\\`\\(refcards/\\)?fr-drdref\\.tex\\'" "refcards/fr-dired-ref.tex") - ("^\\(TUTORIAL[^/]*\\)" "tutorials/\\1") - ("\\`themes/dev-\\(tsdh-\\(?:light\\|dark\\)-theme\\.el\\)\\'" - "themes/\\1") - ;; Moved from lisp/toolbar to etc/images. - ("\\`toolbar/\\(back\\|fwd\\|left\\|right\\|up\\)_arrow\ -\\(\\.\\(?:pb\\|xp\\)m\\)\\'" "images/\\1-arrow\\2") - ("\\`toolbar/lc-\\(back\\|fwd\\|left\\|right\\|up\\)_arrow\ -\\(\\.\\(?:pb\\|xp\\)m\\)\\'" "images/low-color/\\1-arrow\\2") - ("\\`toolbar/mail_\\(compose\\|send\\)\\(\\.[xp]bm\\)\\'" - "images/mail/\\1") - ("\\`toolbar/jump_to\\(\\.\\(?:pb\\|xp\\)m\\)\\'" "images/jump-to\\1") - ("\\`toolbar/lc-jump_to\\(\\.\\(?:pb\\|xp\\)m\\)\\'" - "images/low-color/jump-to\\1") - ("\\`toolbar/\\(attach\\|cancel\\|close\\|copy\\|cut\\|\ -diropen\\|exit\\|help\\|home\\|index\\|info\\|mail\\|new\\|open\\|\ -paste\\|preferences\\|print\\|save\\|saveas\\|search\\|search-replace\\|\ -spell\\|undo\\)\\(\\.\\(?:pb\\|xp\\)m\\)\\'" "images/\\1\\2") - ("\\`toolbar/gud-\\(break\\|cont\\|down\\|finish\\|print\\|pstar\\|\ -remove\\|run\\|until\\|up\\|watch\\)\\(\\.\\(?:pb\\|xp\\)m\\)\\'" - "images/gud/\\1\\2") - ("\\`\\(toolbar/gud-\\|images/gud/\\)n\\(i\\)?\\(\\.\\(?:pb\\|xp\\)m\\)\\'" - "images/gud/next\\2\\3") - ("\\`\\(toolbar/gud-\\|images/gud/\\)s\\(i\\)?\\(\\.\\(?:pb\\|xp\\)m\\)\\'" - "images/gud/step\\2\\3") - ("\\`toolbar/lc-\\([-a-z]+\\.xpm\\)\\'" "images/low-color/\\1") - ("^\\(tree-widget/\\(?:default\\|folder\\)/[-a-z]+\\.\\(png\\|xpm\\)\\)$" - "images/\\1") - ("^\\(images/icons/\\)mac\\(emacs\\)_\\([0-9]+\\)\\(\\.png\\)" - "\\1\\2\\3_mac\\4") - ("\\(images/icons/\\)emacs_\\([0-9][0-9]\\)\\.png" - "\\1hicolor/\\2x\\2/apps/emacs.png") - ;; Moved from leim/ to lisp/leim/. - ("\\`quail/[-a-z0-9]+\\.el\\'" "leim/\\&") - ("\\`ja-dic/ja-dic\\.el\\'" "leim/\\&") - ("\\`vc-\\(rcs\\|cvs\\|sccs\\)-hooks\\.el\\'" "vc/vc-\\1.el") - ("\\`vc-\\(annotate\\|arch\\|bzr\\|cvs\\|dav\\|dir\\|dispatcher\\|\ -git\\|hg\\|hooks\\|mtn\\|rcs\\|sccs\\|svn\\)\\.el\\'" "vc/\\&") - ("\\`ediff-\\(diff\\|help\\|hook\\|init\\|merg\\|mult\\|ptch\\|util\\|\ -vers\\|wind\\)\\.el\\'" "vc/\\&") - ("\\`pcvs-\\(defs\\|info\\|parse\\|util\\)\\.el\\'" "vc/\\&") - ("\\`\\(add-log\\|compare-w\\|cvs-status\\|diff-mode\\|diff\\|\ -ediff\\|emerge\\|log-edit\\|log-view\\|pcvs\\|smerge-mode\\|vc\\)\\.el\\'" - "vc/\\&") - ("\\`\\(emacs-lisp/\\)?helpers\\.el\\'" "emacs-lisp/subr-x.el") - ;; I assume this is (essentially) what happened, org/ChangeLog is vague. - ("\\`org-\\(ascii\\|beamer\\|html\\|icalendar\\|jsinfo\\|latex\ -\\|odt\\|publish\\)\\.el\\'" "ox-\\1.el") - ;; From test/ to test/automated/. - ("comint-testsuite.el" "automated/\\&") - ("\\`\\(bytecomp\\|font-parse\\|icalendar\\|occur\\|newsticker\\)\ --testsuite\\.el" "automated/\\1-tests.el") - ;; NB lax rules should come last. - ("^m/m-\\(.*\\.h\\)$" "m/\\1" t) - ("^m-\\(.*\\.h\\)$" "\\1" t) - ("^s/s-\\(.*\\.h\\)$" "s/\\1" t) - ("^s-\\(.*\\.h\\)$" "\\1" t) - ("\\.\\(el\\|[ch]\\|x[pb]m\\|pbm\\)\\'" t t) - ) - "List of regexps and rewriting rules for renamed files. -Elements are (REGEXP REPLACE [LAX]). If REPLACE is a string, the file -name matching REGEXP is replaced by REPLACE using `replace-string'. -Otherwise, the file name is accepted as is. -Elements with LAX non-nil are only used in `authors-lax-changelogs'.") - -;; It's really not worth trying to make these old logs fully valid. -;; All the obvious real errors are gone. -;; The main issue is _lots_ of moving around of files. -;; Eg the progmodes/ (etc) directories did not exist before 1997. -;; Also, lib-src/ did not exist, the files were in etc/. -;; And various other things. -;; Maybe this should just be any ChangeLog with a . extension, -;; assuming we always fix logs fully before rotating them? -(defconst authors-lax-changelogs - '("erc/ChangeLog\\.0[1-8]\\'" - "gnus/ChangeLog\\.[1-2]\\'" - "lisp/ChangeLog\\.\\([1-9]\\|1[0-5]\\)\\'" - "mh-e/ChangeLog\\.1\\'" - "src/ChangeLog\\.\\([1-9]\\|1[0-2]\\)\\'") - "List of regexps matching ChangeLogs that we do not print errors from. -These are older ChangeLogs that have various issues. -Additionally, for these logs we apply the `lax' elements of -`authors-renamed-files-regexps'.") - - -(defvar authors-checked-files-alist) -(defvar authors-invalid-file-names) - -;; This has become rather yucky. :( -(defun authors-disambiguate-file-name (fullname) - "Convert FULLNAME to an unambiguous relative-name." - (let ((relname (file-name-nondirectory fullname)) - dir parent) - (if (and (member relname authors-ambiguous-files) - ;; Try to identify the top-level directory. - ;; FIXME should really use ROOT from M-x authors. - (not (and (file-directory-p - (expand-file-name - "lib-src" - (setq dir (file-name-directory fullname)))) - (file-directory-p (expand-file-name "etc" dir))))) - ;; I think it looks weird to see eg "lisp/simple.el". - ;; But for eg Makefile.in, we do want to say "lisp/Makefile.in". - (if (and (string-equal "lisp" - (setq parent (file-name-nondirectory - (directory-file-name dir)))) - ;; TODO better to simply have hard-coded list? - ;; Only really Makefile.in where this applies. - (not (file-exists-p - (expand-file-name (concat "../" relname) dir)))) - relname - ;; In case of ambiguity, just prepend the parent directory. - ;; FIXME obviously this is not a perfect solution. - (format "%s/%s" (file-name-nondirectory (directory-file-name dir)) - relname)) - relname))) - -(defun authors-lax-changelog-p (file) - "Return non-nil if FILE matches `authors-lax-changelogs'." - (let ((list authors-lax-changelogs) - found) - (while list - (setq list (if (setq found (string-match-p (car list) file)) - nil - (cdr list)))) - found)) - -(defun authors-canonical-file-name (file log-file pos author) - "Return canonical file name for FILE found in LOG-FILE. -Checks whether FILE is a valid (existing) file name, has been renamed, -or is on the list of removed files. Returns the non-directory part of -the file name. Only uses the LOG-FILE position POS and associated AUTHOR -to print a message if FILE is not found." - ;; FILE should be re-checked in every different directory associated - ;; with a LOG-FILE. Eg configure.ac from src/ChangeLog is not the - ;; same as that from top-level/ChangeLog. - (let* ((fullname (expand-file-name file (file-name-directory log-file))) - (entry (assoc fullname authors-checked-files-alist)) - laxlog relname valid) - (if entry - (cdr entry) - (setq relname (file-name-nondirectory file)) - (if (or (member file authors-valid-file-names) - (member relname authors-valid-file-names) - (file-exists-p file) - (file-exists-p relname) ; FIXME? appropriate? - ) - (setq valid (authors-disambiguate-file-name fullname)) - (if (setq valid (assoc file authors-renamed-files-alist)) - (setq valid (cdr valid)) - (setq laxlog (authors-lax-changelog-p log-file)) - (let ((rules authors-renamed-files-regexps) - rule) - (while rules - (setq rule (car rules)) - (if (and (or laxlog (not (nth 2 rule))) - (string-match (car rule) file)) - (setq valid (if (stringp (nth 1 rule)) - (file-name-nondirectory - (replace-match (nth 1 rule) t nil file)) - relname) - rules nil) - (setq rules (cdr rules))))))) - (setq authors-checked-files-alist - (cons (cons fullname valid) authors-checked-files-alist)) - (unless (or valid - (member file authors-ignored-files) - (authors-obsolete-file-p file) - (string-match "[*]" file) - (string-match "^[0-9.]+$" file) - laxlog) - (setq authors-invalid-file-names - (cons (format "%s:%d: unrecognized `%s' for %s" - log-file - (1+ (count-lines (point-min) pos)) - file author) - authors-invalid-file-names))) - valid))) - -(defun authors-add-fixed-entries (table) - "Add actions from `authors-fixed-entries' to TABLE." - (dolist (entry authors-fixed-entries) - (let ((author (car entry)) - action) - (dolist (item (cdr entry)) - (if (symbolp item) - (setq action item) - (authors-add author item action table)))))) - - -(defun authors-obsolete-file-p (file) - "Return non-nil if FILE is obsolete. -FILE is considered obsolete if it matches one of the regular expressions -from `authors-obsolete-files-regexps'." - (let (obsolete-p - (regexps authors-obsolete-files-regexps)) - (while (and regexps (not obsolete-p)) - (setq obsolete-p (string-match (car regexps) file) - regexps (cdr regexps))) - obsolete-p)) - -(defun authors-no-scan-file-p (file) - "Return non-nil if FILE should not be scanned. -FILE is not scanned if it matches any of `authors-no-scan-regexps'." - (let (no-scan-p - (regexps authors-no-scan-regexps)) - (while (and regexps (not no-scan-p)) - (setq no-scan-p (string-match-p (car regexps) file) - regexps (cdr regexps))) - no-scan-p)) - -(defun authors-add (author file action table) - "Record that AUTHOR worked on FILE. -ACTION is a keyword symbol describing what he did. Record file, -author and what he did in hash table TABLE. See the description of -`authors-scan-change-log' for the structure of the hash table." - (unless (or (member file authors-ignored-files) - (authors-obsolete-file-p file) - (equal author "")) - (let* ((value (gethash author table)) - (entry (assoc file value)) - slot) - (if (null entry) - (puthash author (cons (list file (cons action 1)) value) table) - (if (setq slot (assoc action (cdr entry))) - (setcdr slot (1+ (cdr slot))) - (nconc entry (list (cons action 1)))))))) - - -(defun authors-canonical-author-name (author) - "Return a canonicalized form of AUTHOR, an author name. -If AUTHOR has an entry in `authors-aliases', use that. Remove -email addresses. Capitalize words in the author's name, unless -it is found in `authors-fixed-case'." - (let* ((aliases authors-aliases) - regexps realname) - (while aliases - (setq realname (car (car aliases)) - regexps (cdr (car aliases)) - aliases (cdr aliases)) - (while regexps - (if (string-match (car regexps) author) - (setq author realname - regexps nil - aliases nil) - (setq regexps (cdr regexps)))))) - (when author - (setq author (replace-regexp-in-string "[ \t]*[(<].*$" "" author)) - (setq author (replace-regexp-in-string "\`[ \t]+" "" author)) - (setq author (replace-regexp-in-string "[ \t]+$" "" author)) - (setq author (replace-regexp-in-string "[ \t]+" " " author)) - (unless (string-match "[-, \t]" author) - (setq author "")) - (or (car (member author authors-fixed-case)) - (capitalize author)))) - -(defun authors-scan-change-log (log-file table) - "Scan change log LOG-FILE for author information. - -For each change mentioned in the log, add an entry to hash table TABLE -under the author's canonical name. - -Keys of TABLE are author names. Values are alists of entries (FILE -\(ACTION . COUNT) ...). FILE is one file the author worked on. The -rest of the entry is a list of keyword symbols describing what he did -with the file and the number of each action: - -:wrote means the author wrote the file -:cowrote means he wrote the file in collaboration with others -:changed means he changed the file COUNT times." - - (let* ((enable-local-variables :safe) ; for find-file, hence let* - (enable-local-eval nil) - (existing-buffer (get-file-buffer log-file)) - (buffer (find-file-noselect log-file)) - authors pos) - (with-current-buffer buffer - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward "^[0-9]\\|^[ \t]+\\* " nil t) - (beginning-of-line) - (setq pos (point)) - (cond ((looking-at "^[0-9]+-[0-9]+-[0-9]+") - ;; Handle joint authorship of changes. - ;; This can be a bit fragile, and is not too common. - (setq authors nil) - (while (progn - (skip-chars-forward " \t+:0-9-") - (not (looking-at "\\($\\|\\*\\|\ -Suggested\\|Trivial\\|Version\\|Originally\\|From:\\|Patch[ \t]+[Bb]y\\)"))) - (push (authors-canonical-author-name - (buffer-substring-no-properties - (point) (line-end-position))) authors) - (forward-line 1))) - ((looking-at "^[ \t]+\\*") - (let ((line (buffer-substring-no-properties - (match-end 0) (line-end-position)))) - (while (and (not (string-match ":" line)) - (forward-line 1) - (not (looking-at ":\\|^[ \t]*$"))) - (setq line (concat line - (buffer-substring-no-properties - (line-beginning-position) - (line-end-position))))) - (when (string-match ":" line) - (setq line (substring line 0 (match-beginning 0))) - (setq line (replace-regexp-in-string "[[(<{].*$" "" line)) - (setq line (replace-regexp-in-string "," "" line)) - (dolist (file (split-string line)) - (when (setq file (authors-canonical-file-name file log-file pos (car authors))) - (dolist (author authors) - ;;(message "%s changed %s" author file) - (authors-add author file :changed table))))) - (forward-line 1))))))) - (unless existing-buffer - (kill-buffer buffer)))) - - -(defun authors-scan-el (file table) - "Scan Lisp file FILE for author information. -TABLE is a hash table to add author information to." - (let* ((existing-buffer (get-file-buffer file)) - (enable-local-variables :safe) ; for find-file, hence let* - (enable-local-eval nil) - (buffer (find-file-noselect file))) - (setq file (authors-disambiguate-file-name (expand-file-name file))) - (with-current-buffer buffer - (save-restriction - (widen) - (goto-char (point-min)) - (while (and (re-search-forward - "^;+[ \t]*\\(Authors?\\|Commentary\\|Code\\):[ \t]*" nil t) - (not (member (match-string 1) '("Commentary" "Code")))) - (let ((continue t) - (action :wrote) - authors) - (while continue - ;; Some entries contain a year range in front of the - ;; author's name. - (skip-chars-forward "-0-9 \t") - (push (authors-canonical-author-name - (buffer-substring-no-properties - (point) (line-end-position))) authors) - ;; tips.texi says the continuation line should begin - ;; with a tab, but often spaces are used. - (setq continue - (and (zerop (forward-line 1)) - (looking-at ";;;?\\(\t+ *\\| +\\)[[:alnum:]]") - (goto-char (1- (match-end 0))) - (not (looking-at "[[:upper:]][-[:alpha:]]+:[ \t]"))))) - (and (> (length authors) 1) - (setq action :cowrote)) - (mapc (lambda (author) - (authors-add author file action table)) - authors))))) - (unless existing-buffer - (kill-buffer buffer)))) - - -(defun authors-public-domain-p (file) - "Return t if FILE is a file that was put in public domain." - (let ((public-domain-p nil) - (list authors-public-domain-files)) - (while (and list (not public-domain-p)) - (when (string-match (car list) file) - (setq public-domain-p t)) - (setq list (cdr list))) - public-domain-p)) - -(defvar authors-author-list) - -(defun authors-add-to-author-list (author changes) - "Insert information about AUTHOR's work on Emacs into `authors-author-list'. -CHANGES is an alist of entries (FILE (ACTION . COUNT) ...), as produced by -`authors-scan-change-log'. -The element added to `authors-author-list' is (AUTHOR WROTE CO-WROTE CHANGED), -where WROTE, CO-WROTE, and CHANGED are lists of the files written, co-written -and changed by AUTHOR." - (when author - (let ((nchanged 0) - wrote-list - cowrote-list - changed-list) - (dolist (change changes) - (let* ((actions (cdr change)) - (file (car change)) - (filestat (if (authors-public-domain-p file) - (concat file " (public domain)") - file))) - (cond ((assq :wrote actions) - (setq wrote-list (cons filestat wrote-list))) - ((assq :cowrote actions) - (setq cowrote-list (cons filestat cowrote-list))) - (t - (setq changed-list - (cons (cons file (cdr (assq :changed actions))) - changed-list)))))) - (if wrote-list - (setq wrote-list (sort wrote-list 'string-lessp))) - (if cowrote-list - (setq cowrote-list (sort cowrote-list 'string-lessp))) - (when changed-list - (setq changed-list (sort changed-list - (lambda (a b) - (if (= (cdr a) (cdr b)) - (string-lessp (car a) (car b)) - (> (cdr a) (cdr b)))))) - (setq nchanged (length changed-list)) - (setq changed-list (mapcar 'car changed-list))) - (if (> (- nchanged authors-many-files) 2) - (setcdr (nthcdr authors-many-files changed-list) - (list (format "and %d other files" (- nchanged authors-many-files))))) - (setq authors-author-list - (cons (list author wrote-list cowrote-list changed-list) - authors-author-list))))) - -(defun authors (root) - "Extract author information from change logs and Lisp source files. -ROOT is the root directory under which to find the files. If called -interactively, ROOT is read from the minibuffer. -Result is a buffer *Authors* containing authorship information, and a -buffer *Authors Errors* containing references to unknown files." - (interactive "DEmacs source directory: ") - (setq root (expand-file-name root)) - (let ((logs (process-lines find-program root "-name" "ChangeLog*")) - (table (make-hash-table :test 'equal)) - (buffer-name "*Authors*") - authors-checked-files-alist - authors-invalid-file-names) - (authors-add-fixed-entries table) - (unless (file-exists-p (expand-file-name "src/emacs.c" root)) - (unless (y-or-n-p - (format "Not the root directory of Emacs: %s, continue? " root)) - (error "Not the root directory"))) - (dolist (log logs) - (when (string-match "ChangeLog\\(.[0-9]+\\)?$" log) - (message "Scanning %s..." log) - (authors-scan-change-log log table))) - (let ((els (process-lines find-program root "-name" "*.el"))) - (dolist (file els) - (unless (authors-no-scan-file-p file) - (message "Scanning %s..." file) - (authors-scan-el file table)))) - (message "Generating buffer %s..." buffer-name) - (set-buffer (get-buffer-create buffer-name)) - (erase-buffer) - (set-buffer-file-coding-system authors-coding-system) - (insert -"Many people have contributed code included in the Free Software -Foundation's distribution of GNU Emacs. To show our appreciation for -their public spirit, we list here in alphabetical order a condensed -list of their contributions.\n") - (let (authors-author-list) - (maphash #'authors-add-to-author-list table) - (setq authors-author-list - (sort authors-author-list - (lambda (a b) (string-lessp (car a) (car b))))) - (dolist (a authors-author-list) - (let ((author (car a)) - (wrote (nth 1 a)) - (cowrote (nth 2 a)) - (changed (nth 3 a))) - (insert "\n" author ": ") - (when wrote - (insert "wrote") - (dolist (file wrote) - (if (> (+ (current-column) (length file)) 72) - (insert "\n ")) - (insert " " file)) - (insert "\n")) - (when cowrote - (if wrote - (insert "and ")) - (insert "co-wrote") - (dolist (file cowrote) - (if (> (+ (current-column) (length file)) 72) - (insert "\n ")) - (insert " " file)) - (insert "\n")) - (when changed - (if (or wrote cowrote) - (insert "and ")) - (insert "changed") - (dolist (file changed) - (if (> (+ (current-column) (length file)) 72) - (insert "\n ")) - (insert " " file)) - (insert "\n"))))) - (insert "\nLocal" " Variables:\ncoding: " - (symbol-name authors-coding-system) "\nEnd:\n") - (message "Generating buffer %s... done" buffer-name) - (unless noninteractive - (when authors-invalid-file-names - (with-current-buffer (get-buffer-create "*Authors Errors*") - (setq buffer-read-only nil) - (erase-buffer) - (set-buffer-file-coding-system authors-coding-system) - (insert "Unrecognized file entries found:\n\n") - (mapc (lambda (f) (if (not (string-match "^[A-Za-z]+$" f)) (insert f "\n"))) - (sort authors-invalid-file-names 'string-lessp)) - (goto-char (point-min)) - (compilation-mode) - (message "Errors were found. See buffer %s" (buffer-name)))) - (pop-to-buffer buffer-name)))) - - -(defun batch-update-authors () - "Produce an AUTHORS file. -Call this function in batch mode with two command line arguments FILE -and ROOT. FILE is the file to write, ROOT is the root directory of -the Emacs source tree, from which to build the file." - (unless noninteractive - (error "`batch-update-authors' is to be used only with -batch")) - (when (/= (length command-line-args-left) 2) - (error "Call `batch-update-authors' with the name of the file to write")) - (let* ((file (pop command-line-args-left)) - (root (pop command-line-args-left))) - (authors root) - (write-file file))) - -(provide 'authors) - -;;; authors.el ends here diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index d85e9ec43e6..073d923a178 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -120,7 +120,8 @@ expression, in which case we want to handle forms differently." ;; Look for an interactive spec. (interactive (pcase body ((or `((interactive . ,_) . ,_) - `(,_ (interactive . ,_) . ,_)) t)))) + `(,_ (interactive . ,_) . ,_)) + t)))) ;; Add the usage form at the end where describe-function-1 ;; can recover it. (when (listp args) (setq doc (help-add-fundoc-usage doc args))) @@ -140,11 +141,9 @@ expression, in which case we want to handle forms differently." ;; For complex cases, try again on the macro-expansion. ((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode define-globalized-minor-mode defun defmacro - ;; FIXME: we'd want `defmacro*' here as well, so as - ;; to handle its `declare', but when autoload is run - ;; CL is not loaded so macroexpand doesn't know how - ;; to expand it! - easy-mmode-define-minor-mode define-minor-mode)) + easy-mmode-define-minor-mode define-minor-mode + define-inline cl-defun cl-defmacro)) + (macrop car) (setq expand (let ((load-file-name file)) (macroexpand form))) (memq (car expand) '(progn prog1 defalias))) (make-autoload expand file 'expansion)) ;Recurse on the expansion. @@ -351,9 +350,26 @@ not be relied upon." ";;; " basename " ends here\n"))) +(defvar autoload-ensure-writable nil + "Non-nil means `autoload-ensure-default-file' makes existing file writable.") +;; Just in case someone tries to get you to overwrite a file that you +;; don't want to. +;;;###autoload +(put 'autoload-ensure-writable 'risky-local-variable t) + (defun autoload-ensure-default-file (file) - "Make sure that the autoload file FILE exists and if not create it." - (unless (file-exists-p file) + "Make sure that the autoload file FILE exists, creating it if needed. +If the file already exists and `autoload-ensure-writable' is non-nil, +make it writable." + (if (file-exists-p file) + ;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile, + ;; which was designed to handle CVSREAD=1 and equivalent. + (and autoload-ensure-writable + (let ((modes (file-modes file))) + (if (zerop (logand modes #o0200)) + ;; Ignore any errors here, and let subsequent attempts + ;; to write the file raise any real error. + (ignore-errors (set-file-modes file (logior modes #o0200)))))) (write-region (autoload-rubric file) nil file)) file) @@ -523,7 +539,7 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE (autoload-find-file file)) ;; Obey the no-update-autoloads file local variable. (unless no-update-autoloads - (message "Generating autoloads for %s..." file) + (or noninteractive (message "Generating autoloads for %s..." file)) (setq load-name (if (stringp generated-autoload-load-name) generated-autoload-load-name @@ -607,7 +623,8 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE (nth 5 (file-attributes relfile)))) (insert ";;; Generated autoloads from " relfile "\n"))) (insert generate-autoload-section-trailer)))) - (message "Generating autoloads for %s...done" file)) + (or noninteractive + (message "Generating autoloads for %s...done" file))) (or visited ;; We created this buffer, so we should kill it. (kill-buffer (current-buffer)))) diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index 4172c1592f8..e3d83eb127f 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -1,4 +1,4 @@ -;;; avl-tree.el --- balanced binary trees, AVL-trees +;;; avl-tree.el --- balanced binary trees, AVL-trees -*- lexical-binding:t -*- ;; Copyright (C) 1995, 2007-2015 Free Software Foundation, Inc. @@ -27,23 +27,23 @@ ;;; Commentary: -;; An AVL tree is a self-balancing binary tree. As such, inserting, +;; An AVL tree is a self-balancing binary tree. As such, inserting, ;; deleting, and retrieving data from an AVL tree containing n elements -;; is O(log n). It is somewhat more rigidly balanced than other +;; is O(log n). It is somewhat more rigidly balanced than other ;; self-balancing binary trees (such as red-black trees and AA trees), ;; making insertion slightly slower, deletion somewhat slower, and ;; retrieval somewhat faster (the asymptotic scaling is of course the -;; same for all types). Thus it may be a good choice when the tree will +;; same for all types). Thus it may be a good choice when the tree will ;; be relatively static, i.e. data will be retrieved more often than ;; they are modified. ;; ;; Internally, a tree consists of two elements, the root node and the -;; comparison function. The actual tree has a dummy node as its root +;; comparison function. The actual tree has a dummy node as its root ;; with the real root in the left pointer, which allows the root node to ;; be treated on a par with all other nodes. ;; ;; Each node of the tree consists of one data element, one left -;; sub-tree, one right sub-tree, and a balance count. The latter is the +;; sub-tree, one right sub-tree, and a balance count. The latter is the ;; difference in depth of the left and right sub-trees. ;; ;; The functions with names of the form "avl-tree--" are intended for @@ -51,7 +51,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) @@ -62,7 +62,7 @@ ;; ---------------------------------------------------------------- ;; Functions and macros handling an AVL tree. -(defstruct (avl-tree- +(cl-defstruct (avl-tree- ;; A tagged list is the pre-defstruct representation. ;; (:type list) :named @@ -77,15 +77,10 @@ ;; Return the root node for an AVL tree. INTERNAL USE ONLY. `(avl-tree--node-left (avl-tree--dummyroot ,tree))) -(defsetf avl-tree--root (tree) (node) - `(setf (avl-tree--node-left (avl-tree--dummyroot ,tree)) ,node)) - - - ;; ---------------------------------------------------------------- ;; Functions and macros handling an AVL tree node. -(defstruct (avl-tree--node +(cl-defstruct (avl-tree--node ;; We force a representation without tag so it matches the ;; pre-defstruct representation. Also we use the underlying ;; representation in the implementation of @@ -97,7 +92,7 @@ left right data balance) -(defalias 'avl-tree--node-branch 'aref +(defalias 'avl-tree--node-branch #'aref ;; This implementation is efficient but breaks the defstruct ;; abstraction. An alternative could be (funcall (aref [avl-tree-left ;; avl-tree-right avl-tree-data] branch) node) @@ -109,7 +104,7 @@ NODE is the node, and BRANCH is the branch. ;; The funcall/aref trick wouldn't work for the setf method, unless we ;; tried to access the underlying setter function, but this wouldn't be ;; portable either. -(defsetf avl-tree--node-branch aset) +(gv-define-simple-setter avl-tree--node-branch aset) @@ -297,7 +292,8 @@ Return t if the height of the tree has grown." (if (< (* sgn b2) 0) sgn 0) (avl-tree--node-branch node branch) p2)) (setf (avl-tree--node-balance - (avl-tree--node-branch node branch)) 0) + (avl-tree--node-branch node branch)) + 0) nil)))) (defun avl-tree--do-enter (cmpfun root branch data &optional updatefun) @@ -346,7 +342,7 @@ inserted data." (if (null node) 0 (let ((dl (avl-tree--check-node (avl-tree--node-left node))) (dr (avl-tree--check-node (avl-tree--node-right node)))) - (assert (= (- dr dl) (avl-tree--node-balance node))) + (cl-assert (= (- dr dl) (avl-tree--node-balance node))) (1+ (max dl dr))))) ;; ---------------------------------------------------------------- @@ -391,7 +387,7 @@ itself." (avl-tree--node-data root) (avl-tree--node-balance root)))) -(defstruct (avl-tree--stack +(cl-defstruct (avl-tree--stack (:constructor nil) (:constructor avl-tree--stack-create (tree &optional reverse @@ -403,7 +399,7 @@ itself." (:copier nil)) reverse store) -(defalias 'avl-tree-stack-p 'avl-tree--stack-p +(defalias 'avl-tree-stack-p #'avl-tree--stack-p "Return t if argument is an avl-tree-stack, nil otherwise.") (defun avl-tree--stack-repopulate (stack) @@ -420,12 +416,12 @@ itself." ;;; The public functions which operate on AVL trees. ;; define public alias for constructors so that we can set docstring -(defalias 'avl-tree-create 'avl-tree--create +(defalias 'avl-tree-create #'avl-tree--create "Create an empty AVL tree. COMPARE-FUNCTION is a function which takes two arguments, A and B, and returns non-nil if A is less than B, and nil otherwise.") -(defalias 'avl-tree-compare-function 'avl-tree--cmpfun +(defalias 'avl-tree-compare-function #'avl-tree--cmpfun "Return the comparison function for the AVL tree TREE. \(fn TREE)") @@ -505,7 +501,7 @@ previously specified in `avl-tree-create' when TREE was created." (not (eq (avl-tree-member tree data flag) flag)))) -(defun avl-tree-map (__map-function__ tree &optional reverse) +(defun avl-tree-map (fun tree &optional reverse) "Modify all elements in the AVL tree TREE by applying FUNCTION. Each element is replaced by the return value of FUNCTION applied @@ -516,12 +512,12 @@ descending order if REVERSE is non-nil." (avl-tree--mapc (lambda (node) (setf (avl-tree--node-data node) - (funcall __map-function__ (avl-tree--node-data node)))) + (funcall fun (avl-tree--node-data node)))) (avl-tree--root tree) (if reverse 1 0))) -(defun avl-tree-mapc (__map-function__ tree &optional reverse) +(defun avl-tree-mapc (fun tree &optional reverse) "Apply FUNCTION to all elements in AVL tree TREE, for side-effect only. @@ -529,13 +525,13 @@ FUNCTION is applied to the elements in ascending order, or descending order if REVERSE is non-nil." (avl-tree--mapc (lambda (node) - (funcall __map-function__ (avl-tree--node-data node))) + (funcall fun (avl-tree--node-data node))) (avl-tree--root tree) (if reverse 1 0))) (defun avl-tree-mapf - (__map-function__ combinator tree &optional reverse) + (fun combinator tree &optional reverse) "Apply FUNCTION to all elements in AVL tree TREE, and combine the results using COMBINATOR. @@ -546,7 +542,7 @@ order, or descending order if REVERSE is non-nil." (lambda (node) (setq avl-tree-mapf--accumulate (funcall combinator - (funcall __map-function__ + (funcall fun (avl-tree--node-data node)) avl-tree-mapf--accumulate))) (avl-tree--root tree) @@ -554,7 +550,7 @@ order, or descending order if REVERSE is non-nil." (nreverse avl-tree-mapf--accumulate))) -(defun avl-tree-mapcar (__map-function__ tree &optional reverse) +(defun avl-tree-mapcar (fun tree &optional reverse) "Apply FUNCTION to all elements in AVL tree TREE, and make a list of the results. @@ -568,7 +564,7 @@ then (avl-tree-mapf function 'cons tree (not reverse)) is more efficient." - (nreverse (avl-tree-mapf __map-function__ 'cons tree reverse))) + (nreverse (avl-tree-mapf fun 'cons tree reverse))) (defun avl-tree-first (tree) @@ -605,7 +601,7 @@ is more efficient." "Return the number of elements in TREE." (let ((treesize 0)) (avl-tree--mapc - (lambda (data) (setq treesize (1+ treesize))) + (lambda (_) (setq treesize (1+ treesize))) (avl-tree--root tree) 0) treesize)) diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el index 5426edc4d2a..082955e0823 100644 --- a/lisp/emacs-lisp/backquote.el +++ b/lisp/emacs-lisp/backquote.el @@ -148,16 +148,19 @@ LEVEL is only used internally and indicates the nesting level: (t (list 'apply '(function vector) (cdr n)))))))) ((atom s) + ;; FIXME: Use macroexp-quote! (cons 0 (if (or (null s) (eq s t) (not (symbolp s))) s (list 'quote s)))) ((eq (car s) backquote-unquote-symbol) (if (<= level 0) - (if (> (length s) 2) - ;; We could support it with: (cons 2 `(list . ,(cdr s))) - ;; But let's not encourage such uses. - (error "Multiple args to , are not supported: %S" s) - (cons 1 (nth 1 s))) + (cond + ((> (length s) 2) + ;; We could support it with: (cons 2 `(list . ,(cdr s))) + ;; But let's not encourage such uses. + (error "Multiple args to , are not supported: %S" s)) + (t (cons (if (eq (car-safe (nth 1 s)) 'quote) 0 1) + (nth 1 s)))) (backquote-delay-process s (1- level)))) ((eq (car s) backquote-splice-symbol) (if (<= level 0) @@ -215,9 +218,7 @@ LEVEL is only used internally and indicates the nesting level: ;; Tack on any initial elements. (if firstlist (setq expression (backquote-listify firstlist (cons 1 expression)))) - (if (eq (car-safe expression) 'quote) - (cons 0 (list 'quote s)) - (cons 1 expression)))))) + (cons (if (eq (car-safe expression) 'quote) 0 1) expression))))) ;; backquote-listify takes (tag . structure) pairs from backquote-process ;; and decides between append, list, backquote-list*, and cons depending diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 61729cfde2b..149c4723199 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -944,15 +944,6 @@ form (nth 1 form))) -(defun byte-optimize-zerop (form) - (cond ((numberp (nth 1 form)) - (eval form)) - (byte-compile-delete-errors - (list '= (nth 1 form) 0)) - (form))) - -(put 'zerop 'byte-optimizer 'byte-optimize-zerop) - (defun byte-optimize-and (form) ;; Simplify if less than 2 args. ;; if there is a literal nil in the args to `and', throw it and following diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index c476c049110..caa7e3dad33 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -30,6 +30,18 @@ ;;; Code: +(defalias 'function-put + ;; We don't want people to just use `put' because we can't conveniently + ;; hook into `put' to remap old properties to new ones. But for now, there's + ;; no such remapping, so we just call `put'. + #'(lambda (function prop value) + "Set FUNCTION's property PROP to VALUE. +The namespace for PROP is shared with symbols. +So far, FUNCTION can only be a symbol, not a lambda expression." + (put function prop value))) +(function-put 'defmacro 'doc-string-elt 3) +(function-put 'defmacro 'lisp-indent-function 2) + ;; `macro-declaration-function' are both obsolete (as marked at the end of this ;; file) but used in many .elc files. @@ -69,6 +81,7 @@ The return value of this function is not used." ;; handle declarations in macro definitions and this is the first file ;; loaded by loadup.el that uses declarations in macros. +;; Add any new entries to info node `(elisp)Declare Form'. (defvar defun-declarations-alist (list ;; We can only use backquotes inside the lambdas and not for those @@ -81,27 +94,55 @@ The return value of this function is not used." #'(lambda (f _args new-name when) (list 'make-obsolete (list 'quote f) (list 'quote new-name) (list 'quote when)))) + (list 'interactive-only + #'(lambda (f _args instead) + (list 'function-put (list 'quote f) + ''interactive-only (list 'quote instead)))) + ;; FIXME: Merge `pure' and `side-effect-free'. + (list 'pure + #'(lambda (f _args val) + (list 'function-put (list 'quote f) + ''pure (list 'quote val))) + "If non-nil, the compiler can replace calls with their return value. +This may shift errors from run-time to compile-time.") + (list 'side-effect-free + #'(lambda (f _args val) + (list 'function-put (list 'quote f) + ''side-effect-free (list 'quote val))) + "If non-nil, calls can be ignored if their value is unused. +If `error-free', drop calls even if `byte-compile-delete-errors' is nil.") (list 'compiler-macro #'(lambda (f args compiler-function) - `(eval-and-compile - (put ',f 'compiler-macro - ,(if (eq (car-safe compiler-function) 'lambda) - `(lambda ,(append (cadr compiler-function) args) - ,@(cddr compiler-function)) - `#',compiler-function))))) + (if (not (eq (car-safe compiler-function) 'lambda)) + `(eval-and-compile + (function-put ',f 'compiler-macro #',compiler-function)) + (let ((cfname (intern (concat (symbol-name f) "--anon-cmacro")))) + `(progn + (eval-and-compile + (function-put ',f 'compiler-macro #',cfname)) + ;; Don't autoload the compiler-macro itself, since the + ;; macroexpander will find this file via `f's autoload, + ;; if needed. + :autoload-end + (eval-and-compile + (defun ,cfname (,@(cadr compiler-function) ,@args) + ,@(cddr compiler-function)))))))) (list 'doc-string #'(lambda (f _args pos) - (list 'put (list 'quote f) ''doc-string-elt (list 'quote pos)))) + (list 'function-put (list 'quote f) + ''doc-string-elt (list 'quote pos)))) (list 'indent #'(lambda (f _args val) - (list 'put (list 'quote f) + (list 'function-put (list 'quote f) ''lisp-indent-function (list 'quote val))))) "List associating function properties to their macro expansion. Each element of the list takes the form (PROP FUN) where FUN is a function. For each (PROP . VALUES) in a function's declaration, the FUN corresponding to PROP is called with the function name, the function's arglist, and the VALUES and should return the code to use -to set this property.") +to set this property. + +This is used by `declare'.") (defvar macro-declarations-alist (cons @@ -115,10 +156,10 @@ to set this property.") Each element of the list takes the form (PROP FUN) where FUN is a function. For each (PROP . VALUES) in a macro's declaration, the FUN corresponding to PROP is called with the macro name, the macro's arglist, and the VALUES -and should return the code to use to set this property.") +and should return the code to use to set this property. + +This is used by `declare'.") -(put 'defmacro 'doc-string-elt 3) -(put 'defmacro 'lisp-indent-function 2) (defalias 'defmacro (cons 'macro @@ -218,7 +259,8 @@ The return value is undefined. (cons arglist body)))))) (if declarations (cons 'prog1 (cons def declarations)) - def)))) + def)))) + ;; Redefined in byte-optimize.el. ;; This is not documented--it's not clear that we should promote it. @@ -389,13 +431,20 @@ If you think you need this, you're probably making a mistake somewhere." (defmacro eval-when-compile (&rest body) "Like `progn', but evaluates the body at compile time if you're compiling. -Thus, the result of the body appears to the compiler as a quoted constant. -In interpreted code, this is entirely equivalent to `progn'." +Thus, the result of the body appears to the compiler as a quoted +constant. In interpreted code, this is entirely equivalent to +`progn', except that the value of the expression may be (but is +not necessarily) computed at load time if eager macro expansion +is enabled." (declare (debug (&rest def-form)) (indent 0)) (list 'quote (eval (cons 'progn body) lexical-binding))) (defmacro eval-and-compile (&rest body) - "Like `progn', but evaluates the body at compile time and at load time." + "Like `progn', but evaluates the body at compile time and at +load time. In interpreted code, this is entirely equivalent to +`progn', except that the value of the expression may be (but is +not necessarily) computed at load time if eager macro expansion +is enabled." (declare (debug t) (indent 0)) ;; When the byte-compiler expands code, this macro is not used, so we're ;; either about to run `body' (plain interpretation) or we're doing eager diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 7be1a3dcbb9..2bd8d07851b 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -417,7 +417,7 @@ specify different fields to sort on." This list lives partly on the stack.") (defvar byte-compile-lexical-variables nil "List of variables that have been treated as lexical. -Filled in `cconv-analyse-form' but initialized and consulted here.") +Filled in `cconv-analyze-form' but initialized and consulted here.") (defvar byte-compile-const-variables nil "List of variables declared as constants during compilation of this file.") (defvar byte-compile-free-references) @@ -425,31 +425,51 @@ Filled in `cconv-analyse-form' but initialized and consulted here.") (defvar byte-compiler-error-flag) +(defun byte-compile-recurse-toplevel (form non-toplevel-case) + "Implement `eval-when-compile' and `eval-and-compile'. +Return the compile-time value of FORM." + ;; Macroexpand (not macroexpand-all!) form at toplevel in case it + ;; expands into a toplevel-equivalent `progn'. See CLHS section + ;; 3.2.3.1, "Processing of Top Level Forms". The semantics are very + ;; subtle: see test/automated/bytecomp-tests.el for interesting + ;; cases. + (setf form (macroexp-macroexpand form byte-compile-macro-environment)) + (if (eq (car-safe form) 'progn) + (cons 'progn + (mapcar (lambda (subform) + (byte-compile-recurse-toplevel + subform non-toplevel-case)) + (cdr form))) + (funcall non-toplevel-case form))) + (defconst byte-compile-initial-macro-environment - '( + `( ;; (byte-compiler-options . (lambda (&rest forms) ;; (apply 'byte-compiler-options-handler forms))) (declare-function . byte-compile-macroexpand-declare-function) - (eval-when-compile . (lambda (&rest body) - (list - 'quote - (byte-compile-eval - (byte-compile-top-level - (byte-compile-preprocess (cons 'progn body))))))) - (eval-and-compile . (lambda (&rest body) - ;; Byte compile before running it. Do it piece by - ;; piece, in case further expressions need earlier - ;; ones to be evaluated already, as is the case in - ;; eieio.el. - `(progn - ,@(mapcar (lambda (exp) - (let ((cexp - (byte-compile-top-level - (byte-compile-preprocess - exp)))) - (eval cexp) - cexp)) - body))))) + (eval-when-compile . ,(lambda (&rest body) + (let ((result nil)) + (byte-compile-recurse-toplevel + (cons 'progn body) + (lambda (form) + (setf result + (byte-compile-eval + (byte-compile-top-level + (byte-compile-preprocess form)))))) + (list 'quote result)))) + (eval-and-compile . ,(lambda (&rest body) + (byte-compile-recurse-toplevel + (cons 'progn body) + (lambda (form) + ;; Don't compile here, since we don't know + ;; whether to compile as byte-compile-form + ;; or byte-compile-file-form. + (let ((expanded + (macroexpand-all + form + macroexpand-all-environment))) + (eval expanded lexical-binding) + expanded)))))) "The default macro-environment passed to macroexpand by the compiler. Placing a macro here will cause a macro to have different semantics when expanded by the compiler as when expanded by the interpreter.") @@ -1349,6 +1369,33 @@ extra args." ;; Warn if the function or macro is being redefined with a different ;; number of arguments. (defun byte-compile-arglist-warn (name arglist macrop) + ;; This is the first definition. See if previous calls are compatible. + (let ((calls (assq name byte-compile-unresolved-functions)) + nums sig min max) + (when (and calls macrop) + (byte-compile-warn "macro `%s' defined too late" name)) + (setq byte-compile-unresolved-functions + (delq calls byte-compile-unresolved-functions)) + (setq calls (delq t calls)) ;Ignore higher-order uses of the function. + (when (cdr calls) + (when (and (symbolp name) + (eq (function-get name 'byte-optimizer) + 'byte-compile-inline-expand)) + (byte-compile-warn "defsubst `%s' was used before it was defined" + name)) + (setq sig (byte-compile-arglist-signature arglist) + nums (sort (copy-sequence (cdr calls)) (function <)) + min (car nums) + max (car (nreverse nums))) + (when (or (< min (car sig)) + (and (cdr sig) (> max (cdr sig)))) + (byte-compile-set-symbol-position name) + (byte-compile-warn + "%s being defined to take %s%s, but was previously called with %s" + name + (byte-compile-arglist-signature-string sig) + (if (equal sig '(1 . 1)) " arg" " args") + (byte-compile-arglist-signature-string (cons min max)))))) (let* ((old (byte-compile-fdefinition name macrop)) (initial (and macrop (cdr (assq name @@ -1357,52 +1404,26 @@ extra args." ;; to a defined function. (Bug#8646) (and initial (symbolp initial) (setq old (byte-compile-fdefinition initial nil))) - (if (and old (not (eq old t))) - (progn - (and (eq 'macro (car-safe old)) - (eq 'lambda (car-safe (cdr-safe old))) - (setq old (cdr old))) - (let ((sig1 (byte-compile-arglist-signature - (pcase old - (`(lambda ,args . ,_) args) - (`(closure ,_ ,args . ,_) args) - ((pred byte-code-function-p) (aref old 0)) - (t '(&rest def))))) - (sig2 (byte-compile-arglist-signature arglist))) - (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2) - (byte-compile-set-symbol-position name) - (byte-compile-warn - "%s %s used to take %s %s, now takes %s" - (if macrop "macro" "function") - name - (byte-compile-arglist-signature-string sig1) - (if (equal sig1 '(1 . 1)) "argument" "arguments") - (byte-compile-arglist-signature-string sig2))))) - ;; This is the first definition. See if previous calls are compatible. - (let ((calls (assq name byte-compile-unresolved-functions)) - nums sig min max) - (setq byte-compile-unresolved-functions - (delq calls byte-compile-unresolved-functions)) - (setq calls (delq t calls)) ;Ignore higher-order uses of the function. - (when (cdr calls) - (when (and (symbolp name) - (eq (function-get name 'byte-optimizer) - 'byte-compile-inline-expand)) - (byte-compile-warn "defsubst `%s' was used before it was defined" - name)) - (setq sig (byte-compile-arglist-signature arglist) - nums (sort (copy-sequence (cdr calls)) (function <)) - min (car nums) - max (car (nreverse nums))) - (when (or (< min (car sig)) - (and (cdr sig) (> max (cdr sig)))) - (byte-compile-set-symbol-position name) - (byte-compile-warn - "%s being defined to take %s%s, but was previously called with %s" - name - (byte-compile-arglist-signature-string sig) - (if (equal sig '(1 . 1)) " arg" " args") - (byte-compile-arglist-signature-string (cons min max))))))))) + (when (and old (not (eq old t))) + (and (eq 'macro (car-safe old)) + (eq 'lambda (car-safe (cdr-safe old))) + (setq old (cdr old))) + (let ((sig1 (byte-compile-arglist-signature + (pcase old + (`(lambda ,args . ,_) args) + (`(closure ,_ ,args . ,_) args) + ((pred byte-code-function-p) (aref old 0)) + (t '(&rest def))))) + (sig2 (byte-compile-arglist-signature arglist))) + (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2) + (byte-compile-set-symbol-position name) + (byte-compile-warn + "%s %s used to take %s %s, now takes %s" + (if macrop "macro" "function") + name + (byte-compile-arglist-signature-string sig1) + (if (equal sig1 '(1 . 1)) "argument" "arguments") + (byte-compile-arglist-signature-string sig2))))))) (defvar byte-compile-cl-functions nil "List of functions defined in CL.") @@ -1837,13 +1858,13 @@ The value is non-nil if there were no errors, nil if errors." ;; recompiled). Previously this was accomplished by ;; deleting target-file before writing it. (rename-file tempfile target-file t) - (message "Wrote %s" target-file)) + (or noninteractive (message "Wrote %s" target-file))) ;; This is just to give a better error message than write-region (signal 'file-error (list "Opening output file" (if (file-exists-p target-file) - "cannot overwrite file" - "directory not writable or nonexistent") + "Cannot overwrite file" + "Directory not writable or nonexistent") target-file))) (kill-buffer (current-buffer))) (if (and byte-compile-generate-call-tree @@ -2103,11 +2124,6 @@ list that represents a doc string reference. (eq (aref (nth (nth 1 info) form) 0) ?*)) (setq position (- position))))) - (if preface - (progn - (insert preface) - (prin1 name byte-compile--outbuffer))) - (insert (car info)) (let ((print-continuous-numbering t) print-number-table (index 0) @@ -2120,6 +2136,15 @@ list that represents a doc string reference. (print-gensym t) (print-circle ; Handle circular data structures. (not byte-compile-disable-print-circle))) + (if preface + (progn + ;; FIXME: We don't handle uninterned names correctly. + ;; E.g. if cl-define-compiler-macro uses uninterned name we get: + ;; (defalias '#1=#:foo--cmacro #[514 ...]) + ;; (put 'foo 'compiler-macro '#:foo--cmacro) + (insert preface) + (prin1 name byte-compile--outbuffer))) + (insert (car info)) (prin1 (car form) byte-compile--outbuffer) (while (setq form (cdr form)) (setq index (1+ index)) @@ -2205,9 +2230,12 @@ list that represents a doc string reference. (t form))) ;; byte-hunk-handlers cannot call this! -(defun byte-compile-toplevel-file-form (form) - (let ((byte-compile-current-form nil)) ; close over this for warnings. - (byte-compile-file-form (byte-compile-preprocess form t)))) +(defun byte-compile-toplevel-file-form (top-level-form) + (byte-compile-recurse-toplevel + top-level-form + (lambda (form) + (let ((byte-compile-current-form nil)) ; close over this for warnings. + (byte-compile-file-form (byte-compile-preprocess form t)))))) ;; byte-hunk-handlers can call this. (defun byte-compile-file-form (form) @@ -2510,7 +2538,8 @@ If QUOTED is non-nil, print with quoting; otherwise, print without quoting." "Return an expression which will evaluate to a function value FUN. FUN should be either a `lambda' value or a `closure' value." (pcase-let* (((or (and `(lambda ,args . ,body) (let env nil)) - `(closure ,env ,args . ,body)) fun) + `(closure ,env ,args . ,body)) + fun) (renv ())) ;; Turn the function's closed vars (if any) into local let bindings. (dolist (binding env) @@ -2712,7 +2741,9 @@ for symbols generated by the byte compiler itself." ;; byte-string, constants-vector, stack depth (cdr compiled) ;; optionally, the doc string. - (cond (lexical-binding + (cond ((and lexical-binding arglist) + ;; byte-compile-make-args-desc lost the args's names, + ;; so preserve them in the docstring. (list (help-add-fundoc-usage doc arglist))) ((or doc int) (list doc))) @@ -2950,7 +2981,8 @@ for symbols generated by the byte compiler itself." (t ".")))) (if (eq (car-safe (symbol-function (car form))) 'macro) (byte-compile-log-warning - (format "Forgot to expand macro %s" (car form)) nil :error)) + (format "Forgot to expand macro %s in %S" (car form) form) + nil :error)) (if (and handler ;; Make sure that function exists. (and (functionp handler) @@ -3788,6 +3820,10 @@ that suppresses all warnings during execution of BODY." ;; If things not being bound at all is ok, so must them being ;; obsolete. Note that we add to the existing lists since Tramp ;; (ab)uses this feature. + ;; FIXME: If `foo' is obsoleted by `bar', the code below + ;; correctly arranges to silence the warnings after testing + ;; existence of `foo', but the warning should also be + ;; silenced after testing the existence of `bar'. (let ((byte-compile-not-obsolete-vars (append byte-compile-not-obsolete-vars bound-list)) (byte-compile-not-obsolete-funcs @@ -4057,9 +4093,8 @@ binding slots have been popped." (byte-defop-compiler-1 save-restriction) ;; (byte-defop-compiler-1 save-window-excursion) ;Obsolete: now a macro. ;; (byte-defop-compiler-1 with-output-to-temp-buffer) ;Obsolete: now a macro. -(byte-defop-compiler-1 track-mouse) -(defvar byte-compile--use-old-handlers t +(defvar byte-compile--use-old-handlers nil "If nil, use new byte codes introduced in Emacs-24.4.") (defun byte-compile-catch (form) @@ -4092,12 +4127,6 @@ binding slots have been popped." (byte-compile-form-do-effect (car (cdr form))) (byte-compile-out 'byte-unbind 1)) -(defun byte-compile-track-mouse (form) - (byte-compile-form - (pcase form - (`(,_ :fun-body ,f) `(eval (list 'track-mouse (list 'funcall ,f)))) - (_ `(eval '(track-mouse ,@(byte-compile-top-level-body (cdr form)))))))) - (defun byte-compile-condition-case (form) (if byte-compile--use-old-handlers (byte-compile-condition-case--old form) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index bf7fc6d4345..e9d33e6c646 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -30,13 +30,13 @@ ;; All macros should be expanded beforehand. ;; ;; Here is a brief explanation how this code works. -;; Firstly, we analyze the tree by calling cconv-analyse-form. +;; Firstly, we analyze the tree by calling cconv-analyze-form. ;; This function finds all mutated variables, all functions that are suitable ;; for lambda lifting and all variables captured by closure. It passes the tree ;; once, returning a list of three lists. ;; ;; Then we calculate the intersection of the first and third lists returned by -;; cconv-analyse form to find all mutated variables that are captured by +;; cconv-analyze form to find all mutated variables that are captured by ;; closure. ;; Armed with this data, we call cconv-closure-convert-rec, that rewrites the @@ -140,7 +140,7 @@ Returns a form where all lambdas don't have any free variables." (cconv-lambda-candidates '()) (cconv-captured+mutated '())) ;; Analyze form - fill these variables with new information. - (cconv-analyse-form form '()) + (cconv-analyze-form form '()) (setq cconv-freevars-alist (nreverse cconv-freevars-alist)) (prog1 (cconv-convert form nil nil) ; Env initially empty. (cl-assert (null cconv-freevars-alist))))) @@ -152,7 +152,7 @@ Returns a form where all lambdas don't have any free variables." (cconv-lambda-candidates '()) (cconv-captured+mutated '())) ;; Analyze form - fill these variables with new information. - (cconv-analyse-form form '()) + (cconv-analyze-form form '()) ;; But don't perform the closure conversion. form)) @@ -462,10 +462,6 @@ places where they originally did not directly appear." `(,head ,(cconv-convert form env extend) :fun-body ,(cconv--convert-function () body env form))) - (`(track-mouse . ,body) - `(track-mouse - :fun-body ,(cconv--convert-function () body env form))) - (`(setq . ,forms) ; setq special form (let ((prognlist ())) (while forms @@ -529,7 +525,7 @@ places where they originally did not directly appear." (defalias 'byte-compile-not-lexical-var-p 'boundp)) (defvar byte-compile-lexical-variables) -(defun cconv--analyse-use (vardata form varkind) +(defun cconv--analyze-use (vardata form varkind) "Analyze the use of a variable. VARDATA should be (BINDER READ MUTATED CAPTURED CALLED). VARKIND is the name of the kind of variable. @@ -561,7 +557,7 @@ FORM is the parent form that binds this var." (`(,(and binder `(,_ (function (lambda . ,_)))) nil nil nil t) (push (cons binder form) cconv-lambda-candidates)))) -(defun cconv--analyse-function (args body env parentform) +(defun cconv--analyze-function (args body env parentform) (let* ((newvars nil) (freevars (list body)) ;; We analyze the body within a new environment where all uses are @@ -586,10 +582,10 @@ FORM is the parent form that binds this var." (push (cons (list arg) (cdr varstruct)) newvars) (push varstruct newenv))))) (dolist (form body) ;Analyze body forms. - (cconv-analyse-form form newenv)) + (cconv-analyze-form form newenv)) ;; Summarize resulting data about arguments. (dolist (vardata newvars) - (cconv--analyse-use vardata parentform "argument")) + (cconv--analyze-use vardata parentform "argument")) ;; Transfer uses collected in `envcopy' (via `newenv') back to `env'; ;; and compute free variables. (while env @@ -605,7 +601,7 @@ FORM is the parent form that binds this var." (setf (nth 3 (car env)) t)) (setq env (cdr env) envcopy (cdr envcopy)))))) -(defun cconv-analyse-form (form env) +(defun cconv-analyze-form (form env) "Find mutated variables and variables captured by closure. Analyze lambdas if they are suitable for lambda lifting. - FORM is a piece of Elisp code after macroexpansion. @@ -632,7 +628,7 @@ and updates the data stored in ENV." (setq var (car binder)) (setq value (cadr binder)) - (cconv-analyse-form value (if (eq letsym 'let*) env orig-env))) + (cconv-analyze-form value (if (eq letsym 'let*) env orig-env))) (unless (byte-compile-not-lexical-var-p var) (cl-pushnew var byte-compile-lexical-variables) @@ -641,13 +637,13 @@ and updates the data stored in ENV." (push varstruct env)))) (dolist (form body-forms) ; Analyze body forms. - (cconv-analyse-form form env)) + (cconv-analyze-form form env)) (dolist (vardata newvars) - (cconv--analyse-use vardata form "variable")))) + (cconv--analyze-use vardata form "variable")))) (`(function (lambda ,vrs . ,body-forms)) - (cconv--analyse-function vrs body-forms env form)) + (cconv--analyze-function vrs body-forms env form)) (`(setq . ,forms) ;; If a local variable (member of env) is modified by setq then @@ -655,7 +651,7 @@ and updates the data stored in ENV." (while forms (let ((v (assq (car forms) env))) ; v = non nil if visible (when v (setf (nth 2 v) t))) - (cconv-analyse-form (cadr forms) env) + (cconv-analyze-form (cadr forms) env) (setq forms (cddr forms)))) (`((lambda . ,_) . ,_) ; First element is lambda expression. @@ -663,11 +659,11 @@ and updates the data stored in ENV." (format "Use of deprecated ((lambda %s ...) ...) form" (nth 1 (car form))) t :warning) (dolist (exp `((function ,(car form)) . ,(cdr form))) - (cconv-analyse-form exp env))) + (cconv-analyze-form exp env))) (`(cond . ,cond-forms) ; cond special form (dolist (forms cond-forms) - (dolist (form forms) (cconv-analyse-form form env)))) + (dolist (form forms) (cconv-analyze-form form env)))) (`(quote . ,_) nil) ; quote form (`(function . ,_) nil) ; same as quote @@ -676,13 +672,13 @@ and updates the data stored in ENV." (guard byte-compile--use-old-handlers)) ;; FIXME: The bytecode for condition-case forces us to wrap the ;; form and handlers in closures. - (cconv--analyse-function () (list protected-form) env form) + (cconv--analyze-function () (list protected-form) env form) (dolist (handler handlers) - (cconv--analyse-function (if var (list var)) (cdr handler) + (cconv--analyze-function (if var (list var)) (cdr handler) env form))) (`(condition-case ,var ,protected-form . ,handlers) - (cconv-analyse-form protected-form env) + (cconv-analyze-form protected-form env) (when (and var (symbolp var) (byte-compile-not-lexical-var-p var)) (byte-compile-log-warning (format "Lexical variable shadows the dynamic variable %S" var))) @@ -690,26 +686,21 @@ and updates the data stored in ENV." (if var (push varstruct env)) (dolist (handler handlers) (dolist (form (cdr handler)) - (cconv-analyse-form form env))) - (if var (cconv--analyse-use (cons (list var) (cdr varstruct)) + (cconv-analyze-form form env))) + (if var (cconv--analyze-use (cons (list var) (cdr varstruct)) form "variable")))) ;; FIXME: The bytecode for unwind-protect forces us to wrap the unwind. (`(,(or (and `catch (guard byte-compile--use-old-handlers)) `unwind-protect) ,form . ,body) - (cconv-analyse-form form env) - (cconv--analyse-function () body env form)) - - ;; FIXME: The lack of bytecode for track-mouse forces us to wrap the body. - ;; `track-mouse' really should be made into a macro. - (`(track-mouse . ,body) - (cconv--analyse-function () body env form)) + (cconv-analyze-form form env) + (cconv--analyze-function () body env form)) (`(defvar ,var) (push var byte-compile-bound-variables)) (`(,(or `defconst `defvar) ,var ,value . ,_) (push var byte-compile-bound-variables) - (cconv-analyse-form value env)) + (cconv-analyze-form value env)) (`(,(or `funcall `apply) ,fun . ,args) ;; Here we ignore fun because funcall and apply are the only two @@ -719,8 +710,8 @@ and updates the data stored in ENV." (let ((fdata (and (symbolp fun) (assq fun env)))) (if fdata (setf (nth 4 fdata) t) - (cconv-analyse-form fun env))) - (dolist (form args) (cconv-analyse-form form env))) + (cconv-analyze-form fun env))) + (dolist (form args) (cconv-analyze-form form env))) (`(interactive . ,forms) ;; These appear within the function body but they don't have access @@ -728,19 +719,20 @@ and updates the data stored in ENV." ;; We could extend this to allow interactive specs to refer to ;; variables in the function's enclosing environment, but it doesn't ;; seem worth the trouble. - (dolist (form forms) (cconv-analyse-form form nil))) + (dolist (form forms) (cconv-analyze-form form nil))) ;; `declare' should now be macro-expanded away (and if they're not, we're ;; in trouble because they *can* contain code nowadays). ;; (`(declare . ,_) nil) ;The args don't contain code. (`(,_ . ,body-forms) ; First element is a function or whatever. - (dolist (form body-forms) (cconv-analyse-form form env))) + (dolist (form body-forms) (cconv-analyze-form form env))) ((pred symbolp) (let ((dv (assq form env))) ; dv = declared and visible (when dv (setf (nth 1 dv) t)))))) +(define-obsolete-function-alias 'cconv-analyse-form 'cconv-analyze-form "25.1") (provide 'cconv) ;;; cconv.el ends here diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index 62b2b5cc6da..851b3bfc6fd 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -422,7 +422,7 @@ or is created with the bounds of SEQ." (if (stringp (car (oref seq data))) (let ((labels (oref seq data))) (if (not axis) - (setq axis (make-instance chart-axis-names + (setq axis (make-instance 'chart-axis-names :name (oref seq name) :items labels :chart c)) @@ -430,7 +430,7 @@ or is created with the bounds of SEQ." (let ((range (cons 0 1)) (l (oref seq data))) (if (not axis) - (setq axis (make-instance chart-axis-range + (setq axis (make-instance 'chart-axis-range :name (oref seq name) :chart c))) (while l @@ -577,19 +577,19 @@ labeled NUMTITLE. Optional arguments: Set the chart's max element display to MAX, and sort lists with SORT-PRED if desired." - (let ((nc (make-instance chart-bar + (let ((nc (make-instance 'chart-bar :title title :key-label "8-m" ; This is a text key pic :direction dir )) (iv (eq dir 'vertical))) (chart-add-sequence nc - (make-instance chart-sequece + (make-instance 'chart-sequece :data namelst :name nametitle) (if iv 'x-axis 'y-axis)) (chart-add-sequence nc - (make-instance chart-sequece + (make-instance 'chart-sequece :data numlst :name numtitle) (if iv 'y-axis 'x-axis)) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index e5b64a50b5a..afc2adbee6d 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -38,6 +38,7 @@ ;;; Code: (require 'cl-lib) +(require 'seq) ;;; Type coercion. @@ -269,43 +270,20 @@ If so, return the true (non-nil) value returned by PREDICATE. ;;;###autoload (defun cl--map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg) (or cl-buffer (setq cl-buffer (current-buffer))) - (if (fboundp 'overlay-lists) - - ;; This is the preferred algorithm, though overlay-lists is undocumented. - (let (cl-ovl) - (with-current-buffer cl-buffer - (setq cl-ovl (overlay-lists)) - (if cl-start (setq cl-start (copy-marker cl-start))) - (if cl-end (setq cl-end (copy-marker cl-end)))) - (setq cl-ovl (nconc (car cl-ovl) (cdr cl-ovl))) - (while (and cl-ovl - (or (not (overlay-start (car cl-ovl))) - (and cl-end (>= (overlay-start (car cl-ovl)) cl-end)) - (and cl-start (<= (overlay-end (car cl-ovl)) cl-start)) - (not (funcall cl-func (car cl-ovl) cl-arg)))) - (setq cl-ovl (cdr cl-ovl))) - (if cl-start (set-marker cl-start nil)) - (if cl-end (set-marker cl-end nil))) - - ;; This alternate algorithm fails to find zero-length overlays. - (let ((cl-mark (with-current-buffer cl-buffer - (copy-marker (or cl-start (point-min))))) - (cl-mark2 (and cl-end (with-current-buffer cl-buffer - (copy-marker cl-end)))) - cl-pos cl-ovl) - (while (save-excursion - (and (setq cl-pos (marker-position cl-mark)) - (< cl-pos (or cl-mark2 (point-max))) - (progn - (set-buffer cl-buffer) - (setq cl-ovl (overlays-at cl-pos)) - (set-marker cl-mark (next-overlay-change cl-pos))))) - (while (and cl-ovl - (or (/= (overlay-start (car cl-ovl)) cl-pos) - (not (and (funcall cl-func (car cl-ovl) cl-arg) - (set-marker cl-mark nil))))) - (setq cl-ovl (cdr cl-ovl)))) - (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil))))) + (let (cl-ovl) + (with-current-buffer cl-buffer + (setq cl-ovl (overlay-lists)) + (if cl-start (setq cl-start (copy-marker cl-start))) + (if cl-end (setq cl-end (copy-marker cl-end)))) + (setq cl-ovl (nconc (car cl-ovl) (cdr cl-ovl))) + (while (and cl-ovl + (or (not (overlay-start (car cl-ovl))) + (and cl-end (>= (overlay-start (car cl-ovl)) cl-end)) + (and cl-start (<= (overlay-end (car cl-ovl)) cl-start)) + (not (funcall cl-func (car cl-ovl) cl-arg)))) + (setq cl-ovl (cdr cl-ovl))) + (if cl-start (set-marker cl-start nil)) + (if cl-end (set-marker cl-end nil)))) ;;; Support for `setf'. ;;;###autoload @@ -406,6 +384,42 @@ With two arguments, return rounding and remainder of their quotient." "Return 1 if X is positive, -1 if negative, 0 if zero." (cond ((> x 0) 1) ((< x 0) -1) (t 0))) +;;;###autoload +(cl-defun cl-parse-integer (string &key start end radix junk-allowed) + "Parse integer from the substring of STRING from START to END. +STRING may be surrounded by whitespace chars (chars with syntax ` '). +Other non-digit chars are considered junk. +RADIX is an integer between 2 and 36, the default is 10. Signal +an error if the substring between START and END cannot be parsed +as an integer unless JUNK-ALLOWED is non-nil." + (cl-check-type string string) + (let* ((start (or start 0)) + (len (length string)) + (end (or end len)) + (radix (or radix 10))) + (or (<= start end len) + (error "Bad interval: [%d, %d)" start end)) + (cl-flet ((skip-whitespace () + (while (and (< start end) + (= 32 (char-syntax (aref string start)))) + (setq start (1+ start))))) + (skip-whitespace) + (let ((sign (cl-case (and (< start end) (aref string start)) + (?+ (cl-incf start) +1) + (?- (cl-incf start) -1) + (t +1))) + digit sum) + (while (and (< start end) + (setq digit (cl-digit-char-p (aref string start) radix))) + (setq sum (+ (* (or sum 0) radix) digit) + start (1+ start))) + (skip-whitespace) + (cond ((and junk-allowed (null sum)) sum) + (junk-allowed (* sign sum)) + ((or (/= start end) (null sum)) + (error "Not an integer string: `%s'" string)) + (t (* sign sum))))))) + ;; Random numbers. @@ -508,28 +522,10 @@ If END is omitted, it defaults to the length of the sequence. If START or END is negative, it counts from the end." (declare (gv-setter (lambda (new) - `(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end) - ,new)))) - (if (stringp seq) (substring seq start end) - (let (len) - (and end (< end 0) (setq end (+ end (setq len (length seq))))) - (if (< start 0) (setq start (+ start (or len (setq len (length seq)))))) - (cond ((listp seq) - (if (> start 0) (setq seq (nthcdr start seq))) - (if end - (let ((res nil)) - (while (>= (setq end (1- end)) start) - (push (pop seq) res)) - (nreverse res)) - (copy-sequence seq))) - (t - (or end (setq end (or len (length seq)))) - (let ((res (make-vector (max (- end start) 0) nil)) - (i 0)) - (while (< start end) - (aset res i (aref seq start)) - (setq i (1+ i) start (1+ start))) - res)))))) + (macroexp-let2 nil new new + `(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end) + ,new))))) + (seq-subseq seq start end)) ;;;###autoload (defun cl-concatenate (type &rest seqs) @@ -575,7 +571,7 @@ If START or END is negative, it counts from the end." "Return the value of SYMBOL's PROPNAME property, or DEFAULT if none. \n(fn SYMBOL PROPNAME &optional DEFAULT)" (declare (compiler-macro cl--compiler-macro-get) - (gv-setter (lambda (store) `(put ,sym ,tag ,store)))) + (gv-setter (lambda (store) (ignore def) `(put ,sym ,tag ,store)))) (or (get sym tag) (and def ;; Make sure `def' is really absent as opposed to set to nil. @@ -593,15 +589,14 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (declare (gv-expander (lambda (do) (gv-letplace (getter setter) plist - (macroexp-let2 nil k tag - (macroexp-let2 nil d def - (funcall do `(cl-getf ,getter ,k ,d) - (lambda (v) - (macroexp-let2 nil val v - `(progn - ,(funcall setter - `(cl--set-getf ,getter ,k ,val)) - ,val)))))))))) + (macroexp-let2* nil ((k tag) (d def)) + (funcall do `(cl-getf ,getter ,k ,d) + (lambda (v) + (macroexp-let2 nil val v + `(progn + ,(funcall setter + `(cl--set-getf ,getter ,k ,val)) + ,val))))))))) (setplist '--cl-getf-symbol-- plist) (or (get '--cl-getf-symbol-- tag) ;; Originally we called cl-get here, @@ -634,6 +629,13 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (progn (setplist sym (cdr (cdr plist))) t) (cl--do-remf plist tag)))) +;;; Streams. + +;;;###autoload +(defun cl-fresh-line (&optional stream) + "Output a newline unless already at the beginning of a line." + (terpri stream 'ensure)) + ;;; Some debugging aids. (defun cl-prettyprint (form) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el new file mode 100644 index 00000000000..1bb70963a57 --- /dev/null +++ b/lisp/emacs-lisp/cl-generic.el @@ -0,0 +1,833 @@ +;;; cl-generic.el --- CLOS-style generic functions for Elisp -*- lexical-binding: t; -*- + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Stefan Monnier <monnier@iro.umontreal.ca> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This implements the most of CLOS's multiple-dispatch generic functions. +;; To use it you need either (require 'cl-generic) or (require 'cl-lib). +;; The main entry points are: `cl-defgeneric' and `cl-defmethod'. + +;; Missing elements: +;; - We don't support make-method, call-method, define-method-combination. +;; CLOS's define-method-combination is IMO overly complicated, and it suffers +;; from a significant problem: the method-combination code returns a sexp +;; that needs to be `eval'uated or compiled. IOW it requires run-time +;; code generation. Given how rarely method-combinations are used, +;; I just provided a cl-generic-method-combination-function, which +;; people can use if they are really desperate for such functionality. +;; - In defgeneric we don't support the options: +;; declare, :method-combination, :generic-function-class, :method-class, +;; :method. +;; Added elements: +;; - We support aliases to generic functions. +;; - The kind of thing on which to dispatch can be extended. +;; There is support in this file for dispatch on: +;; - (eql <val>) +;; - plain old types +;; - type of CL structs +;; eieio-core adds dispatch on: +;; - class of eieio objects +;; - actual class argument, using the syntax (subclass <class>). +;; - cl-generic-method-combination-function (i.s.o define-method-combination). +;; - cl-generic-call-method (which replaces make-method and call-method). + +;; Efficiency considerations: overall, I've made an effort to make this fairly +;; efficient for the expected case (e.g. no constant redefinition of methods). +;; - Generic functions which do not dispatch on any argument are implemented +;; optimally (just as efficient as plain old functions). +;; - Generic functions which only dispatch on one argument are fairly efficient +;; (not a lot of room for improvement, I think). +;; - Multiple dispatch is implemented rather naively. There's an extra `apply' +;; function call for every dispatch; we don't optimize each dispatch +;; based on the set of candidate methods remaining; we don't optimize the +;; order in which we performs the dispatches either; If/when this +;; becomes a problem, we can try and optimize it. +;; - call-next-method could be made more efficient, but isn't too terrible. + +;;; Code: + +;; Note: For generic functions that dispatch on several arguments (i.e. those +;; which use the multiple-dispatch feature), we always use the same "tagcodes" +;; and the same set of arguments on which to dispatch. This works, but is +;; often suboptimal since after one dispatch, the remaining dispatches can +;; usually be simplified, or even completely skipped. + +;; TODO/FIXME: +;; - WIBNI we could use something like +;; (add-function :before (cl-method-function (cl-find-method ...)) ...) + +(eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'pcase)) + +(defvar cl-generic-tagcode-function + (lambda (type _name) + (if (eq type t) '(0 . 'cl--generic-type) + (error "Unknown specializer %S" type))) + "Function to get the Elisp code to extract the tag on which we dispatch. +Takes a \"parameter-specializer-name\" and a variable name, and returns +a pair (PRIORITY . CODE) where CODE is an Elisp expression that should be +used to extract the \"tag\" (from the object held in the named variable) +that should uniquely determine if we have a match +\(i.e. the \"tag\" is the value that will be used to dispatch to the proper +method(s)). +Such \"tagcodes\" will be or'd together. +PRIORITY is an integer from 0 to 100 which is used to sort the tagcodes +in the `or'. The higher the priority, the more specific the tag should be. +More specifically, if PRIORITY is N and we have two objects X and Y +whose tag (according to TAGCODE) is `eql', then it should be the case +that for all other (PRIORITY . TAGCODE) where PRIORITY ≤ N, then +\(eval TAGCODE) for X is `eql' to (eval TAGCODE) for Y.") + +(defvar cl-generic-tag-types-function + (lambda (tag) (if (eq tag 'cl--generic-type) '(t))) + "Function to get the list of types that a given \"tag\" matches. +They should be sorted from most specific to least specific.") + +(cl-defstruct (cl--generic-method + (:constructor nil) + (:constructor cl--generic-method-make + (specializers qualifiers uses-cnm function)) + (:predicate nil)) + (specializers nil :read-only t :type list) + (qualifiers nil :read-only t :type (list-of atom)) + ;; USES-CNM is a boolean indicating if FUNCTION expects an extra argument + ;; holding the next-method. + (uses-cnm nil :read-only t :type boolean) + (function nil :read-only t :type function)) + +(cl-defstruct (cl--generic + (:constructor nil) + (:constructor cl--generic-make + (name &optional dispatches method-table)) + (:predicate nil)) + (name nil :type symbol :read-only t) ;Pointer back to the symbol. + ;; `dispatches' holds a list of (ARGNUM . TAGCODES) where ARGNUM is the index + ;; of the corresponding argument and TAGCODES is a list of (PRIORITY . EXP) + ;; where the EXPs are expressions (to be `or'd together) to compute the tag + ;; on which to dispatch and PRIORITY is the priority of each expression to + ;; decide in which order to sort them. + ;; The most important dispatch is last in the list (and the least is first). + (dispatches nil :type (list-of (cons natnum (list-of tagcode)))) + (method-table nil :type (list-of cl--generic-method))) + +(defmacro cl--generic (name) + `(get ,name 'cl--generic)) + +(defun cl-generic-ensure-function (name) + (let (generic + (origname name)) + (while (and (null (setq generic (cl--generic name))) + (fboundp name) + (symbolp (symbol-function name))) + (setq name (symbol-function name))) + (unless (or (not (fboundp name)) + (autoloadp (symbol-function name)) + (and (functionp name) generic)) + (error "%s is already defined as something else than a generic function" + origname)) + (if generic + (cl-assert (eq name (cl--generic-name generic))) + (setf (cl--generic name) (setq generic (cl--generic-make name))) + (defalias name (cl--generic-make-function generic))) + generic)) + +(defun cl--generic-setf-rewrite (name) + (let* ((setter (intern (format "cl-generic-setter--%s" name))) + (exp `(unless (eq ',setter (get ',name 'cl-generic-setter)) + ;; (when (get ',name 'gv-expander) + ;; (error "gv-expander conflicts with (setf %S)" ',name)) + (setf (get ',name 'cl-generic-setter) ',setter) + (gv-define-setter ,name (val &rest args) + (cons ',setter (cons val args)))))) + ;; Make sure `setf' can be used right away, e.g. in the body of the method. + (eval exp t) + (cons setter exp))) + +;;;###autoload +(defmacro cl-defgeneric (name args &rest options-and-methods) + "Create a generic function NAME. +DOC-STRING is the base documentation for this class. A generic +function has no body, as its purpose is to decide which method body +is appropriate to use. Specific methods are defined with `cl-defmethod'. +With this implementation the ARGS are currently ignored. +OPTIONS-AND-METHODS currently understands: +- (:documentation DOCSTRING) +- (declare DECLARATIONS)" + (declare (indent 2) (doc-string 3)) + (let* ((docprop (assq :documentation options-and-methods)) + (doc (cond ((stringp (car-safe options-and-methods)) + (pop options-and-methods)) + (docprop + (prog1 + (cadr docprop) + (setq options-and-methods + (delq docprop options-and-methods)))))) + (declarations (assq 'declare options-and-methods))) + (when declarations + (setq options-and-methods + (delq declarations options-and-methods))) + `(progn + ,(when (eq 'setf (car-safe name)) + (pcase-let ((`(,setter . ,code) (cl--generic-setf-rewrite + (cadr name)))) + (setq name setter) + code)) + ,@(mapcar (lambda (declaration) + (let ((f (cdr (assq (car declaration) + defun-declarations-alist)))) + (cond + (f (apply (car f) name args (cdr declaration))) + (t (message "Warning: Unknown defun property `%S' in %S" + (car declaration) name) + nil)))) + (cdr declarations)) + (defalias ',name + (cl-generic-define ',name ',args ',options-and-methods) + ,(help-add-fundoc-usage doc args))))) + +(defun cl--generic-mandatory-args (args) + (let ((res ())) + (while (not (memq (car args) '(nil &rest &optional &key))) + (push (pop args) res)) + (nreverse res))) + +;;;###autoload +(defun cl-generic-define (name args options-and-methods) + (let ((generic (cl-generic-ensure-function name)) + (mandatory (cl--generic-mandatory-args args)) + (apo (assq :argument-precedence-order options-and-methods))) + (setf (cl--generic-dispatches generic) nil) + (when apo + (dolist (arg (cdr apo)) + (let ((pos (memq arg mandatory))) + (unless pos (error "%S is not a mandatory argument" arg)) + (push (list (- (length mandatory) (length pos))) + (cl--generic-dispatches generic))))) + (setf (cl--generic-method-table generic) nil) + (cl--generic-make-function generic))) + +(defmacro cl-generic-current-method-specializers () + "List of (VAR . TYPE) where TYPE is var's specializer. +This macro can only be used within the lexical scope of a cl-generic method." + (error "cl-generic-current-method-specializers used outside of a method")) + +(eval-and-compile ;Needed while compiling the cl-defmethod calls below! + (defun cl--generic-fgrep (vars sexp) ;Copied from pcase.el. + "Check which of the symbols VARS appear in SEXP." + (let ((res '())) + (while (consp sexp) + (dolist (var (cl--generic-fgrep vars (pop sexp))) + (unless (memq var res) (push var res)))) + (and (memq sexp vars) (not (memq sexp res)) (push sexp res)) + res)) + + (defun cl--generic-lambda (args body) + "Make the lambda expression for a method with ARGS and BODY." + (let ((plain-args ()) + (specializers nil) + (doc-string (if (and (stringp (car-safe body)) (cdr body)) + (pop body))) + (mandatory t)) + (dolist (arg args) + (push (pcase arg + ((or '&optional '&rest '&key) (setq mandatory nil) arg) + ((and `(,name . ,type) (guard mandatory)) + (push (cons name (car type)) specializers) + name) + (_ arg)) + plain-args)) + (setq plain-args (nreverse plain-args)) + (let ((fun `(cl-function (lambda ,plain-args + ,@(if doc-string (list doc-string)) + ,@body))) + (macroenv (cons `(cl-generic-current-method-specializers + . ,(lambda () specializers)) + macroexpand-all-environment))) + (require 'cl-lib) ;Needed to expand `cl-flet' and `cl-function'. + ;; First macroexpand away the cl-function stuff (e.g. &key and + ;; destructuring args, `declare' and whatnot). + (pcase (macroexpand fun macroenv) + (`#'(lambda ,args . ,body) + (let* ((doc-string (and doc-string (stringp (car body)) (cdr body) + (pop body))) + (cnm (make-symbol "cl--cnm")) + (nmp (make-symbol "cl--nmp")) + (nbody (macroexpand-all + `(cl-flet ((cl-call-next-method ,cnm) + (cl-next-method-p ,nmp)) + ,@body) + macroenv)) + ;; FIXME: Rather than `grep' after the fact, the + ;; macroexpansion should directly set some flag when cnm + ;; is used. + ;; FIXME: Also, optimize the case where call-next-method is + ;; only called with explicit arguments. + (uses-cnm (cl--generic-fgrep (list cnm nmp) nbody))) + (cons (not (not uses-cnm)) + `#'(lambda (,@(if uses-cnm (list cnm)) ,@args) + ,@(if doc-string (list doc-string)) + ,(if (not (memq nmp uses-cnm)) + nbody + `(let ((,nmp (lambda () + (cl--generic-isnot-nnm-p ,cnm)))) + ,nbody)))))) + (f (error "Unexpected macroexpansion result: %S" f))))))) + + +;;;###autoload +(defmacro cl-defmethod (name args &rest body) + "Define a new method for generic function NAME. +I.e. it defines the implementation of NAME to use for invocations where the +value of the dispatch argument matches the specified TYPE. +The dispatch argument has to be one of the mandatory arguments, and +all methods of NAME have to use the same argument for dispatch. +The dispatch argument and TYPE are specified in ARGS where the corresponding +formal argument appears as (VAR TYPE) rather than just VAR. + +The optional second argument QUALIFIER is a specifier that +modifies how the method is combined with other methods, including: + :before - Method will be called before the primary + :after - Method will be called after the primary + :around - Method will be called around everything else +The absence of QUALIFIER means this is a \"primary\" method. + +Other than a type, TYPE can also be of the form `(eql VAL)' in +which case this method will be invoked when the argument is `eql' to VAL. + +\(fn NAME [QUALIFIER] ARGS &rest [DOCSTRING] BODY)" + (declare (doc-string 3) (indent 2) + (debug + (&define ; this means we are defining something + [&or name ("setf" :name setf name)] + ;; ^^ This is the methods symbol + [ &optional keywordp ] ; this is key :before etc + list ; arguments + [ &optional stringp ] ; documentation string + def-body))) ; part to be debugged + (let ((qualifiers nil) + (setfizer (if (eq 'setf (car-safe name)) + ;; Call it before we call cl--generic-lambda. + (cl--generic-setf-rewrite (cadr name))))) + (while (not (listp args)) + (push args qualifiers) + (setq args (pop body))) + (pcase-let* ((`(,uses-cnm . ,fun) (cl--generic-lambda args body))) + `(progn + ,(when setfizer + (setq name (car setfizer)) + (cdr setfizer)) + ,(and (get name 'byte-obsolete-info) + (or (not (fboundp 'byte-compile-warning-enabled-p)) + (byte-compile-warning-enabled-p 'obsolete)) + (let* ((obsolete (get name 'byte-obsolete-info))) + (macroexp--warn-and-return + (macroexp--obsolete-warning name obsolete "generic function") + nil))) + ;; You could argue that `defmethod' modifies rather than defines the + ;; function, so warnings like "not known to be defined" are fair game. + ;; But in practice, it's common to use `cl-defmethod' + ;; without a previous `cl-defgeneric'. + (declare-function ,name "") + (cl-generic-define-method ',name ',qualifiers ',args + ,uses-cnm ,fun))))) + +(defun cl--generic-member-method (specializers qualifiers methods) + (while + (and methods + (let ((m (car methods))) + (not (and (equal (cl--generic-method-specializers m) specializers) + (equal (cl--generic-method-qualifiers m) qualifiers))))) + (setq methods (cdr methods)) + methods)) + +;;;###autoload +(defun cl-generic-define-method (name qualifiers args uses-cnm function) + (let* ((generic (cl-generic-ensure-function name)) + (mandatory (cl--generic-mandatory-args args)) + (specializers + (mapcar (lambda (arg) (if (consp arg) (cadr arg) t)) mandatory)) + (method (cl--generic-method-make + specializers qualifiers uses-cnm function)) + (mt (cl--generic-method-table generic)) + (me (cl--generic-member-method specializers qualifiers mt)) + (dispatches (cl--generic-dispatches generic)) + (i 0)) + (dolist (specializer specializers) + (let* ((tagcode (funcall cl-generic-tagcode-function specializer 'arg)) + (x (assq i dispatches))) + (unless x + (setq x (list i (funcall cl-generic-tagcode-function t 'arg))) + (setf (cl--generic-dispatches generic) + (setq dispatches (cons x dispatches)))) + (unless (member tagcode (cdr x)) + (setf (cdr x) + (nreverse (sort (cons tagcode (cdr x)) + #'car-less-than-car)))) + (setq i (1+ i)))) + (if me (setcar me method) + (setf (cl--generic-method-table generic) (cons method mt))) + (cl-pushnew `(cl-defmethod . (,(cl--generic-name generic) . ,specializers)) + current-load-list :test #'equal) + (let ((gfun (cl--generic-make-function generic)) + ;; Prevent `defalias' from recording this as the definition site of + ;; the generic function. + current-load-list) + ;; For aliases, cl--generic-name gives us the actual name. + (defalias (cl--generic-name generic) gfun)))) + +(defmacro cl--generic-with-memoization (place &rest code) + (declare (indent 1) (debug t)) + (gv-letplace (getter setter) place + `(or ,getter + ,(macroexp-let2 nil val (macroexp-progn code) + `(progn + ,(funcall setter val) + ,val))))) + +(defvar cl--generic-dispatchers (make-hash-table :test #'equal)) + +(defun cl--generic-get-dispatcher (tagcodes dispatch-arg) + (cl--generic-with-memoization + (gethash (cons dispatch-arg tagcodes) cl--generic-dispatchers) + (let ((lexical-binding t) + (tag-exp `(or ,@(mapcar #'cdr + ;; Minor optimization: since this tag-exp is + ;; only used to lookup the method-cache, it + ;; doesn't matter if the default value is some + ;; constant or nil. + (if (macroexp-const-p (car (last tagcodes))) + (butlast tagcodes) + tagcodes)))) + (extraargs ())) + (dotimes (_ dispatch-arg) + (push (make-symbol "arg") extraargs)) + (byte-compile + `(lambda (generic dispatches-left) + (let ((method-cache (make-hash-table :test #'eql))) + (lambda (,@extraargs arg &rest args) + (apply (cl--generic-with-memoization + (gethash ,tag-exp method-cache) + (cl--generic-cache-miss + generic ',dispatch-arg dispatches-left + (list ,@(mapcar #'cdr tagcodes)))) + ,@extraargs arg args)))))))) + +(defun cl--generic-make-function (generic) + (let* ((dispatches (cl--generic-dispatches generic)) + (dispatch + (progn + (while (and dispatches + (member (cdar dispatches) + '(nil ((0 . 'cl--generic-type))))) + (setq dispatches (cdr dispatches))) + (pop dispatches)))) + (if (null dispatch) + (cl--generic-build-combined-method + (cl--generic-name generic) + (cl--generic-method-table generic)) + (let ((dispatcher (cl--generic-get-dispatcher + (cdr dispatch) (car dispatch)))) + (funcall dispatcher generic dispatches))))) + +(defvar cl-generic-method-combination-function + #'cl--generic-standard-method-combination + "Function to build the effective method. +Called with 2 arguments: NAME and METHOD-ALIST. +It should return an effective method, i.e. a function that expects the same +arguments as the methods, and calls those methods in some appropriate order. +NAME is the name (a symbol) of the corresponding generic function. +METHOD-ALIST is a list of elements (QUALIFIERS . METHODS) where +QUALIFIERS is a list of qualifiers, and METHODS is a list of the selected +methods for that qualifier list. +The METHODS lists are sorted from most generic first to most specific last. +The function can use `cl-generic-call-method' to create functions that call those +methods.") + +(defvar cl--generic-combined-method-memoization + (make-hash-table :test #'equal :weakness 'value) + "Table storing previously built combined-methods. +This is particularly useful when many different tags select the same set +of methods, since this table then allows us to share a single combined-method +for all those different tags in the method-cache.") + +(defun cl--generic-build-combined-method (generic-name methods) + (cl--generic-with-memoization + (gethash (cons generic-name methods) + cl--generic-combined-method-memoization) + (let ((mets-by-qual ())) + (dolist (method methods) + (let* ((qualifiers (cl--generic-method-qualifiers method)) + (x (assoc qualifiers mets-by-qual))) + ;; FIXME: sadly, alist-get only uses `assq' and we need `assoc'. + ;;(push (cdr qm) (alist-get qualifiers mets-by-qual))) + (if x + (push method (cdr x)) + (push (list qualifiers method) mets-by-qual)))) + (funcall cl-generic-method-combination-function + generic-name mets-by-qual)))) + +(defun cl--generic-no-next-method-function (generic method) + (lambda (&rest args) + (apply #'cl-no-next-method generic method args))) + +(defun cl-generic-call-method (generic-name method &optional fun) + "Return a function that calls METHOD. +FUN is the function that should be called when METHOD calls +`call-next-method'." + (if (not (cl--generic-method-uses-cnm method)) + (cl--generic-method-function method) + (let ((met-fun (cl--generic-method-function method)) + (next (or fun (cl--generic-no-next-method-function + generic-name method)))) + (lambda (&rest args) + (apply met-fun + ;; FIXME: This sucks: passing just `next' would + ;; be a lot more efficient than the lambda+apply + ;; quasi-η, but we need this to implement the + ;; "if call-next-method is called with no + ;; arguments, then use the previous arguments". + (lambda (&rest cnm-args) + (apply next (or cnm-args args))) + args))))) + +(defun cl--generic-standard-method-combination (generic-name mets-by-qual) + (dolist (x mets-by-qual) + (unless (member (car x) '(() (:after) (:before) (:around))) + (error "Unsupported qualifiers in function %S: %S" generic-name (car x)))) + (cond + ((null mets-by-qual) + (lambda (&rest args) + (apply #'cl-no-applicable-method generic-name args))) + ((null (alist-get nil mets-by-qual)) + (lambda (&rest args) + (apply #'cl-no-primary-method generic-name args))) + (t + (let* ((fun nil) + (ab-call (lambda (m) (cl-generic-call-method generic-name m))) + (before + (mapcar ab-call (reverse (cdr (assoc '(:before) mets-by-qual))))) + (after (mapcar ab-call (cdr (assoc '(:after) mets-by-qual))))) + (dolist (method (cdr (assoc nil mets-by-qual))) + (setq fun (cl-generic-call-method generic-name method fun))) + (when (or after before) + (let ((next fun)) + (setq fun (lambda (&rest args) + (dolist (bf before) + (apply bf args)) + (prog1 + (apply next args) + (dolist (af after) + (apply af args))))))) + (dolist (method (cdr (assoc '(:around) mets-by-qual))) + (setq fun (cl-generic-call-method generic-name method fun))) + fun)))) + +(defconst cl--generic-nnm-sample (cl--generic-no-next-method-function t t)) +(defconst cl--generic-cnm-sample + (funcall (cl--generic-build-combined-method + nil (list (cl--generic-method-make () () t #'identity))))) + +(defun cl--generic-isnot-nnm-p (cnm) + "Return non-nil if CNM is the function that calls `cl-no-next-method'." + ;; ¡Big Gross Ugly Hack! + ;; `next-method-p' just sucks, we should let it die. But EIEIO did support + ;; it, and some packages use it, so we need to support it. + (catch 'found + (cl-assert (function-equal cnm cl--generic-cnm-sample)) + (if (byte-code-function-p cnm) + (let ((cnm-constants (aref cnm 2)) + (sample-constants (aref cl--generic-cnm-sample 2))) + (dotimes (i (length sample-constants)) + (when (function-equal (aref sample-constants i) + cl--generic-nnm-sample) + (throw 'found + (not (function-equal (aref cnm-constants i) + cl--generic-nnm-sample)))))) + (cl-assert (eq 'closure (car-safe cl--generic-cnm-sample))) + (let ((cnm-env (cadr cnm))) + (dolist (vb (cadr cl--generic-cnm-sample)) + (when (function-equal (cdr vb) cl--generic-nnm-sample) + (throw 'found + (not (function-equal (cdar cnm-env) + cl--generic-nnm-sample)))) + (setq cnm-env (cdr cnm-env))))) + (error "Haven't found no-next-method-sample in cnm-sample"))) + +(defun cl--generic-cache-miss (generic dispatch-arg dispatches-left tags) + (let ((types (apply #'append (mapcar cl-generic-tag-types-function tags))) + (methods '())) + (dolist (method (cl--generic-method-table generic)) + (let* ((specializer (or (nth dispatch-arg + (cl--generic-method-specializers method)) + t)) + (m (member specializer types))) + (when m + (push (cons (length m) method) methods)))) + ;; Sort the methods, most specific first. + ;; It would be tempting to sort them once and for all in the method-table + ;; rather than here, but the order might depend on the actual argument + ;; (e.g. for multiple inheritance with defclass). + (setq methods (nreverse (mapcar #'cdr (sort methods #'car-less-than-car)))) + (cl--generic-make-function (cl--generic-make (cl--generic-name generic) + dispatches-left methods)))) + +;;; Define some pre-defined generic functions, used internally. + +(define-error 'cl-no-method "No method for %S") +(define-error 'cl-no-next-method "No next method for %S" 'cl-no-method) +(define-error 'cl-no-primary-method "No primary method for %S" 'cl-no-method) +(define-error 'cl-no-applicable-method "No applicable method for %S" + 'cl-no-method) + +(cl-defgeneric cl-no-next-method (generic method &rest args) + "Function called when `cl-call-next-method' finds no next method.") +(cl-defmethod cl-no-next-method (generic method &rest args) + (signal 'cl-no-next-method `(,generic ,method ,@args))) + +(cl-defgeneric cl-no-applicable-method (generic &rest args) + "Function called when a method call finds no applicable method.") +(cl-defmethod cl-no-applicable-method (generic &rest args) + (signal 'cl-no-applicable-method `(,generic ,@args))) + +(cl-defgeneric cl-no-primary-method (generic &rest args) + "Function called when a method call finds no primary method.") +(cl-defmethod cl-no-primary-method (generic &rest args) + (signal 'cl-no-primary-method `(,generic ,@args))) + +(defun cl-call-next-method (&rest _args) + "Function to call the next applicable method. +Can only be used from within the lexical body of a primary or around method." + (error "cl-call-next-method only allowed inside primary and around methods")) + +(defun cl-next-method-p () + "Return non-nil if there is a next method. +Can only be used from within the lexical body of a primary or around method." + (declare (obsolete "make sure there's always a next method, or catch `cl-no-next-method' instead" "25.1")) + (error "cl-next-method-p only allowed inside primary and around methods")) + +;;;###autoload +(defun cl-find-method (generic qualifiers specializers) + (car (cl--generic-member-method + specializers qualifiers + (cl--generic-method-table (cl--generic generic))))) + +(defalias 'cl-method-qualifiers 'cl--generic-method-qualifiers) + +;;; Add support for describe-function + +(defun cl--generic-search-method (met-name) + (let ((base-re (concat "(\\(?:cl-\\)?defmethod[ \t]+" + (regexp-quote (format "%s\\_>" (car met-name)))))) + (or + (re-search-forward + (concat base-re "[^&\"\n]*" + (mapconcat (lambda (specializer) + (regexp-quote + (format "%S" (if (consp specializer) + (nth 1 specializer) specializer)))) + (remq t (cdr met-name)) + "[ \t\n]*)[^&\"\n]*")) + nil t) + (re-search-forward base-re nil t)))) + + +(with-eval-after-load 'find-func + (defvar find-function-regexp-alist) + (add-to-list 'find-function-regexp-alist + `(cl-defmethod . ,#'cl--generic-search-method))) + +(defun cl--generic-method-info (method) + (let* ((specializers (cl--generic-method-specializers method)) + (qualifiers (cl--generic-method-qualifiers method)) + (uses-cnm (cl--generic-method-uses-cnm method)) + (function (cl--generic-method-function method)) + (args (help-function-arglist function 'names)) + (docstring (documentation function)) + (qual-string + (if (null qualifiers) "" + (cl-assert (consp qualifiers)) + (let ((s (prin1-to-string qualifiers))) + (concat (substring s 1 -1) " ")))) + (doconly (if docstring + (let ((split (help-split-fundoc docstring nil))) + (if split (cdr split) docstring)))) + (combined-args ())) + (if uses-cnm (setq args (cdr args))) + (dolist (specializer specializers) + (let ((arg (if (eq '&rest (car args)) + (intern (format "arg%d" (length combined-args))) + (pop args)))) + (push (if (eq specializer t) arg (list arg specializer)) + combined-args))) + (setq combined-args (append (nreverse combined-args) args)) + (list qual-string combined-args doconly))) + +(add-hook 'help-fns-describe-function-functions #'cl--generic-describe) +(defun cl--generic-describe (function) + (let ((generic (if (symbolp function) (cl--generic function)))) + (when generic + (require 'help-mode) ;Needed for `help-function-def' button! + (save-excursion + (insert "\n\nThis is a generic function.\n\n") + (insert (propertize "Implementations:\n\n" 'face 'bold)) + ;; Loop over fanciful generics + (dolist (method (cl--generic-method-table generic)) + (let* ((info (cl--generic-method-info method))) + ;; FIXME: Add hyperlinks for the types as well. + (insert (format "%s%S" (nth 0 info) (nth 1 info))) + (let* ((met-name (cons function + (cl--generic-method-specializers method))) + (file (find-lisp-object-file-name met-name 'cl-defmethod))) + (when file + (insert " in `") + (help-insert-xref-button (help-fns-short-filename file) + 'help-function-def met-name file + 'cl-defmethod) + (insert "'.\n"))) + (insert "\n" (or (nth 2 info) "Undocumented") "\n\n"))))))) + +;;; Support for (eql <val>) specializers. + +(defvar cl--generic-eql-used (make-hash-table :test #'eql)) + +(add-function :before-until cl-generic-tagcode-function + #'cl--generic-eql-tagcode) +(defun cl--generic-eql-tagcode (type name) + (when (eq (car-safe type) 'eql) + (puthash (cadr type) type cl--generic-eql-used) + `(100 . (gethash ,name cl--generic-eql-used)))) + +(add-function :before-until cl-generic-tag-types-function + #'cl--generic-eql-tag-types) +(defun cl--generic-eql-tag-types (tag) + (if (eq (car-safe tag) 'eql) (list tag))) + +;;; Support for cl-defstructs specializers. + +(add-function :before-until cl-generic-tagcode-function + #'cl--generic-struct-tagcode) +(defun cl--generic-struct-tagcode (type name) + (and (symbolp type) + (get type 'cl-struct-type) + (or (eq 'vector (car (get type 'cl-struct-type))) + (error "Can't dispatch on cl-struct %S: type is %S" + type (car (get type 'cl-struct-type)))) + (or (equal '(cl-tag-slot) (car (get type 'cl-struct-slots))) + (error "Can't dispatch on cl-struct %S: no tag in slot 0" + type)) + ;; We could/should check the vector has length >0, + ;; but really, mixing vectors and structs is a bad idea, + ;; so let's not waste time trying to handle the case + ;; of an empty vector. + ;; BEWARE: this returns a bogus tag for non-struct vectors. + `(50 . (and (vectorp ,name) (aref ,name 0))))) + +(add-function :before-until cl-generic-tag-types-function + #'cl--generic-struct-tag-types) +(defun cl--generic-struct-tag-types (tag) + ;; FIXME: cl-defstruct doesn't make it easy for us. + (and (symbolp tag) + ;; A method call shouldn't itself mess with the match-data. + (string-match-p "\\`cl-struct-\\(.*\\)" (symbol-name tag)) + (let ((types (list (intern (substring (symbol-name tag) 10))))) + (while (get (car types) 'cl-struct-include) + (push (get (car types) 'cl-struct-include) types)) + (push 'cl-struct types) ;The "parent type" of all cl-structs. + (nreverse types)))) + +;;; Dispatch on "system types". + +(defconst cl--generic-typeof-types + ;; Hand made from the source code of `type-of'. + '((integer number) (symbol) (string array sequence) (cons list sequence) + ;; Markers aren't `numberp', yet they are accepted wherever integers are + ;; accepted, pretty much. + (marker) (overlay) (float number) (window-configuration) + (process) (window) (subr) (compiled-function) (buffer) + (char-table array sequence) + (bool-vector array sequence) + (frame) (hash-table) (font-spec) (font-entity) (font-object) + (vector array sequence) + ;; Plus, hand made: + (null symbol list sequence) + (list sequence) + (array sequence) + (sequence) + (number))) + +(add-function :before-until cl-generic-tagcode-function + #'cl--generic-typeof-tagcode) +(defun cl--generic-typeof-tagcode (type name) + ;; FIXME: Add support for other types accepted by `cl-typep' such + ;; as `character', `atom', `face', `function', ... + (and (assq type cl--generic-typeof-types) + (progn + (if (memq type '(vector array sequence)) + (message "`%S' also matches CL structs and EIEIO classes" type)) + ;; FIXME: We could also change `type-of' to return `null' for nil. + `(10 . (if ,name (type-of ,name) 'null))))) + +(add-function :before-until cl-generic-tag-types-function + #'cl--generic-typeof-types) +(defun cl--generic-typeof-types (tag) + (and (symbolp tag) + (assq tag cl--generic-typeof-types))) + +;;; Just for kicks: dispatch on major-mode +;; +;; Here's how you'd use it: +;; (cl-defmethod foo ((x (major-mode text-mode)) y z) ...) +;; And then +;; (foo 'major-mode toto titi) +;; +;; FIXME: Better would be to do that via dispatch on an "implicit argument". +;; E.g. (cl-defmethod foo (y z &context (major-mode text-mode)) ...) + +;; (defvar cl--generic-major-modes (make-hash-table :test #'eq)) +;; +;; (add-function :before-until cl-generic-tagcode-function +;; #'cl--generic-major-mode-tagcode) +;; (defun cl--generic-major-mode-tagcode (type name) +;; (if (eq 'major-mode (car-safe type)) +;; `(50 . (if (eq ,name 'major-mode) +;; (cl--generic-with-memoization +;; (gethash major-mode cl--generic-major-modes) +;; `(cl--generic-major-mode . ,major-mode)))))) +;; +;; (add-function :before-until cl-generic-tag-types-function +;; #'cl--generic-major-mode-types) +;; (defun cl--generic-major-mode-types (tag) +;; (when (eq (car-safe tag) 'cl--generic-major-mode) +;; (if (eq tag 'fundamental-mode) '(fundamental-mode t) +;; (let ((types `((major-mode ,(cdr tag))))) +;; (while (get (car types) 'derived-mode-parent) +;; (push (list 'major-mode (get (car types) 'derived-mode-parent)) +;; types)) +;; (unless (eq 'fundamental-mode (car types)) +;; (push '(major-mode fundamental-mode) types)) +;; (nreverse types))))) + +;; Local variables: +;; generated-autoload-file: "cl-loaddefs.el" +;; End: + +(provide 'cl-generic) +;;; cl-generic.el ends here diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el index 5c49f843475..1bcfb6df2cf 100644 --- a/lisp/emacs-lisp/cl-indent.el +++ b/lisp/emacs-lisp/cl-indent.el @@ -27,6 +27,8 @@ ;; This package supplies a single entry point, common-lisp-indent-function, ;; which performs indentation in the preferred style for Common Lisp code. +;; It is also a suitable function for indenting Emacs lisp code. +;; ;; To enable it: ;; ;; (setq lisp-indent-function 'common-lisp-indent-function) @@ -154,6 +156,15 @@ is set to `defun'.") (looking-at "\\sw")) (error t))) +(defun lisp-indent-find-method (symbol &optional no-compat) + "Find the lisp indentation function for SYMBOL. +If NO-COMPAT is non-nil, do not retrieve indenters intended for +the standard lisp indent package." + (or (and (derived-mode-p 'emacs-lisp-mode) + (get symbol 'common-lisp-indent-function-for-elisp)) + (get symbol 'common-lisp-indent-function) + (and (not no-compat) + (get symbol 'lisp-indent-function)))) (defun common-lisp-loop-part-indentation (indent-point state) "Compute the indentation of loop form constituents." @@ -245,9 +256,17 @@ For example, the function `case' has an indent property * indent the first argument by 4. * arguments after the first should be lists, and there may be any number of them. The first list element has an offset of 2, all the rest - have an offset of 2+1=3." + have an offset of 2+1=3. + +If the current mode is actually `emacs-lisp-mode', look for a +`common-lisp-indent-function-for-elisp' property before looking +at `common-lisp-indent-function' and, if set, use its value +instead." + ;; FIXME: why do we need to special-case loop? (if (save-excursion (goto-char (elt state 1)) - (looking-at "([Ll][Oo][Oo][Pp]")) + (looking-at (if (derived-mode-p 'emacs-lisp-mode) + "(\\(cl-\\)?[Ll][Oo][Oo][Pp]" + "([Ll][Oo][Oo][Pp]"))) (common-lisp-loop-part-indentation indent-point state) (common-lisp-indent-function-1 indent-point state))) @@ -291,18 +310,29 @@ For example, the function `case' has an indent property (setq function (downcase (buffer-substring-no-properties tem (point)))) (goto-char tem) + ;; Elisp generally provides CL functionality with a CL + ;; prefix, so if we have a special indenter for the + ;; unprefixed version, prefer it over whatever's defined + ;; for the cl- version. Users can override this + ;; heuristic by defining a + ;; common-lisp-indent-function-for-elisp property on the + ;; cl- version. + (when (and (derived-mode-p 'emacs-lisp-mode) + (not (lisp-indent-find-method + (intern-soft function) t)) + (string-match "\\`cl-" function) + (setf tem (intern-soft + (substring function (match-end 0)))) + (lisp-indent-find-method tem t)) + (setf function (symbol-name tem))) (setq tem (intern-soft function) - method (get tem 'common-lisp-indent-function)) - (cond ((and (null method) - (string-match ":[^:]+" function)) - ;; The pleblisp package feature - (setq function (substring function - (1+ (match-beginning 0))) - method (get (intern-soft function) - 'common-lisp-indent-function))) - ((and (null method)) - ;; backwards compatibility - (setq method (get tem 'lisp-indent-function))))) + method (lisp-indent-find-method tem)) + ;; The pleblisp package feature + (when (and (null tem) + (string-match ":[^:]+" function)) + (setq function (substring function (1+ (match-beginning 0))) + tem (intern-soft function) + method (lisp-indent-find-method tem)))) (let ((n 0)) ;; How far into the containing form is the current form? (if (< (point) indent-point) @@ -764,7 +794,11 @@ optional\\|rest\\|key\\|allow-other-keys\\|aux\\|whole\\|body\\|environment\ (put (car el) 'common-lisp-indent-function (if (symbolp (cdr el)) (get (cdr el) 'common-lisp-indent-function) - (car (cdr el)))))) + (car (cdr el)))))) + +;; In elisp, the else part of `if' is in an implicit progn, so indent +;; it more. +(put 'if 'common-lisp-indent-function-for-elisp 2) ;(defun foo (x) diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index eb5f2d4f98d..0f534181b22 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -152,9 +152,6 @@ an element already on the list. `(setq ,place (cl-adjoin ,x ,place ,@keys))) `(cl-callf2 cl-adjoin ,x ,place ,@keys))) -(defun cl--set-elt (seq n val) - (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val))) - (defun cl--set-buffer-substring (start end val) (save-excursion (delete-region start end) (goto-char start) @@ -282,6 +279,25 @@ so that they are registered at compile-time as well as run-time." "Return t if INTEGER is even." (eq (logand integer 1) 0)) +(defconst cl-digit-char-table + (let* ((digits (make-vector 256 nil)) + (populate (lambda (start end base) + (mapc (lambda (i) + (aset digits i (+ base (- i start)))) + (number-sequence start end))))) + (funcall populate ?0 ?9 0) + (funcall populate ?A ?Z 10) + (funcall populate ?a ?z 10) + digits)) + +(defun cl-digit-char-p (char &optional radix) + "Test if CHAR is a digit in the specified RADIX (default 10). +If true return the decimal value of digit CHAR in RADIX." + (or (<= 2 (or radix 10) 36) + (signal 'args-out-of-range (list 'radix radix '(2 36)))) + (let ((n (aref cl-digit-char-table char))) + (and n (< n (or radix 10)) n))) + (defvar cl--random-state (vector 'cl--random-state-tag -1 30 (cl--random-time))) @@ -361,7 +377,13 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp (cl--defalias 'cl-first 'car) (cl--defalias 'cl-second 'cadr) (cl--defalias 'cl-rest 'cdr) -(cl--defalias 'cl-endp 'null) + +(defun cl-endp (x) + "Return true if X is the empty list; false if it is a cons. +Signal an error if X is not a list." + (if (listp x) + (null x) + (signal 'wrong-type-argument (list 'listp x 'x)))) (cl--defalias 'cl-third 'cl-caddr "Return the third element of the list X.") (cl--defalias 'cl-fourth 'cl-cadddr "Return the fourth element of the list X.") @@ -625,7 +647,6 @@ If ALIST is non-nil, the new pairs are prepended to it." `(insert (prog1 ,store (erase-buffer)))) (gv-define-simple-setter buffer-substring cl--set-buffer-substring) (gv-define-simple-setter current-buffer set-buffer) -(gv-define-simple-setter current-case-table set-case-table) (gv-define-simple-setter current-column move-to-column t) (gv-define-simple-setter current-global-map use-global-map t) (gv-define-setter current-input-mode (store) @@ -680,7 +701,6 @@ If ALIST is non-nil, the new pairs are prepended to it." (gv-define-setter window-width (store) `(progn (enlarge-window (- ,store (window-width)) t) ,store)) (gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t) -(gv-define-simple-setter x-get-selection x-own-selection t) ;; More complex setf-methods. @@ -703,12 +723,11 @@ If ALIST is non-nil, the new pairs are prepended to it." (gv-define-expander substring (lambda (do place from &optional to) (gv-letplace (getter setter) place - (macroexp-let2 nil start from - (macroexp-let2 nil end to - (funcall do `(substring ,getter ,start ,end) - (lambda (v) - (funcall setter `(cl--set-substring - ,getter ,start ,end ,v))))))))) + (macroexp-let2* nil ((start from) (end to)) + (funcall do `(substring ,getter ,start ,end) + (lambda (v) + (funcall setter `(cl--set-substring + ,getter ,start ,end ,v)))))))) ;;; Miscellaneous. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 34c040c1843..38f15b89b0e 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -135,7 +135,13 @@ (t t))) (defun cl--const-expr-val (x) - (and (macroexp-const-p x) (if (consp x) (nth 1 x) x))) + "Return the value of X known at compile-time. +If X is not known at compile time, return nil. Before testing +whether X is known at compile time, macroexpand it completely in +`macroexpand-all-environment'." + (let ((x (macroexpand-all x macroexpand-all-environment))) + (if (macroexp-const-p x) + (if (consp x) (nth 1 x) x)))) (defun cl--expr-contains (x y) "Count number of times X refers to Y. Return nil for 0 times." @@ -619,14 +625,20 @@ The result of the body appears to the compiler as a quoted constant." (set `(setq ,temp ,form))) (if (and (fboundp 'byte-compile-file-form-defmumble) (boundp 'this-kind) (boundp 'that-one)) - (fset 'byte-compile-file-form - `(lambda (form) - (fset 'byte-compile-file-form - ',(symbol-function 'byte-compile-file-form)) - (byte-compile-file-form ',set) - (byte-compile-file-form form))) - (print set (symbol-value 'byte-compile--outbuffer))) - `(symbol-value ',temp)) + ;; Else, we can't output right away, so we have to delay it to the + ;; next time we're at the top-level. + ;; FIXME: Use advice-add/remove. + (fset 'byte-compile-file-form + (let ((old (symbol-function 'byte-compile-file-form))) + (lambda (form) + (fset 'byte-compile-file-form old) + (byte-compile-file-form set) + (byte-compile-file-form form)))) + ;; If we're not in the middle of compiling something, we can + ;; output directly to byte-compile-outbuffer, to make sure + ;; temp is set before we use it. + (print set byte-compile--outbuffer)) + temp) `',(eval form))) @@ -816,7 +828,8 @@ For more details, see Info node `(cl)Loop Facility'. "repeat" "while" "until" "always" "never" "thereis" "collect" "append" "nconc" "sum" "count" "maximize" "minimize" "if" "unless" - "return"] form] + "return"] + form] ;; Simple default, which covers 99% of the cases. symbolp form))) (if (not (memq t (mapcar #'symbolp @@ -1130,7 +1143,8 @@ For more details, see Info node `(cl)Loop Facility'. (if end (push (list (if down (if excl '> '>=) (if excl '< '<=)) - var (or end-var end)) cl--loop-body)) + var (or end-var end)) + cl--loop-body)) (push (list var (list (if down '- '+) var (or step-var step 1))) loop-for-steps))) @@ -1188,7 +1202,8 @@ For more details, see Info node `(cl)Loop Facility'. (push (list temp-vec (pop cl--loop-args)) loop-for-bindings) (push (list temp-idx -1) loop-for-bindings) (push `(< (setq ,temp-idx (1+ ,temp-idx)) - (length ,temp-vec)) cl--loop-body) + (length ,temp-vec)) + cl--loop-body) (if (eq word 'across-ref) (push (list var `(aref ,temp-vec ,temp-idx)) cl--loop-symbol-macs) @@ -1364,7 +1379,8 @@ For more details, see Info node `(cl)Loop Facility'. (if loop-for-sets (push `(progn ,(cl--loop-let (nreverse loop-for-sets) 'setq ands) - t) cl--loop-body)) + t) + cl--loop-body)) (if loop-for-steps (push (cons (if ands 'cl-psetq 'setq) (apply 'append (nreverse loop-for-steps))) @@ -1382,7 +1398,8 @@ For more details, see Info node `(cl)Loop Facility'. (push `(progn (push ,what ,var) t) cl--loop-body) (push `(progn (setq ,var (nconc ,var (list ,what))) - t) cl--loop-body)))) + t) + cl--loop-body)))) ((memq word '(nconc nconcing append appending)) (let ((what (pop cl--loop-args)) @@ -1397,7 +1414,9 @@ For more details, see Info node `(cl)Loop Facility'. ,var) `(,(if (memq word '(nconc nconcing)) #'nconc #'append) - ,var ,what))) t) cl--loop-body))) + ,var ,what))) + t) + cl--loop-body))) ((memq word '(concat concating)) (let ((what (pop cl--loop-args)) @@ -1428,7 +1447,8 @@ For more details, see Info node `(cl)Loop Facility'. (set `(setq ,var (if ,var (,func ,var ,temp) ,temp)))) (push `(progn ,(if (eq temp what) set `(let ((,temp ,what)) ,set)) - t) cl--loop-body))) + t) + cl--loop-body))) ((eq word 'with) (let ((bindings nil)) @@ -1499,7 +1519,8 @@ For more details, see Info node `(cl)Loop Facility'. (or cl--loop-result-var (setq cl--loop-result-var (make-symbol "--cl-var--"))) (push `(setq ,cl--loop-result-var ,(pop cl--loop-args) - ,cl--loop-finish-flag nil) cl--loop-body)) + ,cl--loop-finish-flag nil) + cl--loop-body)) (t ;; This is an advertised interface: (info "(cl)Other Clauses"). @@ -1540,7 +1561,7 @@ If BODY is `setq', then use SPECS for assignments rather than for bindings." (if (and (cl--unused-var-p temp) (null expr)) nil ;; Don't bother declaring/setting `temp' since it won't ;; be used when `expr' is nil, anyway. - (when (or (null temp) + (when (or (null temp) (and (eq body 'setq) (cl--unused-var-p temp))) ;; Prefer a fresh uninterned symbol over "_to", to avoid ;; warnings that we set an unused variable. @@ -1786,6 +1807,8 @@ a `let' form, except that the list of symbols can be computed at run-time." (push (list (pop ,syms) (list 'quote (pop ,vals))) ,binds)) (eval (list 'let ,binds (list 'funcall (list 'quote ,bodyfun)))))))) +(defconst cl--labels-magic (make-symbol "cl--labels-magic")) + (defvar cl--labels-convert-cache nil) (defun cl--labels-convert (f) @@ -1797,10 +1820,12 @@ a `let' form, except that the list of symbols can be computed at run-time." ;; being expanded even though we don't receive it. ((eq f (car cl--labels-convert-cache)) (cdr cl--labels-convert-cache)) (t - (let ((found (assq f macroexpand-all-environment))) - (if (and found (ignore-errors - (eq (cadr (cl-caddr found)) 'cl-labels-args))) - (cadr (cl-caddr (cl-cadddr found))) + (let* ((found (assq f macroexpand-all-environment)) + (replacement (and found + (ignore-errors + (funcall (cdr found) cl--labels-magic))))) + (if (and replacement (eq cl--labels-magic (car replacement))) + (nth 1 replacement) (let ((res `(function ,f))) (setq cl--labels-convert-cache (cons f res)) res)))))) @@ -1809,25 +1834,38 @@ a `let' form, except that the list of symbols can be computed at run-time." (defmacro cl-flet (bindings &rest body) "Make local function definitions. Like `cl-labels' but the definitions are not recursive. +Each binding can take the form (FUNC EXP) where +FUNC is the function name, and EXP is an expression that returns the +function value to which it should be bound, or it can take the more common +form \(FUNC ARGLIST BODY...) which is a shorthand +for (FUNC (lambda ARGLIST BODY)). \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" (declare (indent 1) (debug ((&rest (cl-defun)) cl-declarations body))) (let ((binds ()) (newenv macroexpand-all-environment)) (dolist (binding bindings) - (let ((var (make-symbol (format "--cl-%s--" (car binding))))) - (push (list var `(cl-function (lambda . ,(cdr binding)))) binds) + (let ((var (make-symbol (format "--cl-%s--" (car binding)))) + (args-and-body (cdr binding))) + (if (and (= (length args-and-body) 1) (symbolp (car args-and-body))) + ;; Optimize (cl-flet ((fun var)) body). + (setq var (car args-and-body)) + (push (list var (if (= (length args-and-body) 1) + (car args-and-body) + `(cl-function (lambda . ,args-and-body)))) + binds)) (push (cons (car binding) - `(lambda (&rest cl-labels-args) - (cl-list* 'funcall ',var - cl-labels-args))) + (lambda (&rest args) + (if (eq (car args) cl--labels-magic) + (list cl--labels-magic var) + `(funcall ,var ,@args)))) newenv))) - `(let ,(nreverse binds) - ,@(macroexp-unprogn - (macroexpand-all - `(progn ,@body) - ;; Don't override lexical-let's macro-expander. - (if (assq 'function newenv) newenv - (cons (cons 'function #'cl--labels-convert) newenv))))))) + ;; FIXME: Eliminate those functions which aren't referenced. + (macroexp-let* (nreverse binds) + (macroexpand-all + `(progn ,@body) + ;; Don't override lexical-let's macro-expander. + (if (assq 'function newenv) newenv + (cons (cons 'function #'cl--labels-convert) newenv)))))) ;;;###autoload (defmacro cl-flet* (bindings &rest body) @@ -1854,9 +1892,10 @@ in closures will only work if `lexical-binding' is in use. (let ((var (make-symbol (format "--cl-%s--" (car binding))))) (push (list var `(cl-function (lambda . ,(cdr binding)))) binds) (push (cons (car binding) - `(lambda (&rest cl-labels-args) - (cl-list* 'funcall ',var - cl-labels-args))) + (lambda (&rest args) + (if (eq (car args) cl--labels-magic) + (list cl--labels-magic var) + (cl-list* 'funcall var args)))) newenv))) (macroexpand-all `(letrec ,(nreverse binds) ,@body) ;; Don't override lexical-let's macro-expander. @@ -1878,13 +1917,14 @@ This is like `cl-flet', but for macros instead of functions. cl-declarations body))) (if (cdr bindings) `(cl-macrolet (,(car bindings)) (cl-macrolet ,(cdr bindings) ,@body)) - (if (null bindings) (cons 'progn body) + (if (null bindings) (macroexp-progn body) (let* ((name (caar bindings)) (res (cl--transform-lambda (cdar bindings) name))) (eval (car res)) - (macroexpand-all (cons 'progn body) - (cons (cons name `(lambda ,@(cdr res))) - macroexpand-all-environment)))))) + (macroexpand-all (macroexp-progn body) + (cons (cons name + (eval `(cl-function (lambda ,@(cdr res))) t)) + macroexpand-all-environment)))))) (defconst cl--old-macroexpand (if (and (boundp 'cl--old-macroexpand) @@ -2057,10 +2097,21 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C). (declare (debug t)) (cons 'progn body)) ;;;###autoload -(defmacro cl-the (_type form) - "At present this ignores TYPE and is simply equivalent to FORM." +(defmacro cl-the (type form) + "Return FORM. If type-checking is enabled, assert that it is of TYPE." (declare (indent 1) (debug (cl-type-spec form))) - form) + (if (not (or (not (cl--compiling-file)) + (< cl--optimize-speed 3) + (= cl--optimize-safety 3))) + form + (let* ((temp (if (cl--simple-expr-p form 3) + form (make-symbol "--cl-var--"))) + (body `(progn (unless ,(cl--make-type-test temp type) + (signal 'wrong-type-argument + (list ',type ,temp ',form))) + ,temp))) + (if (eq temp form) body + `(let ((,temp ,form)) ,body))))) (defvar cl--proclaim-history t) ; for future compilers (defvar cl--declare-stack t) ; for future compilers @@ -2381,7 +2432,8 @@ non-nil value, that slot cannot be set via `setf'. pred-form pred-check) (if (stringp (car descs)) (push `(put ',name 'structure-documentation - ,(pop descs)) forms)) + ,(pop descs)) + forms)) (setq descs (cons '(cl-tag-slot) (mapcar (function (lambda (x) (if (consp x) x (list x)))) descs))) @@ -2460,6 +2512,8 @@ non-nil value, that slot cannot be set via `setf'. (setq type 'vector named 'true))) (or named (setq descs (delq (assq 'cl-tag-slot descs) descs))) (push `(defvar ,tag-symbol) forms) + (when (and (null predicate) named) + (setq predicate (intern (format "cl--struct-%s-p" name)))) (setq pred-form (and named (let ((pos (- (length descs) (length (memq (assq 'cl-tag-slot descs) @@ -2475,7 +2529,8 @@ non-nil value, that slot cannot be set via `setf'. pred-check (and pred-form (> safety 0) (if (and (eq (cl-caadr pred-form) 'vectorp) (= safety 1)) - (cons 'and (cl-cdddr pred-form)) pred-form))) + (cons 'and (cl-cdddr pred-form)) + `(,predicate cl-x)))) (let ((pos 0) (descp descs)) (while descp (let* ((desc (pop descp)) @@ -2497,7 +2552,8 @@ non-nil value, that slot cannot be set via `setf'. ',accessor ',name)))) ,(if (eq type 'vector) `(aref cl-x ,pos) (if (= pos 0) '(car cl-x) - `(nth ,pos cl-x)))) forms) + `(nth ,pos cl-x)))) + forms) (push (cons accessor t) side-eff) (if (cadr (memq :read-only (cddr desc))) (push `(gv-define-expander ,accessor @@ -2529,12 +2585,14 @@ non-nil value, that slot cannot be set via `setf'. (setq pos (1+ pos)))) (setq slots (nreverse slots) defaults (nreverse defaults)) - (and predicate pred-form - (progn (push `(cl-defsubst ,predicate (cl-x) - ,(if (eq (car pred-form) 'and) - (append pred-form '(t)) - `(and ,pred-form t))) forms) - (push (cons predicate 'error-free) side-eff))) + (when pred-form + (push `(cl-defsubst ,predicate (cl-x) + ,(if (eq (car pred-form) 'and) + (append pred-form '(t)) + `(and ,pred-form t))) + forms) + (push `(put ',name 'cl-deftype-satisfies ',predicate) forms) + (push (cons predicate 'error-free) side-eff)) (and copier (progn (push `(defun ,copier (x) (copy-sequence x)) forms) (push (cons copier t) side-eff))) @@ -2550,7 +2608,8 @@ non-nil value, that slot cannot be set via `setf'. slots defaults))) (push `(cl-defsubst ,name (&cl-defs '(nil ,@descs) ,@args) - (,type ,@make)) forms) + (,type ,@make)) + forms) (if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs))) (push (cons name t) side-eff)))) (if print-auto (nconc print-func (list '(princ ")" cl-s) t))) @@ -2572,21 +2631,38 @@ non-nil value, that slot cannot be set via `setf'. (put ',name 'cl-struct-include ',include) (put ',name 'cl-struct-print ,print-auto) ,@(mapcar (lambda (x) - `(put ',(car x) 'side-effect-free ',(cdr x))) + `(function-put ',(car x) 'side-effect-free ',(cdr x))) side-eff)) forms) `(progn ,@(nreverse (cons `',name forms))))) -;;; Types and assertions. - -;;;###autoload -(defmacro cl-deftype (name arglist &rest body) - "Define NAME as a new data type. -The type name can then be used in `cl-typecase', `cl-check-type', etc." - (declare (debug cl-defmacro) (doc-string 3) (indent 2)) - `(cl-eval-when (compile load eval) - (put ',name 'cl-deftype-handler - (cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body))))) +(defun cl-struct-sequence-type (struct-type) + "Return the sequence used to build STRUCT-TYPE. +STRUCT-TYPE is a symbol naming a struct type. Return 'vector or +'list, or nil if STRUCT-TYPE is not a struct type. " + (declare (side-effect-free t) (pure t)) + (car (get struct-type 'cl-struct-type))) + +(defun cl-struct-slot-info (struct-type) + "Return a list of slot names of struct STRUCT-TYPE. +Each entry is a list (SLOT-NAME . OPTS), where SLOT-NAME is a +slot name symbol and OPTS is a list of slot options given to +`cl-defstruct'. Dummy slots that represent the struct name and +slots skipped by :initial-offset may appear in the list." + (declare (side-effect-free t) (pure t)) + (get struct-type 'cl-struct-slots)) + +(defun cl-struct-slot-offset (struct-type slot-name) + "Return the offset of slot SLOT-NAME in STRUCT-TYPE. +The returned zero-based slot index is relative to the start of +the structure data type and is adjusted for any structure name +and :initial-offset slots. Signal error if struct STRUCT-TYPE +does not contain SLOT-NAME." + (declare (side-effect-free t) (pure t)) + (or (cl-position slot-name + (cl-struct-slot-info struct-type) + :key #'car :test #'eq) + (error "struct %s has no slot %s" struct-type slot-name))) (defvar byte-compile-function-environment) (defvar byte-compile-macro-environment) @@ -2600,46 +2676,48 @@ Of course, we really can't know that for sure, so it's just a heuristic." (cdr (assq sym byte-compile-macro-environment)))))) (defun cl--make-type-test (val type) - (if (symbolp type) - (cond ((get type 'cl-deftype-handler) - (cl--make-type-test val (funcall (get type 'cl-deftype-handler)))) - ((memq type '(nil t)) type) - ((eq type 'null) `(null ,val)) - ((eq type 'atom) `(atom ,val)) - ((eq type 'float) `(floatp ,val)) - ((eq type 'real) `(numberp ,val)) - ((eq type 'fixnum) `(integerp ,val)) - ;; FIXME: Should `character' accept things like ?\C-\M-a ? --Stef - ((memq type '(character string-char)) `(characterp ,val)) - (t - (let* ((name (symbol-name type)) - (namep (intern (concat name "p")))) - (cond - ((cl--macroexp-fboundp namep) (list namep val)) - ((cl--macroexp-fboundp - (setq namep (intern (concat name "-p")))) - (list namep val)) - (t (list type val)))))) - (cond ((get (car type) 'cl-deftype-handler) - (cl--make-type-test val (apply (get (car type) 'cl-deftype-handler) - (cdr type)))) - ((memq (car type) '(integer float real number)) - (delq t `(and ,(cl--make-type-test val (car type)) - ,(if (memq (cadr type) '(* nil)) t - (if (consp (cadr type)) `(> ,val ,(cl-caadr type)) - `(>= ,val ,(cadr type)))) - ,(if (memq (cl-caddr type) '(* nil)) t - (if (consp (cl-caddr type)) - `(< ,val ,(cl-caaddr type)) - `(<= ,val ,(cl-caddr type))))))) - ((memq (car type) '(and or not)) - (cons (car type) - (mapcar (function (lambda (x) (cl--make-type-test val x))) - (cdr type)))) - ((memq (car type) '(member cl-member)) - `(and (cl-member ,val ',(cdr type)) t)) - ((eq (car type) 'satisfies) (list (cadr type) val)) - (t (error "Bad type spec: %s" type))))) + (pcase type + ((and `(,name . ,args) (guard (get name 'cl-deftype-handler))) + (cl--make-type-test val (apply (get name 'cl-deftype-handler) + args))) + (`(,(and name (or 'integer 'float 'real 'number)) + . ,(or `(,min ,max) pcase--dontcare)) + `(and ,(cl--make-type-test val name) + ,(if (memq min '(* nil)) t + (if (consp min) `(> ,val ,(car min)) + `(>= ,val ,min))) + ,(if (memq max '(* nil)) t + (if (consp max) + `(< ,val ,(car max)) + `(<= ,val ,max))))) + (`(,(and name (or 'and 'or 'not)) . ,args) + (cons name (mapcar (lambda (x) (cl--make-type-test val x)) args))) + (`(member . ,args) + `(and (cl-member ,val ',args) t)) + (`(satisfies ,pred) `(funcall #',pred ,val)) + ((and (pred symbolp) (guard (get type 'cl-deftype-handler))) + (cl--make-type-test val (funcall (get type 'cl-deftype-handler)))) + ((and (pred symbolp) (guard (get type 'cl-deftype-satisfies))) + `(funcall #',(get type 'cl-deftype-satisfies) ,val)) + ((or 'nil 't) type) + ('null `(null ,val)) + ('atom `(atom ,val)) + ('float `(floatp ,val)) + ('real `(numberp ,val)) + ('fixnum `(integerp ,val)) + ;; FIXME: Implement `base-char' and `extended-char'. + ('character `(characterp ,val)) + ((pred symbolp) + (let* ((name (symbol-name type)) + (namep (intern (concat name "p")))) + (cond + ((cl--macroexp-fboundp namep) (list namep val)) + ((cl--macroexp-fboundp + (setq namep (intern (concat name "-p")))) + (list namep val)) + ((cl--macroexp-fboundp type) (list type val)) + (t (error "Unknown type %S" type))))) + (_ (error "Bad type spec: %s" type)))) (defvar cl--object) ;;;###autoload @@ -2714,7 +2792,12 @@ and then returning foo." (let ((p args) (res nil)) (while (consp p) (push (pop p) res)) (setq args (nconc (nreverse res) (and p (list '&rest p))))) - (let ((fname (make-symbol (concat (symbol-name func) "--cmacro")))) + ;; FIXME: The code in bytecomp mishandles top-level expressions that define + ;; uninterned functions. E.g. it would generate code like: + ;; (defalias '#1=#:foo--cmacro #[514 ...]) + ;; (put 'foo 'compiler-macro '#:foo--cmacro) + ;; So we circumvent this by using an interned name. + (let ((fname (intern (concat (symbol-name func) "--cmacro")))) `(eval-and-compile ;; Name the compiler-macro function, so that `symbol-file' can find it. (cl-defun ,fname ,(if (memq '&whole args) (delq '&whole args) @@ -2848,9 +2931,8 @@ The function's arguments should be treated as immutable. ;;;###autoload (defun cl--compiler-macro-adjoin (form a list &rest keys) (if (memq :key keys) form - (macroexp-let2 macroexp-copyable-p va a - (macroexp-let2 macroexp-copyable-p vlist list - `(if (cl-member ,va ,vlist ,@keys) ,vlist (cons ,va ,vlist)))))) + (macroexp-let2* macroexp-copyable-p ((va a) (vlist list)) + `(if (cl-member ,va ,vlist ,@keys) ,vlist (cons ,va ,vlist))))) (defun cl--compiler-macro-get (_form sym prop &optional def) (if def @@ -2873,19 +2955,47 @@ The function's arguments should be treated as immutable. ;;; Things that are inline. (cl-proclaim '(inline cl-acons cl-map cl-concatenate cl-notany - cl-notevery cl--set-elt cl-revappend cl-nreconc gethash)) + cl-notevery cl-revappend cl-nreconc gethash)) ;;; Things that are side-effect-free. -(mapc (lambda (x) (put x 'side-effect-free t)) +(mapc (lambda (x) (function-put x 'side-effect-free t)) '(cl-oddp cl-evenp cl-signum last butlast cl-ldiff cl-pairlis cl-gcd cl-lcm cl-isqrt cl-floor cl-ceiling cl-truncate cl-round cl-mod cl-rem cl-subseq cl-list-length cl-get cl-getf)) ;;; Things that are side-effect-and-error-free. -(mapc (lambda (x) (put x 'side-effect-free 'error-free)) +(mapc (lambda (x) (function-put x 'side-effect-free 'error-free)) '(eql cl-list* cl-subst cl-acons cl-equalp cl-random-state-p copy-tree cl-sublis)) +;;; Types and assertions. + +;;;###autoload +(defmacro cl-deftype (name arglist &rest body) + "Define NAME as a new data type. +The type name can then be used in `cl-typecase', `cl-check-type', etc." + (declare (debug cl-defmacro) (doc-string 3) (indent 2)) + `(cl-eval-when (compile load eval) + (put ',name 'cl-deftype-handler + (cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body))))) + +;;; Additional functions that we can now define because we've defined +;;; `cl-defsubst' and `cl-typep'. + +(cl-defsubst cl-struct-slot-value (struct-type slot-name inst) + ;; The use of `cl-defsubst' here gives us both a compiler-macro + ;; and a gv-expander "for free". + "Return the value of slot SLOT-NAME in INST of STRUCT-TYPE. +STRUCT and SLOT-NAME are symbols. INST is a structure instance." + (declare (side-effect-free t)) + (unless (cl-typep inst struct-type) + (signal 'wrong-type-argument (list struct-type inst))) + ;; We could use `elt', but since the byte compiler will resolve the + ;; branch below at compile time, it's more efficient to use the + ;; type-specific accessor. + (if (eq (cl-struct-sequence-type struct-type) 'vector) + (aref inst (cl-struct-slot-offset struct-type slot-name)) + (nth (cl-struct-slot-offset struct-type slot-name) inst))) (run-hooks 'cl-macs-load-hook) diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index 2c872f26146..5624accf66a 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -166,7 +166,7 @@ SEQ1 is destructively modified, then returned. (cl-n (min (- (or cl-end1 cl-len) cl-start1) (- (or cl-end2 cl-len) cl-start2)))) (while (>= (setq cl-n (1- cl-n)) 0) - (cl--set-elt cl-seq1 (+ cl-start1 cl-n) + (setf (elt cl-seq1 (+ cl-start1 cl-n)) (elt cl-seq2 (+ cl-start2 cl-n)))))) (if (listp cl-seq1) (let ((cl-p1 (nthcdr cl-start1 cl-seq1)) @@ -392,7 +392,7 @@ to avoid corrupting the original SEQ. cl-seq (setq cl-seq (copy-sequence cl-seq)) (or cl-from-end - (progn (cl--set-elt cl-seq cl-i cl-new) + (progn (setf (elt cl-seq cl-i) cl-new) (setq cl-i (1+ cl-i) cl-count (1- cl-count)))) (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count :start cl-i cl-keys)))))) @@ -439,7 +439,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. (setq cl-end (1- cl-end)) (if (cl--check-test cl-old (elt cl-seq cl-end)) (progn - (cl--set-elt cl-seq cl-end cl-new) + (setf (elt cl-seq cl-end) cl-new) (setq cl-count (1- cl-count))))) (while (and (< cl-start cl-end) (> cl-count 0)) (if (cl--check-test cl-old (aref cl-seq cl-start)) diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index da3eab73fc4..1b204631fb8 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -342,6 +342,8 @@ The two cases that are handled are: - renaming of F when it's a function defined via `cl-labels' or `labels'." (require 'cl-macs) (declare-function cl--expr-contains-any "cl-macs" (x y)) + (declare-function cl--labels-convert "cl-macs" (f)) + (defvar cl--labels-convert-cache) (cond ;; ¡¡Big Ugly Hack!! We can't use a compiler-macro because those are checked ;; *after* handling `function', but we want to stop macroexpansion from @@ -374,13 +376,10 @@ The two cases that are handled are: (setq cl--function-convert-cache (cons newf res)) res)))) (t - (let ((found (assq f macroexpand-all-environment))) - (if (and found (ignore-errors - (eq (cadr (cl-caddr found)) 'cl-labels-args))) - (cadr (cl-caddr (cl-cadddr found))) - (let ((res `(function ,f))) - (setq cl--function-convert-cache (cons f res)) - res)))))) + (setq cl--labels-convert-cache cl--function-convert-cache) + (prog1 + (cl--labels-convert f) + (setq cl--function-convert-cache cl--labels-convert-cache))))) (defmacro lexical-let (bindings &rest body) "Like `let', but lexically scoped. diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index a250ea60d21..52da4c99eaf 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -162,7 +162,8 @@ The new mode runs the hook constructed by the function See Info node `(elisp)Derived Modes' for more details." (declare (debug (&define name symbolp sexp [&optional stringp] [&rest keywordp sexp] def-body)) - (doc-string 4)) + (doc-string 4) + (indent 3)) (when (and docstring (not (stringp docstring))) ;; Some trickiness, since what appears to be the docstring may really be diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index f58bb076406..7e6f56518a2 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -300,7 +300,7 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. ,(format "Hook run after entering or leaving `%s'. No problems result if this variable is not bound. `add-hook' automatically binds it. (This is true for all hook variables.)" - mode)) + modefun)) ;; Define the minor-mode keymap. ,(unless (symbolp keymap) ;nil is also a symbol. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index f8defb1171b..7faa101299e 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -411,12 +411,7 @@ Return the result of the last expression in BODY." ;; read is redefined to maybe instrument forms. ;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs. -;; Save the original read function -(defalias 'edebug-original-read - (symbol-function (if (fboundp 'edebug-original-read) - 'edebug-original-read 'read))) - -(defun edebug-read (&optional stream) +(defun edebug--read (orig &optional stream) "Read one Lisp expression as text from STREAM, return as Lisp object. If STREAM is nil, use the value of `standard-input' (which see). STREAM or the value of `standard-input' may be: @@ -434,10 +429,7 @@ the option `edebug-all-forms'." (or stream (setq stream standard-input)) (if (eq stream (current-buffer)) (edebug-read-and-maybe-wrap-form) - (edebug-original-read stream))) - -(or (fboundp 'edebug-original-eval-defun) - (defalias 'edebug-original-eval-defun (symbol-function 'eval-defun))) + (funcall (or orig #'read) stream))) (defvar edebug-result) ; The result of the function call returned by body. @@ -568,16 +560,13 @@ already is one.)" (defun edebug-install-read-eval-functions () (interactive) - ;; Don't install if already installed. - (unless load-read-function - (setq load-read-function 'edebug-read) - (defalias 'eval-defun 'edebug-eval-defun))) + (add-function :around load-read-function #'edebug--read) + (advice-add 'eval-defun :override 'edebug-eval-defun)) (defun edebug-uninstall-read-eval-functions () (interactive) - (setq load-read-function nil) - (defalias 'eval-defun (symbol-function 'edebug-original-eval-defun))) - + (remove-function load-read-function #'edebug--read) + (advice-remove 'eval-defun 'edebug-eval-defun)) ;;; Edebug internal data @@ -722,8 +711,8 @@ Maybe clear the markers and delete the symbol's edebug property?" (cond ;; read goes one too far if a (possibly quoted) string or symbol ;; is immediately followed by non-whitespace. - ((eq class 'symbol) (edebug-original-read (current-buffer))) - ((eq class 'string) (edebug-original-read (current-buffer))) + ((eq class 'symbol) (read (current-buffer))) + ((eq class 'string) (read (current-buffer))) ((eq class 'quote) (forward-char 1) (list 'quote (edebug-read-sexp))) ((eq class 'backquote) @@ -731,7 +720,7 @@ Maybe clear the markers and delete the symbol's edebug property?" ((eq class 'comma) (list '\, (edebug-read-sexp))) (t ; anything else, just read it. - (edebug-original-read (current-buffer)))))) + (read (current-buffer)))))) ;;; Offsets for reader @@ -827,14 +816,11 @@ Maybe clear the markers and delete the symbol's edebug property?" (funcall (or (cdr (assq (edebug-next-token-class) edebug-read-alist)) ;; anything else, just read it. - 'edebug-original-read) + #'read) stream)))) -(defun edebug-read-symbol (stream) - (edebug-original-read stream)) - -(defun edebug-read-string (stream) - (edebug-original-read stream)) +(defalias 'edebug-read-symbol #'read) +(defalias 'edebug-read-string #'read) (defun edebug-read-quote (stream) ;; Turn 'thing into (quote thing) @@ -878,7 +864,7 @@ Maybe clear the markers and delete the symbol's edebug property?" ((memq (following-char) '(?: ?B ?O ?X ?b ?o ?x ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?0)) (backward-char 1) - (edebug-original-read stream)) + (read stream)) (t (edebug-syntax-error "Bad char after #")))) (defun edebug-read-list (stream) @@ -1049,16 +1035,15 @@ Maybe clear the markers and delete the symbol's edebug property?" edebug-gate edebug-best-error edebug-error-point - no-match ;; Do this once here instead of several times. (max-lisp-eval-depth (+ 800 max-lisp-eval-depth)) (max-specpdl-size (+ 2000 max-specpdl-size))) - (setq no-match - (catch 'no-match - (setq result (edebug-read-and-maybe-wrap-form1)) - nil)) - (if no-match - (apply 'edebug-syntax-error no-match)) + (let ((no-match + (catch 'no-match + (setq result (edebug-read-and-maybe-wrap-form1)) + nil))) + (if no-match + (apply 'edebug-syntax-error no-match))) result)) @@ -1077,7 +1062,7 @@ Maybe clear the markers and delete the symbol's edebug property?" (if (and (eq 'lparen (edebug-next-token-class)) (eq 'symbol (progn (forward-char 1) (edebug-next-token-class)))) ;; Find out if this is a defining form from first symbol - (setq def-kind (edebug-original-read (current-buffer)) + (setq def-kind (read (current-buffer)) spec (and (symbolp def-kind) (get-edebug-spec def-kind)) defining-form-p (and (listp spec) (eq '&define (car spec))) @@ -1085,7 +1070,7 @@ Maybe clear the markers and delete the symbol's edebug property?" def-name (if (and defining-form-p (eq 'name (car (cdr spec))) (eq 'symbol (edebug-next-token-class))) - (edebug-original-read (current-buffer)))))) + (read (current-buffer)))))) ;;;(message "all defs: %s all forms: %s" edebug-all-defs edebug-all-forms) (cond (defining-form-p @@ -3210,7 +3195,7 @@ function or macro is called, Edebug will be called there as well." (if (looking-at "\(") (edebug--form-data-name (edebug-get-form-data-entry (point))) - (edebug-original-read (current-buffer)))))) + (read (current-buffer)))))) (edebug-instrument-function func)))) @@ -3238,25 +3223,14 @@ canceled the first time the function is entered." (put function 'edebug-on-entry nil)) -(if (not (fboundp 'edebug-original-debug-on-entry)) - (fset 'edebug-original-debug-on-entry (symbol-function 'debug-on-entry))) -'(fset 'debug-on-entry 'edebug-debug-on-entry) ;; Should we do this? +'(advice-add 'debug-on-entry :around 'edebug--debug-on-entry) ;; Should we do this? ;; Also need edebug-cancel-debug-on-entry -'(defun edebug-debug-on-entry (function) - "Request FUNCTION to invoke debugger each time it is called. -If the user continues, FUNCTION's execution proceeds. -Works by modifying the definition of FUNCTION, -which must be written in Lisp, not predefined. -Use `cancel-debug-on-entry' to cancel the effect of this command. -Redefining FUNCTION also does that. - -This version is from Edebug. If the function is instrumented for -Edebug, it calls `edebug-on-entry'." - (interactive "aDebug on entry (to function): ") +'(defun edebug--debug-on-entry (orig function) + "If the function is instrumented for Edebug, call `edebug-on-entry'." (let ((func-data (get function 'edebug))) (if (or (null func-data) (markerp func-data)) - (edebug-original-debug-on-entry function) + (funcall orig function) (edebug-on-entry function)))) @@ -3400,9 +3374,7 @@ Return the result of the last expression." (print-level (or edebug-print-level print-level)) (print-circle (or edebug-print-circle print-circle)) (print-readably nil)) ; lemacs uses this. - (condition-case nil - (edebug-prin1-to-string value) - (error "#Apparently circular structure#")))) + (edebug-prin1-to-string value))) (defun edebug-compute-previous-result (previous-value) (if edebug-unwrap-results @@ -4137,9 +4109,8 @@ With prefix argument, make it a temporary breakpoint." 'edebug--called-interactively-skip) (remove-hook 'cl-read-load-hooks 'edebug--require-cl-read) (edebug-uninstall-read-eval-functions) - ;; continue standard unloading + ;; Continue standard unloading. nil) (provide 'edebug) - ;;; edebug.el ends here diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index 4cbec768d8b..feb06711cb3 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -1,4 +1,4 @@ -;;; eieio-base.el --- Base classes for EIEIO. +;;; eieio-base.el --- Base classes for EIEIO. -*- lexical-binding:t -*- ;;; Copyright (C) 2000-2002, 2004-2005, 2007-2015 Free Software ;;; Foundation, Inc. @@ -31,7 +31,7 @@ ;;; Code: (require 'eieio) -(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib! +(eval-when-compile (require 'cl-lib)) ;;; eieio-instance-inheritor ;; @@ -40,7 +40,7 @@ ;; error if a slot is unbound. (defclass eieio-instance-inheritor () ((parent-instance :initarg :parent-instance - :type eieio-instance-inheritor-child + :type eieio-instance-inheritor :documentation "The parent of this instance. If a slot of this class is referenced, and is unbound, then the parent @@ -52,7 +52,8 @@ a parent instance. When a slot in the child is referenced, and has not been set, use values from the parent." :abstract t) -(defmethod slot-unbound ((object eieio-instance-inheritor) class slot-name fn) +(cl-defmethod slot-unbound ((object eieio-instance-inheritor) + _class slot-name _fn) "If a slot OBJECT in this CLASS is unbound, try to inherit, or throw a signal. SLOT-NAME is the offending slot. FN is the function signaling the error." (if (slot-boundp object 'parent-instance) @@ -60,31 +61,16 @@ SLOT-NAME is the offending slot. FN is the function signaling the error." ;; method if the parent instance's slot is unbound. (eieio-oref (oref object parent-instance) slot-name) ;; Throw the regular signal. - (call-next-method))) + (cl-call-next-method))) -(defmethod clone ((obj eieio-instance-inheritor) &rest params) +(cl-defmethod clone ((obj eieio-instance-inheritor) &rest _params) "Clone OBJ, initializing `:parent' to OBJ. All slots are unbound, except those initialized with PARAMS." - (let ((nobj (make-vector (length obj) eieio-unbound)) - (nm (eieio--object-name obj)) - (passname (and params (stringp (car params)))) - (num 1)) - (aset nobj 0 'object) - (setf (eieio--object-class nobj) (eieio--object-class obj)) - ;; The following was copied from the default clone. - (if (not passname) - (save-match-data - (if (string-match "-\\([0-9]+\\)" nm) - (setq num (1+ (string-to-number (match-string 1 nm))) - nm (substring nm 0 (match-beginning 0)))) - (setf (eieio--object-name nobj) (concat nm "-" (int-to-string num)))) - (setf (eieio--object-name nobj) (car params))) - ;; Now initialize from params. - (if params (shared-initialize nobj (if passname (cdr params) params))) + (let ((nobj (cl-call-next-method))) (oset nobj parent-instance obj) nobj)) -(defmethod eieio-instance-inheritor-slot-boundp ((object eieio-instance-inheritor) +(cl-defmethod eieio-instance-inheritor-slot-boundp ((object eieio-instance-inheritor) slot) "Return non-nil if the instance inheritor OBJECT's SLOT is bound. See `slot-boundp' for details on binding slots. @@ -117,8 +103,8 @@ Inheritors from this class must overload `tracking-symbol' which is a variable symbol used to store a list of all instances." :abstract t) -(defmethod initialize-instance :AFTER ((this eieio-instance-tracker) - &rest slots) +(cl-defmethod initialize-instance :after ((this eieio-instance-tracker) + &rest _slots) "Make sure THIS is in our master list of this class. Optional argument SLOTS are the initialization arguments." ;; Theoretically, this is never called twice for a given instance. @@ -126,7 +112,7 @@ Optional argument SLOTS are the initialization arguments." (if (not (memq this (symbol-value sym))) (set sym (append (symbol-value sym) (list this)))))) -(defmethod delete-instance ((this eieio-instance-tracker)) +(cl-defmethod delete-instance ((this eieio-instance-tracker)) "Remove THIS from the master list of this class." (set (oref this tracking-symbol) (delq this (symbol-value (oref this tracking-symbol))))) @@ -154,7 +140,7 @@ Multiple calls to `make-instance' will return this object.")) A singleton is a class which will only ever have one instance." :abstract t) -(defmethod constructor :STATIC ((class eieio-singleton) name &rest slots) +(cl-defmethod eieio-constructor ((class (subclass eieio-singleton)) &rest _slots) "Constructor for singleton CLASS. NAME and SLOTS initialize the new object. This constructor guarantees that no matter how many you request, @@ -163,7 +149,7 @@ only one object ever exists." ;; with class allocated slots or default values. (let ((old (oref-default class singleton))) (if (eq old eieio-unbound) - (oset-default class singleton (call-next-method)) + (oset-default class singleton (cl-call-next-method)) old))) @@ -212,7 +198,7 @@ object. For this reason, only slots which do not have an `:initarg' specified will not be saved." :abstract t) -(defmethod eieio-persistent-save-interactive ((this eieio-persistent) prompt +(cl-defmethod eieio-persistent-save-interactive ((this eieio-persistent) prompt &optional name) "Prepare to save THIS. Use in an `interactive' statement. Query user for file name with PROMPT if THIS does not yet specify @@ -269,7 +255,7 @@ malicious code. Note: This function recurses when a slot of :type of some object is identified, and needing more object creation." (let ((objclass (nth 0 inputlist)) - (objname (nth 1 inputlist)) + ;; (objname (nth 1 inputlist)) (slots (nthcdr 2 inputlist)) (createslots nil)) @@ -284,7 +270,7 @@ identified, and needing more object creation." ;; In addition, strip out quotes, list functions, and update ;; object constructors as needed. (setq value (eieio-persistent-validate/fix-slot-value - objclass name value)) + (eieio--class-v objclass) name value)) (push name createslots) (push value createslots) @@ -292,7 +278,7 @@ identified, and needing more object creation." (setq slots (cdr (cdr slots)))) - (apply 'make-instance objclass objname (nreverse createslots)) + (apply #'make-instance objclass (nreverse createslots)) ;;(eval inputlist) )) @@ -304,11 +290,13 @@ constructor functions are considered valid. Second, any text properties will be stripped from strings." (cond ((consp proposed-value) ;; Lists with something in them need special treatment. - (let ((slot-idx (eieio-slot-name-index class nil slot)) + (let ((slot-idx (eieio--slot-name-index class + nil slot)) (type nil) (classtype nil)) - (setq slot-idx (- slot-idx 3)) - (setq type (aref (eieio--class-public-type (class-v class)) + (setq slot-idx (- slot-idx + (eval-when-compile eieio--object-num-slots))) + (setq type (aref (eieio--class-public-type class) slot-idx)) (setq classtype (eieio-persistent-slot-type-is-class-p @@ -345,8 +333,8 @@ Second, any text properties will be stripped from strings." (unless (and ;; Do we have a type? (consp classtype) (class-p (car classtype))) - (error "In save file, list of object constructors found, but no :type specified for slot %S" - slot)) + (error "In save file, list of object constructors found, but no :type specified for slot %S of type %S" + slot classtype)) ;; We have a predicate, but it doesn't satisfy the predicate? (dolist (PV (cdr proposed-value)) @@ -374,31 +362,49 @@ Second, any text properties will be stripped from strings." ) (defun eieio-persistent-slot-type-is-class-p (type) - "Return the class refered to in TYPE. + "Return the class referred to in TYPE. If no class is referenced there, then return nil." (cond ((class-p type) ;; If the type is a class, then return it. type) - - ((and (symbolp type) (string-match "-child$" (symbol-name type)) + ((and (eq 'list-of (car-safe type)) (class-p (cadr type))) + ;; If it is the type of a list of a class, then return that class and + ;; the type. + (cons (cadr type) type)) + + ((and (symbolp type) (get type 'cl-deftype-handler)) + ;; Macro-expand the type according to cl-deftype definitions. + (eieio-persistent-slot-type-is-class-p + (funcall (get type 'cl-deftype-handler)))) + + ;; FIXME: foo-child should not be a valid type! + ((and (symbolp type) (string-match "-child\\'" (symbol-name type)) (class-p (intern-soft (substring (symbol-name type) 0 (match-beginning 0))))) + (unless eieio-backward-compatibility + (error "Use of bogus %S type instead of %S" + type (intern-soft (substring (symbol-name type) 0 + (match-beginning 0))))) ;; If it is the predicate ending with -child, then return ;; that class. Unfortunately, in EIEIO, typep of just the ;; class is the same as if we used -child, so no further work needed. (intern-soft (substring (symbol-name type) 0 (match-beginning 0)))) - - ((and (symbolp type) (string-match "-list$" (symbol-name type)) + ;; FIXME: foo-list should not be a valid type! + ((and (symbolp type) (string-match "-list\\'" (symbol-name type)) (class-p (intern-soft (substring (symbol-name type) 0 (match-beginning 0))))) + (unless eieio-backward-compatibility + (error "Use of bogus %S type instead of (list-of %S)" + type (intern-soft (substring (symbol-name type) 0 + (match-beginning 0))))) ;; If it is the predicate ending with -list, then return ;; that class and the predicate to use. (cons (intern-soft (substring (symbol-name type) 0 (match-beginning 0))) type)) - ((and (consp type) (eq (car type) 'or)) + ((eq (car-safe type) 'or) ;; If type is a list, and is an or, it is possibly something ;; like (or null myclass), so check for that. (let ((ans nil)) @@ -411,17 +417,17 @@ If no class is referenced there, then return nil." ;; No match, not a class. nil))) -(defmethod object-write ((this eieio-persistent) &optional comment) +(cl-defmethod object-write ((this eieio-persistent) &optional comment) "Write persistent object THIS out to the current stream. Optional argument COMMENT is a header line comment." - (call-next-method this (or comment (oref this file-header-line)))) + (cl-call-next-method this (or comment (oref this file-header-line)))) -(defmethod eieio-persistent-path-relative ((this eieio-persistent) file) +(cl-defmethod eieio-persistent-path-relative ((this eieio-persistent) file) "For object THIS, make absolute file name FILE relative." (file-relative-name (expand-file-name file) (file-name-directory (oref this file)))) -(defmethod eieio-persistent-save ((this eieio-persistent) &optional file) +(cl-defmethod eieio-persistent-save ((this eieio-persistent) &optional file) "Save persistent object THIS to disk. Optional argument FILE overrides the file name specified in the object instance." @@ -462,34 +468,38 @@ instance." ;;; Named object -;; -;; Named objects use the objects `name' as a slot, and that slot -;; is accessed with the `object-name' symbol. (defclass eieio-named () - () - "Object with a name. -Name storage already occurs in an object. This object provides get/set -access to it." + ((object-name :initarg :object-name :initform nil)) + "Object with a name." :abstract t) -(defmethod slot-missing ((obj eieio-named) - slot-name operation &optional new-value) - "Called when a non-existent slot is accessed. -For variable `eieio-named', provide an imaginary `object-name' slot. -Argument OBJ is the named object. -Argument SLOT-NAME is the slot that was attempted to be accessed. -OPERATION is the type of access, such as `oref' or `oset'. -NEW-VALUE is the value that was being set into SLOT if OPERATION were -a set type." - (if (memq slot-name '(object-name :object-name)) - (cond ((eq operation 'oset) - (if (not (stringp new-value)) - (signal 'invalid-slot-type - (list obj slot-name 'string new-value))) - (eieio-object-set-name-string obj new-value)) - (t (eieio-object-name-string obj))) - (call-next-method))) +(cl-defmethod eieio-object-name-string ((obj eieio-named)) + "Return a string which is OBJ's name." + (or (slot-value obj 'object-name) + (symbol-name (eieio-object-class obj)))) + +(cl-defmethod eieio-object-set-name-string ((obj eieio-named) name) + "Set the string which is OBJ's NAME." + (eieio--check-type stringp name) + (eieio-oset obj 'object-name name)) + +(cl-defmethod clone ((obj eieio-named) &rest params) + "Clone OBJ, initializing `:parent' to OBJ. +All slots are unbound, except those initialized with PARAMS." + (let* ((newname (and (stringp (car params)) (pop params))) + (nobj (apply #'cl-call-next-method obj params)) + (nm (slot-value obj 'object-name))) + (eieio-oset obj 'object-name + (or newname + (save-match-data + (if (and nm (string-match "-\\([0-9]+\\)" nm)) + (let ((num (1+ (string-to-number + (match-string 1 nm))))) + (concat (substring nm 0 (match-beginning 0)) + "-" (int-to-string num))) + (concat nm "-1"))))) + nobj)) (provide 'eieio-base) diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el new file mode 100644 index 00000000000..fcca99d79d5 --- /dev/null +++ b/lisp/emacs-lisp/eieio-compat.el @@ -0,0 +1,264 @@ +;;; eieio-compat.el --- Compatibility with Older EIEIO versions -*- lexical-binding:t -*- + +;; Copyright (C) 1995-1996, 1998-2015 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: OO, lisp + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Backward compatibility definition of old EIEIO functions in +;; terms of newer equivalent. + +;; The main elements are the old EIEIO `defmethod' and `defgeneric' which are +;; now implemented on top of cl-generic. The differences we have to +;; accommodate are: +;; - EIEIO's :static methods (turned into a new `eieio--static' specializer). +;; - EIEIO's support for `call-next-method' and `next-method-p' instead of +;; `cl-next-method-p' and `cl-call-next-method' (simple matter of renaming). +;; - Different errors are signaled. +;; - EIEIO's defgeneric does not reset the function. +;; - EIEIO's no-next-method and no-applicable-method can't be aliases of +;; cl-generic's namesakes since they have different calling conventions, +;; which means that packages that (defmethod no-next-method ..) don't work. +;; - EIEIO's `call-next-method' and `next-method-p' had dynamic scope whereas +;; cl-generic's `cl-next-method-p' and `cl-call-next-method' are lexically +;; scoped. + +;;; Code: + +(require 'eieio-core) +(require 'cl-generic) + +(put 'eieio--defalias 'byte-hunk-handler + #'byte-compile-file-form-defalias) ;;(get 'defalias 'byte-hunk-handler) +;;;###autoload +(defun eieio--defalias (name body) + "Like `defalias', but with less side-effects. +More specifically, it has no side-effects at all when the new function +definition is the same (`eq') as the old one." + (cl-assert (not (symbolp body))) + (while (and (fboundp name) (symbolp (symbol-function name))) + ;; Follow aliases, so methods applied to obsolete aliases still work. + (setq name (symbol-function name))) + (unless (and (fboundp name) + (eq (symbol-function name) body)) + (defalias name body))) + +;;;###autoload +(defmacro defgeneric (method args &optional doc-string) + "Create a generic function METHOD. +DOC-STRING is the base documentation for this class. A generic +function has no body, as its purpose is to decide which method body +is appropriate to use. Uses `defmethod' to create methods, and calls +`defgeneric' for you. With this implementation the ARGS are +currently ignored. You can use `defgeneric' to apply specialized +top level documentation to a method." + (declare (doc-string 3) (obsolete cl-defgeneric "25.1")) + `(eieio--defalias ',method + (eieio--defgeneric-init-form + ',method + ,(if doc-string (help-add-fundoc-usage doc-string args))))) + +;;;###autoload +(defmacro defmethod (method &rest args) + "Create a new METHOD through `defgeneric' with ARGS. + +The optional second argument KEY is a specifier that +modifies how the method is called, including: + :before - Method will be called before the :primary + :primary - The default if not specified + :after - Method will be called after the :primary + :static - First arg could be an object or class +The next argument is the ARGLIST. The ARGLIST specifies the arguments +to the method as with `defun'. The first argument can have a type +specifier, such as: + ((VARNAME CLASS) ARG2 ...) +where VARNAME is the name of the local variable for the method being +created. The CLASS is a class symbol for a class made with `defclass'. +A DOCSTRING comes after the ARGLIST, and is optional. +All the rest of the args are the BODY of the method. A method will +return the value of the last form in the BODY. + +Summary: + + (defmethod mymethod [:before | :primary | :after | :static] + ((typearg class-name) arg2 &optional opt &rest rest) + \"doc-string\" + body)" + (declare (doc-string 3) (obsolete cl-defmethod "25.1") + (debug + (&define ; this means we are defining something + [&or name ("setf" :name setf name)] + ;; ^^ This is the methods symbol + [ &optional symbolp ] ; this is key :before etc + list ; arguments + [ &optional stringp ] ; documentation string + def-body ; part to be debugged + ))) + (let* ((key (if (keywordp (car args)) (pop args))) + (params (car args)) + (arg1 (car params)) + (fargs (if (consp arg1) + (cons (car arg1) (cdr params)) + params)) + (class (if (consp arg1) (nth 1 arg1))) + (code `(lambda ,fargs ,@(cdr args)))) + `(progn + ;; Make sure there is a generic and the byte-compiler sees it. + (defgeneric ,method ,args) + (eieio--defmethod ',method ',key ',class #',code)))) + +(add-function :before-until cl-generic-tagcode-function + #'eieio--generic-static-tagcode) +(defun eieio--generic-static-tagcode (type name) + (and (eq 'eieio--static (car-safe type)) + `(40 . (cond + ((symbolp ,name) (eieio--class-v ,name)) + ((vectorp ,name) (aref ,name 0)))))) + +(add-function :around cl-generic-tag-types-function + #'eieio--generic-static-tag-types) +(defun eieio--generic-static-tag-types (orig-fun tag) + (cond + ((or (eieio--class-p tag) + (and (symbolp tag) (boundp tag) (eieio--class-p (symbol-value tag)))) + (let ((superclasses (funcall orig-fun tag)) + (types ())) + ;; Interleave: (subclass <foo>) (eieio--static <foo>) <subclass <bar>) .. + (dolist (superclass superclasses) + (push superclass types) + (push `(eieio--static + ,(if (consp superclass) (cadr superclass) superclass)) + types)) + (nreverse types))) + (t (funcall orig-fun tag)))) + +;;;###autoload +(defun eieio--defgeneric-init-form (method doc-string) + (if doc-string (put method 'function-documentation doc-string)) + (if (memq method '(no-next-method no-applicable-method)) + (symbol-function method) + (let ((generic (cl-generic-ensure-function method))) + (symbol-function (cl--generic-name generic))))) + +;;;###autoload +(defun eieio--defmethod (method kind argclass code) + (setq kind (intern (downcase (symbol-name kind)))) + (let* ((specializer (if (not (eq kind :static)) + (or argclass t) + (setq kind nil) + `(eieio--static ,argclass))) + (uses-cnm (not (memq kind '(:before :after)))) + (specializers `((arg ,specializer))) + (code + ;; Backward compatibility for `no-next-method' and + ;; `no-applicable-method', which have slightly different calling + ;; convention than their cl-generic counterpart. + (pcase method + (`no-next-method + (setq method 'cl-no-next-method) + (setq specializers `(generic method ,@specializers)) + (lambda (_generic _method &rest args) (apply code args))) + (`no-applicable-method + (setq method 'cl-no-applicable-method) + (setq specializers `(generic ,@specializers)) + (lambda (generic arg &rest args) (apply code arg generic args))) + (_ code)))) + (cl-generic-define-method + method (unless (memq kind '(nil :primary)) (list kind)) + specializers uses-cnm + (if uses-cnm + (let* ((docstring (documentation code 'raw)) + (args (help-function-arglist code 'preserve-names)) + (doc-only (if docstring + (let ((split (help-split-fundoc docstring nil))) + (if split (cdr split) docstring)))) + (new-docstring (help-add-fundoc-usage doc-only + (cons 'cl-cnm args)))) + ;; FIXME: ¡Add new-docstring to those closures! + (lambda (cnm &rest args) + (cl-letf (((symbol-function 'call-next-method) cnm) + ((symbol-function 'next-method-p) + (lambda () (cl--generic-isnot-nnm-p cnm)))) + (apply code args)))) + code)) + ;; The old EIEIO code did not signal an error when there are methods + ;; applicable but only of the before/after kind. So if we add a :before + ;; or :after, make sure there's a matching dummy primary. + (when (and (memq kind '(:before :after)) + ;; FIXME: Use `cl-find-method'? + (not (cl-find-method method () + (mapcar (lambda (arg) + (if (consp arg) (nth 1 arg) t)) + specializers)))) + (cl-generic-define-method method () specializers t + (lambda (cnm &rest args) + (if (cl--generic-isnot-nnm-p cnm) + (apply cnm args))))) + method)) + +;; Compatibility with code which tries to catch `no-method-definition' errors. +(push 'no-method-definition (get 'cl-no-applicable-method 'error-conditions)) + +(defun generic-p (fname) (not (null (cl--generic fname)))) + +(defun no-next-method (&rest args) + (declare (obsolete cl-no-next-method "25.1")) + (apply #'cl-no-next-method 'unknown nil args)) + +(defun no-applicable-method (object method &rest args) + (declare (obsolete cl-no-applicable-method "25.1")) + (apply #'cl-no-applicable-method method object args)) + +(define-obsolete-function-alias 'call-next-method 'cl-call-next-method "25.1") +(defun next-method-p () + (declare (obsolete cl-next-method-p "25.1")) + ;; EIEIO's `next-method-p' just returned nil when called in an + ;; invalid context. + (message "next-method-p called outside of a primary or around method") + nil) + +;;;###autoload +(defun eieio-defmethod (method args) + "Obsolete work part of an old version of the `defmethod' macro." + (declare (obsolete cl-defmethod "24.1")) + (eval `(defmethod ,method ,@args)) + method) + +;;;###autoload +(defun eieio-defgeneric (method doc-string) + "Obsolete work part of an old version of the `defgeneric' macro." + (declare (obsolete cl-defgeneric "24.1")) + (eval `(defgeneric ,method (x) ,@(if doc-string `(,doc-string)))) + ;; Return the method + 'method) + +;;;###autoload +(defun eieio-defclass (cname superclasses slots options) + (declare (obsolete eieio-defclass-internal "25.1")) + (eval `(defclass ,cname ,superclasses ,slots ,@options))) + + +;; Local Variables: +;; generated-autoload-file: "eieio-core.el" +;; End: + +(provide 'eieio-compat) + +;;; eieio-compat.el ends here diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index cf430d32dd9..7492f0522ab 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -1,4 +1,4 @@ -;;; eieio-core.el --- Core implementation for eieio +;;; eieio-core.el --- Core implementation for eieio -*- lexical-binding:t -*- ;; Copyright (C) 1995-1996, 1998-2015 Free Software Foundation, Inc. @@ -31,31 +31,8 @@ ;;; Code: -(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib! - -;; Compatibility -(if (fboundp 'compiled-function-arglist) - - ;; XEmacs can only access a compiled functions arglist like this: - (defalias 'eieio-compiled-function-arglist 'compiled-function-arglist) - - ;; Emacs doesn't have this function, but since FUNC is a vector, we can just - ;; grab the appropriate element. - (defun eieio-compiled-function-arglist (func) - "Return the argument list for the compiled function FUNC." - (aref func 0)) - - ) - -(put 'eieio--defalias 'byte-hunk-handler - #'byte-compile-file-form-defalias) ;;(get 'defalias 'byte-hunk-handler) -(defun eieio--defalias (name body) - "Like `defalias', but with less side-effects. -More specifically, it has no side-effects at all when the new function -definition is the same (`eq') as the old one." - (unless (and (fboundp name) - (eq (symbol-function name) body)) - (defalias name body))) +(require 'cl-lib) +(require 'pcase) ;;; ;; A few functions that are better in the official EIEIO src, but @@ -85,8 +62,12 @@ default setting for optimization purposes.") (defvar eieio-optimize-primary-methods-flag t "Non-nil means to optimize the method dispatch on primary methods.") -(defvar eieio-initializing-object nil - "Set to non-nil while initializing an object.") +(defvar eieio-backward-compatibility t + "If nil, drop support for some behaviors of older versions of EIEIO. +Currently under control of this var: +- Define every class as a var whose value is the class symbol. +- Define <class>-child-p and <class>-list-p predicates. +- Allow object names in constructors.") (defconst eieio-unbound (if (and (boundp 'eieio-unbound) (symbolp eieio-unbound)) @@ -98,110 +79,78 @@ default setting for optimization purposes.") ;; while it is being built itself. (defvar eieio-default-superclass nil) -;;; -;; Class currently in scope. -;; -;; When invoking methods, the running method needs to know which class -;; is currently in scope. Generally this is the class of the method -;; being called, but 'call-next-method' needs to query this state, -;; and change it to be then next super class up. -;; -;; Thus, the scoped class is a stack that needs to be managed. +(progn + ;; Arrange for field access not to bother checking if the access is indeed + ;; made to an eieio--class object. + (cl-declaim (optimize (safety 0))) +(cl-defstruct (eieio--class + (:constructor nil) + (:constructor eieio--class-make (symbol &aux (tag 'defclass))) + (:type vector) + (:copier nil)) + ;; We use an untagged cl-struct, with our own hand-made tag as first field + ;; (containing the symbol `defclass'). It would be better to use a normal + ;; cl-struct with its normal tag (e.g. so that cl-defstruct can define the + ;; predicate for us), but that breaks compatibility with .elc files compiled + ;; against older versions of EIEIO. + tag + symbol ;; symbol (self-referencing) + parent children + symbol-hashtable ;; hashtable permitting fast access to variable position indexes + ;; @todo + ;; the word "public" here is leftovers from the very first version. + ;; Get rid of it! + public-a ;; class attribute index + public-d ;; class attribute defaults index + public-doc ;; class documentation strings for attributes + public-type ;; class type for a slot + public-custom ;; class custom type for a slot + public-custom-label ;; class custom group for a slot + public-custom-group ;; class custom group for a slot + public-printer ;; printer for a slot + protection ;; protection for a slot + initarg-tuples ;; initarg tuples list + class-allocation-a ;; class allocated attributes + class-allocation-doc ;; class allocated documentation + class-allocation-type ;; class allocated value type + class-allocation-custom ;; class allocated custom descriptor + class-allocation-custom-label ;; class allocated custom descriptor + class-allocation-custom-group ;; class allocated custom group + class-allocation-printer ;; class allocated printer for a slot + class-allocation-protection ;; class allocated protection list + class-allocation-values ;; class allocated value vector + default-object-cache ;; what a newly created object would look like. + ; This will speed up instantiation time as + ; only a `copy-sequence' will be needed, instead of + ; looping over all the values and setting them from + ; the default. + options ;; storage location of tagged class option + ; Stored outright without modifications or stripping + ) + ;; Set it back to the default value. + (cl-declaim (optimize (safety 1)))) -(defvar eieio--scoped-class-stack nil - "A stack of the classes currently in scope during method invocation.") -(defun eieio--scoped-class () - "Return the class currently in scope, or nil." - (car-safe eieio--scoped-class-stack)) +(cl-defstruct (eieio--object + (:type vector) ;We manage our own tagging system. + (:constructor nil) + (:copier nil)) + ;; `class-tag' holds a symbol, which is not the class name, but is instead + ;; properly prefixed as an internal EIEIO thingy and which holds the class + ;; object/struct in its `symbol-value' slot. + class-tag) -(defmacro eieio--with-scoped-class (class &rest forms) - "Set CLASS as the currently scoped class while executing FORMS." - `(unwind-protect - (progn - (push ,class eieio--scoped-class-stack) - ,@forms) - (pop eieio--scoped-class-stack))) -(put 'eieio--with-scoped-class 'lisp-indent-function 1) +(eval-and-compile + (defconst eieio--object-num-slots + (length (get 'eieio--object 'cl-struct-slots)))) -;;; -;; Field Accessors -;; -(defmacro eieio--define-field-accessors (prefix fields) - (declare (indent 1)) - (let ((index 0) - (defs '())) - (dolist (field fields) - (let ((doc (if (listp field) - (prog1 (cadr field) (setq field (car field)))))) - (push `(defmacro ,(intern (format "eieio--%s-%s" prefix field)) (x) - ,@(if doc (list (format (if (string-match "\n" doc) - "Return %s" "Return %s of a %s.") - doc prefix))) - (list 'aref x ,index)) - defs) - (setq index (1+ index)))) - `(eval-and-compile - ,@(nreverse defs) - (defconst ,(intern (format "eieio--%s-num-slots" prefix)) ,index)))) - -(eieio--define-field-accessors class - (-unused-0 ;;FIXME: not sure, but at least there was no accessor! - (symbol "symbol (self-referencing)") - parent children - (symbol-obarray "obarray permitting fast access to variable position indexes") - ;; @todo - ;; the word "public" here is leftovers from the very first version. - ;; Get rid of it! - (public-a "class attribute index") - (public-d "class attribute defaults index") - (public-doc "class documentation strings for attributes") - (public-type "class type for a slot") - (public-custom "class custom type for a slot") - (public-custom-label "class custom group for a slot") - (public-custom-group "class custom group for a slot") - (public-printer "printer for a slot") - (protection "protection for a slot") - (initarg-tuples "initarg tuples list") - (class-allocation-a "class allocated attributes") - (class-allocation-doc "class allocated documentation") - (class-allocation-type "class allocated value type") - (class-allocation-custom "class allocated custom descriptor") - (class-allocation-custom-label "class allocated custom descriptor") - (class-allocation-custom-group "class allocated custom group") - (class-allocation-printer "class allocated printer for a slot") - (class-allocation-protection "class allocated protection list") - (class-allocation-values "class allocated value vector") - (default-object-cache "what a newly created object would look like. -This will speed up instantiation time as only a `copy-sequence' will -be needed, instead of looping over all the values and setting them -from the default.") - (options "storage location of tagged class options. -Stored outright without modifications or stripping."))) - -(eieio--define-field-accessors object - (-unused-0 ;;FIXME: not sure, but at least there was no accessor! - (class "class struct defining OBJ") - name)) - -;; FIXME: The constants below should have an `eieio-' prefix added!! - -(defconst method-static 0 "Index into :static tag on a method.") -(defconst method-before 1 "Index into :before tag on a method.") -(defconst method-primary 2 "Index into :primary tag on a method.") -(defconst method-after 3 "Index into :after tag on a method.") -(defconst method-num-lists 4 "Number of indexes into methods vector in which groups of functions are kept.") -(defconst method-generic-before 4 "Index into generic :before tag on a method.") -(defconst method-generic-primary 5 "Index into generic :primary tag on a method.") -(defconst method-generic-after 6 "Index into generic :after tag on a method.") -(defconst method-num-slots 7 "Number of indexes into a method's vector.") - -(defsubst eieio-specialized-key-to-generic-key (key) - "Convert a specialized KEY into a generic method key." - (cond ((eq key method-static) 0) ;; don't convert - ((< key method-num-lists) (+ key 3)) ;; The conversion - (t key) ;; already generic.. maybe. - )) +(defsubst eieio--object-class-object (obj) + (symbol-value (eieio--object-class-tag obj))) + +(defsubst eieio--object-class-name (obj) + ;; FIXME: Most uses of this function should be changed to use + ;; eieio--object-class-object instead! + (eieio--class-symbol (eieio--object-class-object obj))) ;;; Important macros used internally in eieio. @@ -215,120 +164,94 @@ Stored outright without modifications or stripping."))) (t `(,type ,obj)))) (signal 'wrong-type-argument (list ',type ,obj)))) -(defmacro class-v (class) +(defmacro eieio--class-v (class) ;Use a macro, so it acts as a GV place. "Internal: Return the class vector from the CLASS symbol." + (declare (debug t)) ;; No check: If eieio gets this far, it has probably been checked already. `(get ,class 'eieio-class-definition)) -(defmacro class-p (class) - "Return t if CLASS is a valid class vector. -CLASS is a symbol." +(defsubst eieio--class-object (class) + "Return the class object." + (if (symbolp class) + ;; Keep the symbol if class-v is nil, for better error messages. + (or (eieio--class-v class) class) + class)) + +(defsubst eieio--class-p (class) + "Return non-nil if CLASS is a valid class object." + (condition-case nil + (eq (aref class 0) 'defclass) + (error nil))) + +(defsubst eieio-class-object (class) + "Check that CLASS is a class and return the corresponding object." + (let ((c (eieio--class-object class))) + (eieio--check-type eieio--class-p c) + c)) + +(defsubst class-p (class) + "Return non-nil if CLASS is a valid class vector. +CLASS is a symbol." ;FIXME: Is it a vector or a symbol? ;; this new method is faster since it doesn't waste time checking lots of ;; things. - `(condition-case nil - (eq (aref (class-v ,class) 0) 'defclass) - (error nil))) - -(defun eieio-class-name (class) "Return a Lisp like symbol name for CLASS." + (condition-case nil + (eq (aref (eieio--class-v class) 0) 'defclass) + (error nil))) + +(defun eieio-class-name (class) + "Return a Lisp like symbol name for CLASS." + ;; FIXME: What's a "Lisp like symbol name"? + ;; FIXME: CLOS returns a symbol, but the code returns a string. + (if (eieio--class-p class) (setq class (eieio--class-symbol class))) (eieio--check-type class-p class) ;; I think this is supposed to return a symbol, but to me CLASS is a symbol, ;; and I wanted a string. Arg! (format "#<class %s>" (symbol-name class))) (define-obsolete-function-alias 'class-name #'eieio-class-name "24.4") -(defmacro eieio-class-parents-fast (class) - "Return parent classes to CLASS with no check." - `(eieio--class-parent (class-v ,class))) - -(defmacro eieio-class-children-fast (class) "Return child classes to CLASS with no check." - `(eieio--class-children (class-v ,class))) - -(defmacro same-class-fast-p (obj class) - "Return t if OBJ is of class-type CLASS with no error checking." - `(eq (eieio--object-class ,obj) ,class)) - -(defmacro class-constructor (class) - "Return the symbol representing the constructor of CLASS." - `(eieio--class-symbol (class-v ,class))) - -(defmacro generic-p (method) - "Return t if symbol METHOD is a generic function. -Only methods have the symbol `eieio-method-obarray' as a property -\(which contains a list of all bindings to that method type.)" - `(and (fboundp ,method) (get ,method 'eieio-method-obarray))) - -(defun generic-primary-only-p (method) - "Return t if symbol METHOD is a generic function with only primary methods. -Only methods have the symbol `eieio-method-obarray' as a property (which -contains a list of all bindings to that method type.) -Methods with only primary implementations are executed in an optimized way." - (and (generic-p method) - (let ((M (get method 'eieio-method-tree))) - (and (< 0 (length (aref M method-primary))) - (not (aref M method-static)) - (not (aref M method-before)) - (not (aref M method-after)) - (not (aref M method-generic-before)) - (not (aref M method-generic-primary)) - (not (aref M method-generic-after)))) - )) - -(defun generic-primary-only-one-p (method) - "Return t if symbol METHOD is a generic function with only primary methods. -Only methods have the symbol `eieio-method-obarray' as a property (which -contains a list of all bindings to that method type.) -Methods with only primary implementations are executed in an optimized way." - (and (generic-p method) - (let ((M (get method 'eieio-method-tree))) - (and (= 1 (length (aref M method-primary))) - (not (aref M method-static)) - (not (aref M method-before)) - (not (aref M method-after)) - (not (aref M method-generic-before)) - (not (aref M method-generic-primary)) - (not (aref M method-generic-after)))) - )) - -(defmacro class-option-assoc (list option) +(defalias 'eieio--class-constructor #'identity + "Return the symbol representing the constructor of CLASS.") + +(defmacro eieio--class-option-assoc (list option) "Return from LIST the found OPTION, or nil if it doesn't exist." `(car-safe (cdr (memq ,option ,list)))) -(defmacro class-option (class option) +(defsubst eieio--class-option (class option) "Return the value stored for CLASS' OPTION. Return nil if that option doesn't exist." - `(class-option-assoc (eieio--class-options (class-v ,class)) ',option)) + (eieio--class-option-assoc (eieio--class-options class) option)) -(defmacro eieio-object-p (obj) +(defsubst eieio-object-p (obj) "Return non-nil if OBJ is an EIEIO object." - `(condition-case nil - (let ((tobj ,obj)) - (and (eq (aref tobj 0) 'object) - (class-p (eieio--object-class tobj)))) - (error nil))) + (and (vectorp obj) + (condition-case nil + (eq (aref (eieio--object-class-object obj) 0) 'defclass) + (error nil)))) + (defalias 'object-p 'eieio-object-p) -(defmacro class-abstract-p (class) +(defsubst class-abstract-p (class) "Return non-nil if CLASS is abstract. Abstract classes cannot be instantiated." - `(class-option ,class :abstract)) + (eieio--class-option (eieio--class-v class) :abstract)) -(defmacro class-method-invocation-order (class) +(defsubst eieio--class-method-invocation-order (class) "Return the invocation order of CLASS. Abstract classes cannot be instantiated." - `(or (class-option ,class :method-invocation-order) - :breadth-first)) + (or (eieio--class-option class :method-invocation-order) + :breadth-first)) ;;; ;; Class Creation -(defvar eieio-defclass-autoload-map (make-vector 7 nil) +(defvar eieio-defclass-autoload-map (make-hash-table) "Symbol map of superclasses we find in autoloads.") ;; We autoload this because it's used in `make-autoload'. ;;;###autoload -(defun eieio-defclass-autoload (cname superclasses filename doc) +(defun eieio-defclass-autoload (cname _superclasses filename doc) "Create autoload symbols for the EIEIO class CNAME. SUPERCLASSES are the superclasses that CNAME inherits from. DOC is the docstring for CNAME. @@ -337,82 +260,52 @@ SUPERCLASSES as children. It creates an autoload function for CNAME's constructor." ;; Assume we've already debugged inputs. - (let* ((oldc (when (class-p cname) (class-v cname))) - (newc (make-vector eieio--class-num-slots nil)) + ;; We used to store the list of superclasses in the `parent' slot (as a list + ;; of class names). But now this slot holds a list of class objects, and + ;; those parents may not exist yet, so the corresponding class objects may + ;; simply not exist yet. So instead we just don't store the list of parents + ;; here in eieio-defclass-autoload at all, since it seems that they're just + ;; not needed before the class is actually loaded. + (let* ((oldc (when (class-p cname) (eieio--class-v cname))) + (newc (eieio--class-make cname)) ) (if oldc nil ;; Do nothing if we already have this class. - ;; Create the class in NEWC, but don't fill anything else in. - (aset newc 0 'defclass) - (setf (eieio--class-symbol newc) cname) - - (let ((clear-parent nil)) - ;; No parents? - (when (not superclasses) - (setq superclasses '(eieio-default-superclass) - clear-parent t) - ) - - ;; Hook our new class into the existing structures so we can - ;; autoload it later. - (dolist (SC superclasses) - - - ;; TODO - If we create an autoload that is in the map, that - ;; map needs to be cleared! - + ;; turn this into a usable self-pointing symbol + (when eieio-backward-compatibility + (set cname cname) + (make-obsolete-variable cname (format "use '%s instead" cname) "25.1")) - ;; Does our parent exist? - (if (not (class-p SC)) + ;; Store the new class vector definition into the symbol. We need to + ;; do this first so that we can call defmethod for the accessor. + ;; The vector will be updated by the following while loop and will not + ;; need to be stored a second time. + (setf (eieio--class-v cname) newc) - ;; Create a symbol for this parent, and then store this - ;; parent on that symbol. - (let ((sym (intern (symbol-name SC) eieio-defclass-autoload-map))) - (if (not (boundp sym)) - (set sym (list cname)) - (add-to-list sym cname)) - ) - - ;; We have a parent, save the child in there. - (when (not (member cname (eieio--class-children (class-v SC)))) - (setf (eieio--class-children (class-v SC)) - (cons cname (eieio--class-children (class-v SC)))))) - - ;; save parent in child - (setf (eieio--class-parent newc) (cons SC (eieio--class-parent newc))) - ) - - ;; turn this into a usable self-pointing symbol - (set cname cname) - - ;; Store the new class vector definition into the symbol. We need to - ;; do this first so that we can call defmethod for the accessor. - ;; The vector will be updated by the following while loop and will not - ;; need to be stored a second time. - (put cname 'eieio-class-definition newc) - - ;; Clear the parent - (if clear-parent (setf (eieio--class-parent newc) nil)) - - ;; Create an autoload on top of our constructor function. - (autoload cname filename doc nil nil) - (autoload (intern (concat (symbol-name cname) "-p")) filename "" nil nil) - (autoload (intern (concat (symbol-name cname) "-child-p")) filename "" nil nil) - (autoload (intern (concat (symbol-name cname) "-list-p")) filename "" nil nil) - - )))) + ;; Create an autoload on top of our constructor function. + (autoload cname filename doc nil nil) + (autoload (intern (format "%s-p" cname)) filename "" nil nil) + (when eieio-backward-compatibility + (autoload (intern (format "%s-child-p" cname)) filename "" nil nil) + (autoload (intern (format "%s-list-p" cname)) filename "" nil nil))))) (defsubst eieio-class-un-autoload (cname) "If class CNAME is in an autoload state, load its file." - (when (eq (car-safe (symbol-function cname)) 'autoload) - (load-library (car (cdr (symbol-function cname)))))) + (autoload-do-load (symbol-function cname))) ; cname + +(cl-deftype list-of (elem-type) + `(and list + (satisfies (lambda (list) + (cl-every (lambda (elem) (cl-typep elem ',elem-type)) + list))))) -(defun eieio-defclass (cname superclasses slots options-and-doc) - ;; FIXME: Most of this should be moved to the `defclass' macro. +(declare-function eieio--defmethod "eieio-generic" (method kind argclass code)) + +(defun eieio-defclass-internal (cname superclasses slots options) "Define CNAME as a new subclass of SUPERCLASSES. -SLOTS are the slots residing in that class definition, and options or -documentation OPTIONS-AND-DOC is the toplevel documentation for this class. +SLOTS are the slots residing in that class definition, and OPTIONS +holds the class options. See `defclass' for more information." ;; Run our eieio-hook each time, and clear it when we are done. ;; This way people can add hooks safely if they want to modify eieio @@ -420,18 +313,17 @@ See `defclass' for more information." (run-hooks 'eieio-hook) (setq eieio-hook nil) - (eieio--check-type listp superclasses) - (let* ((pname superclasses) - (newc (make-vector eieio--class-num-slots nil)) - (oldc (when (class-p cname) (class-v cname))) + (oldc (when (class-p cname) (eieio--class-v cname))) + (newc (if (and oldc (not (eieio--class-default-object-cache oldc))) + ;; The oldc class is a stub setup by eieio-defclass-autoload. + ;; Reuse it instead of creating a new one, so that existing + ;; references are still valid. + oldc + (eieio--class-make cname))) (groups nil) ;; list of groups id'd from slots - (options nil) (clearparent nil)) - (aset newc 0 'defclass) - (setf (eieio--class-symbol newc) cname) - ;; If this class already existed, and we are updating its structure, ;; make sure we keep the old child list. This can cause bugs, but ;; if no new slots are created, it also saves time, and prevents @@ -439,124 +331,68 @@ See `defclass' for more information." ;; byte compiling an EIEIO file. (if oldc (setf (eieio--class-children newc) (eieio--class-children oldc)) - ;; If the old class did not exist, but did exist in the autoload map, then adopt those children. - ;; This is like the above, but deals with autoloads nicely. - (let ((sym (intern-soft (symbol-name cname) eieio-defclass-autoload-map))) - (when sym - (condition-case nil - (setf (eieio--class-children newc) (symbol-value sym)) - (error nil)) - (unintern (symbol-name cname) eieio-defclass-autoload-map) - )) - ) - - (cond ((and (stringp (car options-and-doc)) - (/= 1 (% (length options-and-doc) 2))) - (error "Too many arguments to `defclass'")) - ((and (symbolp (car options-and-doc)) - (/= 0 (% (length options-and-doc) 2))) - (error "Too many arguments to `defclass'")) - ) - - (setq options - (if (stringp (car options-and-doc)) - (cons :documentation options-and-doc) - options-and-doc)) + ;; If the old class did not exist, but did exist in the autoload map, + ;; then adopt those children. This is like the above, but deals with + ;; autoloads nicely. + (let ((children (gethash cname eieio-defclass-autoload-map))) + (when children + (setf (eieio--class-children newc) children) + (remhash cname eieio-defclass-autoload-map)))) (if pname (progn - (while pname - (if (and (car pname) (symbolp (car pname))) - (if (not (class-p (car pname))) + (dolist (p pname) + (if (and p (symbolp p)) + (if (not (class-p p)) ;; bad class - (error "Given parent class %s is not a class" (car pname)) + (error "Given parent class %S is not a class" p) ;; good parent class... ;; save new child in parent - (when (not (member cname (eieio--class-children (class-v (car pname))))) - (setf (eieio--class-children (class-v (car pname))) - (cons cname (eieio--class-children (class-v (car pname)))))) + (cl-pushnew cname (eieio--class-children (eieio--class-v p))) ;; Get custom groups, and store them into our local copy. - (mapc (lambda (g) (pushnew g groups :test #'equal)) - (class-option (car pname) :custom-groups)) + (mapc (lambda (g) (cl-pushnew g groups :test #'equal)) + (eieio--class-option (eieio--class-v p) :custom-groups)) ;; save parent in child - (setf (eieio--class-parent newc) (cons (car pname) (eieio--class-parent newc)))) - (error "Invalid parent class %s" pname)) - (setq pname (cdr pname))) + (push (eieio--class-v p) (eieio--class-parent newc))) + (error "Invalid parent class %S" p))) ;; Reverse the list of our parents so that they are prioritized in ;; the same order as specified in the code. - (setf (eieio--class-parent newc) (nreverse (eieio--class-parent newc))) ) + (cl-callf nreverse (eieio--class-parent newc))) ;; If there is nothing to loop over, then inherit from the ;; default superclass. (unless (eq cname 'eieio-default-superclass) ;; adopt the default parent here, but clear it later... (setq clearparent t) - ;; save new child in parent - (if (not (member cname (eieio--class-children (class-v 'eieio-default-superclass)))) - (setf (eieio--class-children (class-v 'eieio-default-superclass)) - (cons cname (eieio--class-children (class-v 'eieio-default-superclass))))) - ;; save parent in child - (setf (eieio--class-parent newc) (list eieio-default-superclass)))) - - ;; turn this into a usable self-pointing symbol - (set cname cname) - - ;; These two tests must be created right away so we can have self- - ;; referencing classes. ei, a class whose slot can contain only - ;; pointers to itself. - - ;; Create the test function - (let ((csym (intern (concat (symbol-name cname) "-p")))) - (fset csym - (list 'lambda (list 'obj) - (format "Test OBJ to see if it an object of type %s" cname) - (list 'and '(eieio-object-p obj) - (list 'same-class-p 'obj cname))))) - - ;; Make sure the method invocation order is a valid value. - (let ((io (class-option-assoc options :method-invocation-order))) - (when (and io (not (member io '(:depth-first :breadth-first :c3)))) - (error "Method invocation order %s is not allowed" io) - )) + ;; save new child in parent + (cl-pushnew cname (eieio--class-children eieio-default-superclass)) + ;; save parent in child + (setf (eieio--class-parent newc) (list eieio-default-superclass)))) - ;; Create a handy child test too - (let ((csym (intern (concat (symbol-name cname) "-child-p")))) - (fset csym - `(lambda (obj) - ,(format - "Test OBJ to see if it an object is a child of type %s" - cname) - (and (eieio-object-p obj) - (object-of-class-p obj ,cname)))) + ;; turn this into a usable self-pointing symbol; FIXME: Why? + (when eieio-backward-compatibility + (set cname cname) + (make-obsolete-variable cname (format "use '%s instead" cname) "25.1")) ;; Create a handy list of the class test too - (let ((csym (intern (concat (symbol-name cname) "-list-p")))) - (fset csym - `(lambda (obj) - ,(format - "Test OBJ to see if it a list of objects which are a child of type %s" - cname) - (when (listp obj) - (let ((ans t)) ;; nil is valid - ;; Loop over all the elements of the input list, test - ;; each to make sure it is a child of the desired object class. - (while (and obj ans) - (setq ans (and (eieio-object-p (car obj)) - (object-of-class-p (car obj) ,cname))) - (setq obj (cdr obj))) - ans))))) - - ;; When using typep, (typep OBJ 'myclass) returns t for objects which - ;; are subclasses of myclass. For our predicates, however, it is - ;; important for EIEIO to be backwards compatible, where - ;; myobject-p, and myobject-child-p are different. - ;; "cl" uses this technique to specify symbols with specific typep - ;; test, so we can let typep have the CLOS documented behavior - ;; while keeping our above predicate clean. - - ;; It would be cleaner to use `defsetf' here, but that requires cl - ;; at runtime. - (put cname 'cl-deftype-handler - (list 'lambda () `(list 'satisfies (quote ,csym))))) + (when eieio-backward-compatibility + (let ((csym (intern (concat (symbol-name cname) "-list-p")))) + (defalias csym + `(lambda (obj) + ,(format + "Test OBJ to see if it a list of objects which are a child of type %s" + cname) + (when (listp obj) + (let ((ans t)) ;; nil is valid + ;; Loop over all the elements of the input list, test + ;; each to make sure it is a child of the desired object class. + (while (and obj ans) + (setq ans (and (eieio-object-p (car obj)) + (object-of-class-p (car obj) ,cname))) + (setq obj (cdr obj))) + ans)))) + (make-obsolete csym (format "use (cl-typep ... '(list-of %s)) instead" + cname) + "25.1"))) ;; Before adding new slots, let's add all the methods and classes ;; in from the parent class. @@ -566,78 +402,45 @@ See `defclass' for more information." ;; do this first so that we can call defmethod for the accessor. ;; The vector will be updated by the following while loop and will not ;; need to be stored a second time. - (put cname 'eieio-class-definition newc) + (setf (eieio--class-v cname) newc) ;; Query each slot in the declaration list and mangle into the ;; class structure I have defined. - (while slots - (let* ((slot1 (car slots)) - (name (car slot1)) - (slot (cdr slot1)) - (acces (plist-get slot ':accessor)) - (init (or (plist-get slot ':initform) - (if (member ':initform slot) nil + (pcase-dolist (`(,name . ,slot) slots) + (let* ((init (or (plist-get slot :initform) + (if (member :initform slot) nil eieio-unbound))) - (initarg (plist-get slot ':initarg)) - (docstr (plist-get slot ':documentation)) - (prot (plist-get slot ':protection)) - (reader (plist-get slot ':reader)) - (writer (plist-get slot ':writer)) - (alloc (plist-get slot ':allocation)) - (type (plist-get slot ':type)) - (custom (plist-get slot ':custom)) - (label (plist-get slot ':label)) - (customg (plist-get slot ':group)) - (printer (plist-get slot ':printer)) - - (skip-nil (class-option-assoc options :allow-nil-initform)) + (initarg (plist-get slot :initarg)) + (docstr (plist-get slot :documentation)) + (prot (plist-get slot :protection)) + (alloc (plist-get slot :allocation)) + (type (plist-get slot :type)) + (custom (plist-get slot :custom)) + (label (plist-get slot :label)) + (customg (plist-get slot :group)) + (printer (plist-get slot :printer)) + + (skip-nil (eieio--class-option-assoc options :allow-nil-initform)) ) - (if eieio-error-unsupported-class-tags - (let ((tmp slot)) - (while tmp - (if (not (member (car tmp) '(:accessor - :initform - :initarg - :documentation - :protection - :reader - :writer - :allocation - :type - :custom - :label - :group - :printer - :allow-nil-initform - :custom-groups))) - (signal 'invalid-slot-type (list (car tmp)))) - (setq tmp (cdr (cdr tmp)))))) - ;; Clean up the meaning of protection. - (cond ((or (eq prot 'public) (eq prot :public)) (setq prot nil)) - ((or (eq prot 'protected) (eq prot :protected)) (setq prot 'protected)) - ((or (eq prot 'private) (eq prot :private)) (setq prot 'private)) - ((eq prot nil) nil) - (t (signal 'invalid-slot-type (list ':protection prot)))) - - ;; Make sure the :allocation parameter has a valid value. - (if (not (or (not alloc) (eq alloc :class) (eq alloc :instance))) - (signal 'invalid-slot-type (list ':allocation alloc))) + (setq prot + (pcase prot + ((or 'nil 'public ':public) nil) + ((or 'protected ':protected) 'protected) + ((or 'private ':private) 'private) + (_ (signal 'invalid-slot-type (list :protection prot))))) ;; The default type specifier is supposed to be t, meaning anything. (if (not type) (setq type t)) - ;; Label is nil, or a string - (if (not (or (null label) (stringp label))) - (signal 'invalid-slot-type (list ':label label))) - - ;; Is there an initarg, but allocation of class? - (if (and initarg (eq alloc :class)) - (message "Class allocated slots do not need :initarg")) - ;; intern the symbol so we can use it blankly - (if initarg (set initarg initarg)) + (if eieio-backward-compatibility + (and initarg (not (keywordp initarg)) + (progn + (set initarg initarg) + (make-obsolete-variable + initarg (format "use '%s instead" initarg) "25.1")))) ;; The customgroup should be a list of symbols (cond ((null customg) @@ -647,145 +450,60 @@ See `defclass' for more information." ;; The customgroup better be a symbol, or list of symbols. (mapc (lambda (cg) (if (not (symbolp cg)) - (signal 'invalid-slot-type (list ':group cg)))) + (signal 'invalid-slot-type (list :group cg)))) customg) ;; First up, add this slot into our new class. - (eieio-add-new-slot newc name init docstr type custom label customg printer + (eieio--add-new-slot newc name init docstr type custom label customg printer prot initarg alloc 'defaultoverride skip-nil) ;; We need to id the group, and store them in a group list attribute. - (mapc (lambda (cg) (pushnew cg groups :test 'equal)) customg) - - ;; Anyone can have an accessor function. This creates a function - ;; of the specified name, and also performs a `defsetf' if applicable - ;; so that users can `setf' the space returned by this function. - (if acces - (progn - (eieio--defmethod - acces (if (eq alloc :class) :static :primary) cname - `(lambda (this) - ,(format - "Retrieves the slot `%s' from an object of class `%s'" - name cname) - (if (slot-boundp this ',name) - (eieio-oref this ',name) - ;; Else - Some error? nil? - nil))) - - (if (fboundp 'gv-define-setter) - ;; FIXME: We should move more of eieio-defclass into the - ;; defclass macro so we don't have to use `eval' and require - ;; `gv' at run-time. - (eval `(gv-define-setter ,acces (eieio--store eieio--object) - (list 'eieio-oset eieio--object '',name - eieio--store))) - ;; Provide a setf method. It would be cleaner to use - ;; defsetf, but that would require CL at runtime. - (put acces 'setf-method - `(lambda (widget) - (let* ((--widget-sym-- (make-symbol "--widget--")) - (--store-sym-- (make-symbol "--store--"))) - (list - (list --widget-sym--) - (list widget) - (list --store-sym--) - (list 'eieio-oset --widget-sym-- '',name - --store-sym--) - (list 'getfoo --widget-sym--)))))))) - - ;; If a writer is defined, then create a generic method of that - ;; name whose purpose is to set the value of the slot. - (if writer - (eieio--defmethod - writer nil cname - `(lambda (this value) - ,(format "Set the slot `%s' of an object of class `%s'" - name cname) - (setf (slot-value this ',name) value)))) - ;; If a reader is defined, then create a generic method - ;; of that name whose purpose is to access this slot value. - (if reader - (eieio--defmethod - reader nil cname - `(lambda (this) - ,(format "Access the slot `%s' from object of class `%s'" - name cname) - (slot-value this ',name)))) - ) - (setq slots (cdr slots))) + (dolist (cg customg) + (cl-pushnew cg groups :test 'equal)) + )) ;; Now that everything has been loaded up, all our lists are backwards! ;; Fix that up now. - (setf (eieio--class-public-a newc) (nreverse (eieio--class-public-a newc))) - (setf (eieio--class-public-d newc) (nreverse (eieio--class-public-d newc))) - (setf (eieio--class-public-doc newc) (nreverse (eieio--class-public-doc newc))) - (setf (eieio--class-public-type newc) - (apply 'vector (nreverse (eieio--class-public-type newc)))) - (setf (eieio--class-public-custom newc) (nreverse (eieio--class-public-custom newc))) - (setf (eieio--class-public-custom-label newc) (nreverse (eieio--class-public-custom-label newc))) - (setf (eieio--class-public-custom-group newc) (nreverse (eieio--class-public-custom-group newc))) - (setf (eieio--class-public-printer newc) (nreverse (eieio--class-public-printer newc))) - (setf (eieio--class-protection newc) (nreverse (eieio--class-protection newc))) - (setf (eieio--class-initarg-tuples newc) (nreverse (eieio--class-initarg-tuples newc))) + (cl-callf nreverse (eieio--class-public-a newc)) + (cl-callf nreverse (eieio--class-public-d newc)) + (cl-callf nreverse (eieio--class-public-doc newc)) + (cl-callf (lambda (types) (apply #'vector (nreverse types))) + (eieio--class-public-type newc)) + (cl-callf nreverse (eieio--class-public-custom newc)) + (cl-callf nreverse (eieio--class-public-custom-label newc)) + (cl-callf nreverse (eieio--class-public-custom-group newc)) + (cl-callf nreverse (eieio--class-public-printer newc)) + (cl-callf nreverse (eieio--class-protection newc)) + (cl-callf nreverse (eieio--class-initarg-tuples newc)) ;; The storage for class-class-allocation-type needs to be turned into ;; a vector now. - (setf (eieio--class-class-allocation-type newc) - (apply 'vector (eieio--class-class-allocation-type newc))) + (cl-callf (lambda (cat) (apply #'vector cat)) + (eieio--class-class-allocation-type newc)) ;; Also, take class allocated values, and vectorize them for speed. - (setf (eieio--class-class-allocation-values newc) - (apply 'vector (eieio--class-class-allocation-values newc))) - - ;; Attach slot symbols into an obarray, and store the index of - ;; this slot as the variable slot in this new symbol. We need to - ;; know about primes, because obarrays are best set in vectors of - ;; prime number length, and we also need to make our vector small - ;; to save space, and also optimal for the number of items we have. + (cl-callf (lambda (cavs) (apply #'vector cavs)) + (eieio--class-class-allocation-values newc)) + + ;; Attach slot symbols into a hashtable, and store the index of + ;; this slot as the value this table. (let* ((cnt 0) (pubsyms (eieio--class-public-a newc)) (prots (eieio--class-protection newc)) - (l (length pubsyms)) - (vl (let ((primes '( 3 5 7 11 13 17 19 23 29 31 37 41 43 47 - 53 59 61 67 71 73 79 83 89 97 101 ))) - (while (and primes (< (car primes) l)) - (setq primes (cdr primes))) - (car primes))) - (oa (make-vector vl 0)) - (newsym)) + (oa (make-hash-table :test #'eq))) (while pubsyms - (setq newsym (intern (symbol-name (car pubsyms)) oa)) - (set newsym cnt) - (setq cnt (1+ cnt)) - (if (car prots) (put newsym 'protection (car prots))) + (let ((newsym (list cnt))) + (setf (gethash (car pubsyms) oa) newsym) + (setq cnt (1+ cnt)) + (if (car prots) (setcdr newsym (car prots)))) (setq pubsyms (cdr pubsyms) prots (cdr prots))) - (setf (eieio--class-symbol-obarray newc) oa) - ) - - ;; Create the constructor function - (if (class-option-assoc options :abstract) - ;; Abstract classes cannot be instantiated. Say so. - (let ((abs (class-option-assoc options :abstract))) - (if (not (stringp abs)) - (setq abs (format "Class %s is abstract" cname))) - (fset cname - `(lambda (&rest stuff) - ,(format "You cannot create a new object of type %s" cname) - (error ,abs)))) - - ;; Non-abstract classes need a constructor. - (fset cname - `(lambda (newname &rest slots) - ,(format "Create a new object with name NAME of class type %s" cname) - (apply 'constructor ,cname newname slots))) - ) + (setf (eieio--class-symbol-hashtable newc) oa)) ;; Set up a specialized doc string. ;; Use stored value since it is calculated in a non-trivial way (put cname 'variable-documentation - (class-option-assoc options :documentation)) + (eieio--class-option-assoc options :documentation)) ;; Save the file location where this class is defined. (let ((fname (if load-in-progress @@ -797,8 +515,8 @@ See `defclass' for more information." (put cname 'class-location fname))) ;; We have a list of custom groups. Store them into the options. - (let ((g (class-option-assoc options :custom-groups))) - (mapc (lambda (cg) (pushnew cg g :test 'equal)) groups) + (let ((g (eieio--class-option-assoc options :custom-groups))) + (mapc (lambda (cg) (cl-pushnew cg g :test 'equal)) groups) (if (memq :custom-groups options) (setcar (cdr (memq :custom-groups options)) g) (setq options (cons :custom-groups (cons g options))))) @@ -811,11 +529,17 @@ See `defclass' for more information." (if clearparent (setf (eieio--class-parent newc) nil)) ;; Create the cached default object. - (let ((cache (make-vector (+ (length (eieio--class-public-a newc)) 3) - nil))) - (aset cache 0 'object) - (setf (eieio--object-class cache) cname) - (setf (eieio--object-name cache) 'default-cache-object) + (let ((cache (make-vector (+ (length (eieio--class-public-a newc)) + (eval-when-compile eieio--object-num-slots)) + nil)) + ;; We don't strictly speaking need to use a symbol, but the old + ;; code used the class's name rather than the class's object, so + ;; we follow this preference for using a symbol, which is probably + ;; convenient to keep the printed representation of such Elisp + ;; objects readable. + (tag (intern (format "eieio-class-tag--%s" cname)))) + (set tag newc) + (setf (eieio--object-class-tag cache) tag) (let ((eieio-skip-typecheck t)) ;; All type-checking has been done to our satisfaction ;; before this call. Don't waste our time in this call.. @@ -831,16 +555,16 @@ See `defclass' for more information." "Whether the default value VAL should be evaluated for use." (and (consp val) (symbolp (car val)) (fboundp (car val)))) -(defun eieio-perform-slot-validation-for-default (slot spec value skipnil) +(defun eieio--perform-slot-validation-for-default (slot spec value skipnil) "For SLOT, signal if SPEC does not match VALUE. If SKIPNIL is non-nil, then if VALUE is nil return t instead." - (if (and (not (eieio-eval-default-p value)) - (not eieio-skip-typecheck) - (not (and skipnil (null value))) - (not (eieio-perform-slot-validation spec value))) + (if (not (or (eieio-eval-default-p value) ;FIXME: Why? + eieio-skip-typecheck + (and skipnil (null value)) + (eieio--perform-slot-validation spec value))) (signal 'invalid-slot-type (list slot spec value)))) -(defun eieio-add-new-slot (newc a d doc type cust label custg print prot init alloc +(defun eieio--add-new-slot (newc a d doc type cust label custg print prot init alloc &optional defaultoverride skipnil) "Add into NEWC attribute A. If A already exists in NEWC, then do nothing. If it doesn't exist, @@ -861,9 +585,9 @@ if default value is nil." ;; To prevent override information w/out specification of storage, ;; we need to do this little hack. - (if (member a (eieio--class-class-allocation-a newc)) (setq alloc ':class)) + (if (member a (eieio--class-class-allocation-a newc)) (setq alloc :class)) - (if (or (not alloc) (and (symbolp alloc) (eq alloc ':instance))) + (if (or (not alloc) (and (symbolp alloc) (eq alloc :instance))) ;; In this case, we modify the INSTANCE version of a given slot. (progn @@ -871,16 +595,16 @@ if default value is nil." ;; Only add this element if it is so-far unique (if (not (member a (eieio--class-public-a newc))) (progn - (eieio-perform-slot-validation-for-default a type d skipnil) - (setf (eieio--class-public-a newc) (cons a (eieio--class-public-a newc))) - (setf (eieio--class-public-d newc) (cons d (eieio--class-public-d newc))) - (setf (eieio--class-public-doc newc) (cons doc (eieio--class-public-doc newc))) - (setf (eieio--class-public-type newc) (cons type (eieio--class-public-type newc))) - (setf (eieio--class-public-custom newc) (cons cust (eieio--class-public-custom newc))) - (setf (eieio--class-public-custom-label newc) (cons label (eieio--class-public-custom-label newc))) - (setf (eieio--class-public-custom-group newc) (cons custg (eieio--class-public-custom-group newc))) - (setf (eieio--class-public-printer newc) (cons print (eieio--class-public-printer newc))) - (setf (eieio--class-protection newc) (cons prot (eieio--class-protection newc))) + (eieio--perform-slot-validation-for-default a type d skipnil) + (push a (eieio--class-public-a newc)) + (push d (eieio--class-public-d newc)) + (push doc (eieio--class-public-doc newc)) + (push type (eieio--class-public-type newc)) + (push cust (eieio--class-public-custom newc)) + (push label (eieio--class-public-custom-label newc)) + (push custg (eieio--class-public-custom-group newc)) + (push print (eieio--class-public-printer newc)) + (push prot (eieio--class-protection newc)) (setf (eieio--class-initarg-tuples newc) (cons (cons init a) (eieio--class-initarg-tuples newc))) ) ;; When defaultoverride is true, we are usually adding new local @@ -906,7 +630,7 @@ if default value is nil." type tp a))) ;; If we have a repeat, only update the initarg... (unless (eq d eieio-unbound) - (eieio-perform-slot-validation-for-default a tp d skipnil) + (eieio--perform-slot-validation-for-default a tp d skipnil) (setcar dp d)) ;; If we have a new initarg, check for it. (when init @@ -983,19 +707,19 @@ if default value is nil." (let ((value (eieio-default-eval-maybe d))) (if (not (member a (eieio--class-class-allocation-a newc))) (progn - (eieio-perform-slot-validation-for-default a type value skipnil) + (eieio--perform-slot-validation-for-default a type value skipnil) ;; Here we have found a :class version of a slot. This ;; requires a very different approach. - (setf (eieio--class-class-allocation-a newc) (cons a (eieio--class-class-allocation-a newc))) - (setf (eieio--class-class-allocation-doc newc) (cons doc (eieio--class-class-allocation-doc newc))) - (setf (eieio--class-class-allocation-type newc) (cons type (eieio--class-class-allocation-type newc))) - (setf (eieio--class-class-allocation-custom newc) (cons cust (eieio--class-class-allocation-custom newc))) - (setf (eieio--class-class-allocation-custom-label newc) (cons label (eieio--class-class-allocation-custom-label newc))) - (setf (eieio--class-class-allocation-custom-group newc) (cons custg (eieio--class-class-allocation-custom-group newc))) - (setf (eieio--class-class-allocation-protection newc) (cons prot (eieio--class-class-allocation-protection newc))) + (push a (eieio--class-class-allocation-a newc)) + (push doc (eieio--class-class-allocation-doc newc)) + (push type (eieio--class-class-allocation-type newc)) + (push cust (eieio--class-class-allocation-custom newc)) + (push label (eieio--class-class-allocation-custom-label newc)) + (push custg (eieio--class-class-allocation-custom-group newc)) + (push prot (eieio--class-class-allocation-protection newc)) ;; Default value is stored in the 'values section, since new objects ;; can't initialize from this element. - (setf (eieio--class-class-allocation-values newc) (cons value (eieio--class-class-allocation-values newc)))) + (push value (eieio--class-class-allocation-values newc))) (when defaultoverride ;; There is a match, and we must override the old value. (let* ((ca (eieio--class-class-allocation-a newc)) @@ -1020,7 +744,7 @@ if default value is nil." ;; is to change the default, so allow unbound in. ;; If we have a repeat, only update the value... - (eieio-perform-slot-validation-for-default a tp value skipnil) + (eieio--perform-slot-validation-for-default a tp value skipnil) (setcar dp value)) ;; PLN Tue Jun 26 11:57:06 2007 : The protection is @@ -1065,289 +789,85 @@ if default value is nil." )) )) -(defun eieio-copy-parents-into-subclass (newc parents) +(defun eieio-copy-parents-into-subclass (newc _parents) "Copy into NEWC the slots of PARENTS. Follow the rules of not overwriting early parents when applying to the new child class." - (let ((ps (eieio--class-parent newc)) - (sn (class-option-assoc (eieio--class-options newc) - ':allow-nil-initform))) - (while ps + (let ((sn (eieio--class-option-assoc (eieio--class-options newc) + :allow-nil-initform))) + (dolist (pcv (eieio--class-parent newc)) ;; First, duplicate all the slots of the parent. - (let ((pcv (class-v (car ps)))) - (let ((pa (eieio--class-public-a pcv)) - (pd (eieio--class-public-d pcv)) - (pdoc (eieio--class-public-doc pcv)) - (ptype (eieio--class-public-type pcv)) - (pcust (eieio--class-public-custom pcv)) - (plabel (eieio--class-public-custom-label pcv)) - (pcustg (eieio--class-public-custom-group pcv)) - (printer (eieio--class-public-printer pcv)) - (pprot (eieio--class-protection pcv)) - (pinit (eieio--class-initarg-tuples pcv)) - (i 0)) - (while pa - (eieio-add-new-slot newc - (car pa) (car pd) (car pdoc) (aref ptype i) - (car pcust) (car plabel) (car pcustg) - (car printer) - (car pprot) (car-safe (car pinit)) nil nil sn) - ;; Increment each value. - (setq pa (cdr pa) - pd (cdr pd) - pdoc (cdr pdoc) - i (1+ i) - pcust (cdr pcust) - plabel (cdr plabel) - pcustg (cdr pcustg) - printer (cdr printer) - pprot (cdr pprot) - pinit (cdr pinit)) - )) ;; while/let - ;; Now duplicate all the class alloc slots. - (let ((pa (eieio--class-class-allocation-a pcv)) - (pdoc (eieio--class-class-allocation-doc pcv)) - (ptype (eieio--class-class-allocation-type pcv)) - (pcust (eieio--class-class-allocation-custom pcv)) - (plabel (eieio--class-class-allocation-custom-label pcv)) - (pcustg (eieio--class-class-allocation-custom-group pcv)) - (printer (eieio--class-class-allocation-printer pcv)) - (pprot (eieio--class-class-allocation-protection pcv)) - (pval (eieio--class-class-allocation-values pcv)) - (i 0)) - (while pa - (eieio-add-new-slot newc - (car pa) (aref pval i) (car pdoc) (aref ptype i) - (car pcust) (car plabel) (car pcustg) - (car printer) - (car pprot) nil ':class sn) - ;; Increment each value. - (setq pa (cdr pa) - pdoc (cdr pdoc) - pcust (cdr pcust) - plabel (cdr plabel) - pcustg (cdr pcustg) - printer (cdr printer) - pprot (cdr pprot) - i (1+ i)) - ))) ;; while/let - ;; Loop over each parent class - (setq ps (cdr ps))) - )) + (let ((pa (eieio--class-public-a pcv)) + (pd (eieio--class-public-d pcv)) + (pdoc (eieio--class-public-doc pcv)) + (ptype (eieio--class-public-type pcv)) + (pcust (eieio--class-public-custom pcv)) + (plabel (eieio--class-public-custom-label pcv)) + (pcustg (eieio--class-public-custom-group pcv)) + (printer (eieio--class-public-printer pcv)) + (pprot (eieio--class-protection pcv)) + (pinit (eieio--class-initarg-tuples pcv)) + (i 0)) + (while pa + (eieio--add-new-slot newc + (car pa) (car pd) (car pdoc) (aref ptype i) + (car pcust) (car plabel) (car pcustg) + (car printer) + (car pprot) (car-safe (car pinit)) nil nil sn) + ;; Increment each value. + (setq pa (cdr pa) + pd (cdr pd) + pdoc (cdr pdoc) + i (1+ i) + pcust (cdr pcust) + plabel (cdr plabel) + pcustg (cdr pcustg) + printer (cdr printer) + pprot (cdr pprot) + pinit (cdr pinit)) + )) ;; while/let + ;; Now duplicate all the class alloc slots. + (let ((pa (eieio--class-class-allocation-a pcv)) + (pdoc (eieio--class-class-allocation-doc pcv)) + (ptype (eieio--class-class-allocation-type pcv)) + (pcust (eieio--class-class-allocation-custom pcv)) + (plabel (eieio--class-class-allocation-custom-label pcv)) + (pcustg (eieio--class-class-allocation-custom-group pcv)) + (printer (eieio--class-class-allocation-printer pcv)) + (pprot (eieio--class-class-allocation-protection pcv)) + (pval (eieio--class-class-allocation-values pcv)) + (i 0)) + (while pa + (eieio--add-new-slot newc + (car pa) (aref pval i) (car pdoc) (aref ptype i) + (car pcust) (car plabel) (car pcustg) + (car printer) + (car pprot) nil :class sn) + ;; Increment each value. + (setq pa (cdr pa) + pdoc (cdr pdoc) + pcust (cdr pcust) + plabel (cdr plabel) + pcustg (cdr pcustg) + printer (cdr printer) + pprot (cdr pprot) + i (1+ i)) + ))))) -;;; CLOS methods and generics -;; - -(defun eieio--defgeneric-init-form (method doc-string) - "Form to use for the initial definition of a generic." - (cond - ((or (not (fboundp method)) - (eq 'autoload (car-safe (symbol-function method)))) - ;; Make sure the method tables are installed. - (eieiomt-install method) - ;; Construct the actual body of this function. - (eieio-defgeneric-form method doc-string)) - ((generic-p method) (symbol-function method)) ;Leave it as-is. - (t (error "You cannot create a generic/method over an existing symbol: %s" - method)))) - -(defun eieio-defgeneric-form (method doc-string) - "The lambda form that would be used as the function defined on METHOD. -All methods should call the same EIEIO function for dispatch. -DOC-STRING is the documentation attached to METHOD." - `(lambda (&rest local-args) - ,doc-string - (eieio-generic-call (quote ,method) local-args))) - -(defsubst eieio-defgeneric-reset-generic-form (method) - "Setup METHOD to call the generic form." - (let ((doc-string (documentation method))) - (fset method (eieio-defgeneric-form method doc-string)))) - -(defun eieio-defgeneric-form-primary-only (method doc-string) - "The lambda form that would be used as the function defined on METHOD. -All methods should call the same EIEIO function for dispatch. -DOC-STRING is the documentation attached to METHOD." - `(lambda (&rest local-args) - ,doc-string - (eieio-generic-call-primary-only (quote ,method) local-args))) - -(defsubst eieio-defgeneric-reset-generic-form-primary-only (method) - "Setup METHOD to call the generic form." - (let ((doc-string (documentation method))) - (fset method (eieio-defgeneric-form-primary-only method doc-string)))) - -(defun eieio-defgeneric-form-primary-only-one (method doc-string - class - impl - ) - "The lambda form that would be used as the function defined on METHOD. -All methods should call the same EIEIO function for dispatch. -DOC-STRING is the documentation attached to METHOD. -CLASS is the class symbol needed for private method access. -IMPL is the symbol holding the method implementation." - ;; NOTE: I tried out byte compiling this little fcn. Turns out it - ;; is faster to execute this for not byte-compiled. ie, install this, - ;; then measure calls going through here. I wonder why. - (require 'bytecomp) - (let ((byte-compile-warnings nil)) - (byte-compile - `(lambda (&rest local-args) - ,doc-string - ;; This is a cool cheat. Usually we need to look up in the - ;; method table to find out if there is a method or not. We can - ;; instead make that determination at load time when there is - ;; only one method. If the first arg is not a child of the class - ;; of that one implementation, then clearly, there is no method def. - (if (not (eieio-object-p (car local-args))) - ;; Not an object. Just signal. - (signal 'no-method-definition - (list ',method local-args)) - - ;; We do have an object. Make sure it is the right type. - (if ,(if (eq class eieio-default-superclass) - nil ; default superclass means just an obj. Already asked. - `(not (child-of-class-p (eieio--object-class (car local-args)) - ',class))) - - ;; If not the right kind of object, call no applicable - (apply 'no-applicable-method (car local-args) - ',method local-args) - - ;; It is ok, do the call. - ;; Fill in inter-call variables then evaluate the method. - (let ((eieio-generic-call-next-method-list nil) - (eieio-generic-call-key method-primary) - (eieio-generic-call-methodname ',method) - (eieio-generic-call-arglst local-args) - ) - (eieio--with-scoped-class ',class - ,(if (< emacs-major-version 24) - `(apply ,(list 'quote impl) local-args) - `(apply #',impl local-args))) - ;(,impl local-args) - ))))))) - -(defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method) - "Setup METHOD to call the generic form." - (let* ((doc-string (documentation method)) - (M (get method 'eieio-method-tree)) - (entry (car (aref M method-primary))) - ) - (fset method (eieio-defgeneric-form-primary-only-one - method doc-string - (car entry) - (cdr entry) - )))) - -(defun eieio-unbind-method-implementations (method) - "Make the generic method METHOD have no implementations. -It will leave the original generic function in place, -but remove reference to all implementations of METHOD." - (put method 'eieio-method-tree nil) - (put method 'eieio-method-obarray nil)) - -(defun eieio--defmethod (method kind argclass code) - "Work part of the `defmethod' macro defining METHOD with ARGS." - (let ((key - ;; Find optional keys. - (cond ((memq kind '(:BEFORE :before)) method-before) - ((memq kind '(:AFTER :after)) method-after) - ((memq kind '(:STATIC :static)) method-static) - ((memq kind '(:PRIMARY :primary nil)) method-primary) - ;; Primary key. - ;; (t method-primary) - (t (error "Unknown method kind %S" kind))))) - ;; Make sure there is a generic (when called from defclass). - (eieio--defalias - method (eieio--defgeneric-init-form - method (or (documentation code) - (format "Generically created method `%s'." method)))) - ;; Create symbol for property to bind to. If the first arg is of - ;; the form (varname vartype) and `vartype' is a class, then - ;; that class will be the type symbol. If not, then it will fall - ;; under the type `primary' which is a non-specific calling of the - ;; function. - (if argclass - (if (not (class-p argclass)) - (error "Unknown class type %s in method parameters" - argclass)) - ;; Generics are higher. - (setq key (eieio-specialized-key-to-generic-key key))) - ;; Put this lambda into the symbol so we can find it. - (eieiomt-add method code key argclass) - ) - - (when eieio-optimize-primary-methods-flag - ;; Optimizing step: - ;; - ;; If this method, after this setup, only has primary methods, then - ;; we can setup the generic that way. - (if (generic-primary-only-p method) - ;; If there is only one primary method, then we can go one more - ;; optimization step. - (if (generic-primary-only-one-p method) - (eieio-defgeneric-reset-generic-form-primary-only-one method) - (eieio-defgeneric-reset-generic-form-primary-only method)) - (eieio-defgeneric-reset-generic-form method))) - - method) - ;;; Slot type validation ;; This is a hideous hack for replacing `typep' from cl-macs, to avoid ;; requiring the CL library at run-time. It can be eliminated if/when ;; `typep' is merged into Emacs core. -(defun eieio--typep (val type) - (if (symbolp type) - (cond ((get type 'cl-deftype-handler) - (eieio--typep val (funcall (get type 'cl-deftype-handler)))) - ((eq type t) t) - ((eq type 'null) (null val)) - ((eq type 'atom) (atom val)) - ((eq type 'float) (and (numberp val) (not (integerp val)))) - ((eq type 'real) (numberp val)) - ((eq type 'fixnum) (integerp val)) - ((memq type '(character string-char)) (characterp val)) - (t - (let* ((name (symbol-name type)) - (namep (intern (concat name "p")))) - (if (fboundp namep) - (funcall `(lambda () (,namep val))) - (funcall `(lambda () - (,(intern (concat name "-p")) val))))))) - (cond ((get (car type) 'cl-deftype-handler) - (eieio--typep val (apply (get (car type) 'cl-deftype-handler) - (cdr type)))) - ((memq (car type) '(integer float real number)) - (and (eieio--typep val (car type)) - (or (memq (cadr type) '(* nil)) - (if (consp (cadr type)) - (> val (car (cadr type))) - (>= val (cadr type)))) - (or (memq (caddr type) '(* nil)) - (if (consp (car (cddr type))) - (< val (caar (cddr type))) - (<= val (car (cddr type))))))) - ((memq (car type) '(and or not)) - (eval (cons (car type) - (mapcar (lambda (x) - `(eieio--typep (quote ,val) (quote ,x))) - (cdr type))))) - ((memq (car type) '(member member*)) - (memql val (cdr type))) - ((eq (car type) 'satisfies) - (funcall `(lambda () (,(cadr type) val)))) - (t (error "Bad type spec: %s" type))))) - -(defun eieio-perform-slot-validation (spec value) + +(defun eieio--perform-slot-validation (spec value) "Return non-nil if SPEC does not match VALUE." (or (eq spec t) ; t always passes (eq value eieio-unbound) ; unbound always passes - (eieio--typep value spec))) + (cl-typep value spec))) -(defun eieio-validate-slot-value (class slot-idx value slot) +(defun eieio--validate-slot-value (class slot-idx value slot) "Make sure that for CLASS referencing SLOT-IDX, VALUE is valid. Checks the :type specifier. SLOT is the slot that is being checked, and is only used when throwing @@ -1355,22 +875,24 @@ an error." (if eieio-skip-typecheck nil ;; Trim off object IDX junk added in for the object index. - (setq slot-idx (- slot-idx 3)) - (let ((st (aref (eieio--class-public-type (class-v class)) slot-idx))) - (if (not (eieio-perform-slot-validation st value)) - (signal 'invalid-slot-type (list class slot st value)))))) + (setq slot-idx (- slot-idx (eval-when-compile eieio--object-num-slots))) + (let ((st (aref (eieio--class-public-type class) slot-idx))) + (if (not (eieio--perform-slot-validation st value)) + (signal 'invalid-slot-type + (list (eieio--class-symbol class) slot st value)))))) -(defun eieio-validate-class-slot-value (class slot-idx value slot) +(defun eieio--validate-class-slot-value (class slot-idx value slot) "Make sure that for CLASS referencing SLOT-IDX, VALUE is valid. Checks the :type specifier. SLOT is the slot that is being checked, and is only used when throwing an error." (if eieio-skip-typecheck nil - (let ((st (aref (eieio--class-class-allocation-type (class-v class)) + (let ((st (aref (eieio--class-class-allocation-type class) slot-idx))) - (if (not (eieio-perform-slot-validation st value)) - (signal 'invalid-slot-type (list class slot st value)))))) + (if (not (eieio--perform-slot-validation st value)) + (signal 'invalid-slot-type + (list (eieio--class-symbol class) slot st value)))))) (defun eieio-barf-if-slot-unbound (value instance slotname fn) "Throw a signal if VALUE is a representation of an UNBOUND slot. @@ -1378,7 +900,7 @@ INSTANCE is the object being referenced. SLOTNAME is the offending slot. If the slot is ok, return VALUE. Argument FN is the function calling this verifier." (if (and (eq value eieio-unbound) (not eieio-skip-typecheck)) - (slot-unbound instance (eieio--object-class instance) slotname fn) + (slot-unbound instance (eieio--object-class-name instance) slotname fn) value)) @@ -1389,14 +911,17 @@ Argument FN is the function calling this verifier." (eieio--check-type (or eieio-object-p class-p) obj) (eieio--check-type symbolp slot) (if (class-p obj) (eieio-class-un-autoload obj)) - (let* ((class (if (class-p obj) obj (eieio--object-class obj))) - (c (eieio-slot-name-index class obj slot))) + (let* ((class (cond ((symbolp obj) + (error "eieio-oref called on a class!") + (eieio--class-v obj)) + (t (eieio--object-class-object obj)))) + (c (eieio--slot-name-index class obj slot))) (if (not c) ;; It might be missing because it is a :class allocated slot. ;; Let's check that info out. - (if (setq c (eieio-class-slot-name-index class slot)) + (if (setq c (eieio--class-slot-name-index class slot)) ;; Oref that slot. - (aref (eieio--class-class-allocation-values (class-v class)) c) + (aref (eieio--class-class-allocation-values class) c) ;; The slot-missing method is a cool way of allowing an object author ;; to intercept missing slot definitions. Since it is also the LAST ;; thing called in this fn, its return value would be retrieved. @@ -1412,26 +937,30 @@ Argument FN is the function calling this verifier." Fills in OBJ's SLOT with its default value." (eieio--check-type (or eieio-object-p class-p) obj) (eieio--check-type symbolp slot) - (let* ((cl (if (eieio-object-p obj) (eieio--object-class obj) obj)) - (c (eieio-slot-name-index cl obj slot))) + (let* ((cl (cond ((symbolp obj) (eieio--class-v obj)) + (t (eieio--object-class-object obj)))) + (c (eieio--slot-name-index cl obj slot))) (if (not c) ;; It might be missing because it is a :class allocated slot. ;; Let's check that info out. (if (setq c - (eieio-class-slot-name-index cl slot)) + (eieio--class-slot-name-index cl slot)) ;; Oref that slot. - (aref (eieio--class-class-allocation-values (class-v cl)) + (aref (eieio--class-class-allocation-values cl) c) (slot-missing obj slot 'oref-default) ;;(signal 'invalid-slot-name (list (class-name cl) slot)) ) (eieio-barf-if-slot-unbound - (let ((val (nth (- c 3) (eieio--class-public-d (class-v cl))))) + (let ((val (nth (- c (eval-when-compile eieio--object-num-slots)) + (eieio--class-public-d cl)))) (eieio-default-eval-maybe val)) - obj cl 'oref-default)))) + obj (eieio--class-symbol cl) 'oref-default)))) (defun eieio-default-eval-maybe (val) "Check VAL, and return what `oref-default' would provide." + ;; FIXME: What the hell is this supposed to do? Shouldn't it evaluate + ;; variables as well? Why not just always call `eval'? (cond ;; Is it a function call? If so, evaluate it. ((eieio-eval-default-p val) @@ -1447,69 +976,56 @@ Fills in OBJ's SLOT with its default value." Fills in OBJ's SLOT with VALUE." (eieio--check-type eieio-object-p obj) (eieio--check-type symbolp slot) - (let ((c (eieio-slot-name-index (eieio--object-class obj) obj slot))) + (let* ((class (eieio--object-class-object obj)) + (c (eieio--slot-name-index class obj slot))) (if (not c) ;; It might be missing because it is a :class allocated slot. ;; Let's check that info out. (if (setq c - (eieio-class-slot-name-index (eieio--object-class obj) slot)) + (eieio--class-slot-name-index class slot)) ;; Oset that slot. (progn - (eieio-validate-class-slot-value (eieio--object-class obj) c value slot) - (aset (eieio--class-class-allocation-values (class-v (eieio--object-class obj))) + (eieio--validate-class-slot-value class c value slot) + (aset (eieio--class-class-allocation-values class) c value)) ;; See oref for comment on `slot-missing' (slot-missing obj slot 'oset value) ;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot)) ) - (eieio-validate-slot-value (eieio--object-class obj) c value slot) + (eieio--validate-slot-value class c value slot) (aset obj c value)))) (defun eieio-oset-default (class slot value) "Do the work for the macro `oset-default'. Fills in the default value in CLASS' in SLOT with VALUE." - (eieio--check-type class-p class) + (setq class (eieio--class-object class)) + (eieio--check-type eieio--class-p class) (eieio--check-type symbolp slot) - (eieio--with-scoped-class class - (let* ((c (eieio-slot-name-index class nil slot))) - (if (not c) - ;; It might be missing because it is a :class allocated slot. - ;; Let's check that info out. - (if (setq c (eieio-class-slot-name-index class slot)) - (progn - ;; Oref that slot. - (eieio-validate-class-slot-value class c value slot) - (aset (eieio--class-class-allocation-values (class-v class)) c - value)) - (signal 'invalid-slot-name (list (eieio-class-name class) slot))) - (eieio-validate-slot-value class c value slot) - ;; Set this into the storage for defaults. - (setcar (nthcdr (- c 3) (eieio--class-public-d (class-v class))) - value) - ;; Take the value, and put it into our cache object. - (eieio-oset (eieio--class-default-object-cache (class-v class)) - slot value) - )))) + (let* ((c (eieio--slot-name-index class nil slot))) + (if (not c) + ;; It might be missing because it is a :class allocated slot. + ;; Let's check that info out. + (if (setq c (eieio--class-slot-name-index class slot)) + (progn + ;; Oref that slot. + (eieio--validate-class-slot-value class c value slot) + (aset (eieio--class-class-allocation-values class) c + value)) + (signal 'invalid-slot-name (list (eieio--class-symbol class) slot))) + (eieio--validate-slot-value class c value slot) + ;; Set this into the storage for defaults. + (setcar (nthcdr (- c (eval-when-compile eieio--object-num-slots)) + (eieio--class-public-d class)) + value) + ;; Take the value, and put it into our cache object. + (eieio-oset (eieio--class-default-object-cache class) + slot value) + ))) ;;; EIEIO internal search functions ;; -(defun eieio-slot-originating-class-p (start-class slot) - "Return non-nil if START-CLASS is the first class to define SLOT. -This is for testing if the class currently in scope is the class that defines SLOT -so that we can protect private slots." - (let ((par (eieio-class-parents-fast start-class)) - (ret t)) - (if (not par) - t - (while (and par ret) - (if (intern-soft (symbol-name slot) - (eieio--class-symbol-obarray (class-v (car par)))) - (setq ret nil)) - (setq par (cdr par))) - ret))) - -(defun eieio-slot-name-index (class obj slot) +(defun eieio--slot-name-index (class obj slot) "In CLASS for OBJ find the index of the named SLOT. The slot is a symbol which is installed in CLASS by the `defclass' call. OBJ can be nil, but if it is an object, and the slot in question @@ -1518,36 +1034,21 @@ scoped class. If SLOT is the value created with :initarg instead, reverse-lookup that name, and recurse with the associated slot value." ;; Removed checks to outside this call - (let* ((fsym (intern-soft (symbol-name slot) - (eieio--class-symbol-obarray (class-v class)))) - (fsi (if (symbolp fsym) (symbol-value fsym) nil))) + (let* ((fsym (gethash slot (eieio--class-symbol-hashtable class))) + (fsi (car fsym))) (if (integerp fsi) - (cond - ((not (get fsym 'protection)) - (+ 3 fsi)) - ((and (eq (get fsym 'protection) 'protected) - (eieio--scoped-class) - (or (child-of-class-p class (eieio--scoped-class)) - (and (eieio-object-p obj) - (child-of-class-p class (eieio--object-class obj))))) - (+ 3 fsi)) - ((and (eq (get fsym 'protection) 'private) - (or (and (eieio--scoped-class) - (eieio-slot-originating-class-p (eieio--scoped-class) slot)) - eieio-initializing-object)) - (+ 3 fsi)) - (t nil)) - (let ((fn (eieio-initarg-to-attribute class slot))) - (if fn (eieio-slot-name-index class obj fn) nil))))) - -(defun eieio-class-slot-name-index (class slot) + (+ (eval-when-compile eieio--object-num-slots) fsi) + (let ((fn (eieio--initarg-to-attribute class slot))) + (if fn (eieio--slot-name-index class obj fn) nil))))) + +(defun eieio--class-slot-name-index (class slot) "In CLASS find the index of the named SLOT. The slot is a symbol which is installed in CLASS by the `defclass' call. If SLOT is the value created with :initarg instead, reverse-lookup that name, and recurse with the associated slot value." ;; This will happen less often, and with fewer slots. Do this the ;; storage cheap way. - (let* ((a (eieio--class-class-allocation-a (class-v class))) + (let* ((a (eieio--class-class-allocation-a class)) (l1 (length a)) (af (memq slot a)) (l2 (length af))) @@ -1564,36 +1065,26 @@ reverse-lookup that name, and recurse with the associated slot value." If SET-ALL is non-nil, then when a default is nil, that value is reset. If SET-ALL is nil, the slots are only reset if the default is not nil." - (eieio--with-scoped-class (eieio--object-class obj) - (let ((eieio-initializing-object t) - (pub (eieio--class-public-a (class-v (eieio--object-class obj))))) - (while pub - (let ((df (eieio-oref-default obj (car pub)))) - (if (or df set-all) - (eieio-oset obj (car pub) df))) - (setq pub (cdr pub)))))) - -(defun eieio-initarg-to-attribute (class initarg) + (let ((pub (eieio--class-public-a (eieio--object-class-object obj)))) + (while pub + (let ((df (eieio-oref-default obj (car pub)))) + (if (or df set-all) + (eieio-oset obj (car pub) df))) + (setq pub (cdr pub))))) + +(defun eieio--initarg-to-attribute (class initarg) "For CLASS, convert INITARG to the actual attribute name. If there is no translation, pass it in directly (so we can cheat if need be... May remove that later...)" - (let ((tuple (assoc initarg (eieio--class-initarg-tuples (class-v class))))) + (let ((tuple (assoc initarg (eieio--class-initarg-tuples class)))) (if tuple (cdr tuple) nil))) -(defun eieio-attribute-to-initarg (class attribute) - "In CLASS, convert the ATTRIBUTE into the corresponding init argument tag. -This is usually a symbol that starts with `:'." - (let ((tuple (rassoc attribute (eieio--class-initarg-tuples (class-v class))))) - (if tuple - (car tuple) - nil))) - ;;; ;; Method Invocation order: C3 -(defun eieio-c3-candidate (class remaining-inputs) - "Return CLASS if it can go in the result now, otherwise nil" +(defun eieio--c3-candidate (class remaining-inputs) + "Return CLASS if it can go in the result now, otherwise nil." ;; Ensure CLASS is not in any position but the first in any of the ;; element lists of REMAINING-INPUTS. (and (not (let ((found nil)) @@ -1603,7 +1094,7 @@ This is usually a symbol that starts with `:'." found)) class)) -(defun eieio-c3-merge-lists (reversed-partial-result remaining-inputs) +(defun eieio--c3-merge-lists (reversed-partial-result remaining-inputs) "Merge REVERSED-PARTIAL-RESULT REMAINING-INPUTS in a consistent order, if possible. If a consistent order does not exist, signal an error." (if (let ((tail remaining-inputs) @@ -1622,41 +1113,38 @@ If a consistent order does not exist, signal an error." (next (progn (while (and tail (not found)) (setq found (and (car tail) - (eieio-c3-candidate (caar tail) - remaining-inputs)) + (eieio--c3-candidate (caar tail) + remaining-inputs)) tail (cdr tail))) found))) (if next ;; The graph is consistent so far, add NEXT to result and ;; merge input lists, dropping NEXT from their heads where ;; applicable. - (eieio-c3-merge-lists + (eieio--c3-merge-lists (cons next reversed-partial-result) - (mapcar (lambda (l) (if (eq (first l) next) (rest l) l)) + (mapcar (lambda (l) (if (eq (cl-first l) next) (cl-rest l) l)) remaining-inputs)) ;; The graph is inconsistent, give up (signal 'inconsistent-class-hierarchy (list remaining-inputs)))))) -(defun eieio-class-precedence-c3 (class) +(defun eieio--class-precedence-c3 (class) "Return all parents of CLASS in c3 order." - (let ((parents (eieio-class-parents-fast class))) - (eieio-c3-merge-lists + (let ((parents (eieio--class-parent (eieio--class-v class)))) + (eieio--c3-merge-lists (list class) (append (or - (mapcar - (lambda (x) - (eieio-class-precedence-c3 x)) - parents) - '((eieio-default-superclass))) + (mapcar #'eieio--class-precedence-c3 parents) + `((,eieio-default-superclass))) (list parents)))) ) ;;; ;; Method Invocation Order: Depth First -(defun eieio-class-precedence-dfs (class) +(defun eieio--class-precedence-dfs (class) "Return all parents of CLASS in depth-first order." - (let* ((parents (eieio-class-parents-fast class)) + (let* ((parents (eieio--class-parent class)) (classes (copy-sequence (apply #'append (list class) @@ -1664,9 +1152,9 @@ If a consistent order does not exist, signal an error." (mapcar (lambda (parent) (cons parent - (eieio-class-precedence-dfs parent))) + (eieio--class-precedence-dfs parent))) parents) - '((eieio-default-superclass)))))) + `((,eieio-default-superclass)))))) (tail classes)) ;; Remove duplicates. (while tail @@ -1676,588 +1164,190 @@ If a consistent order does not exist, signal an error." ;;; ;; Method Invocation Order: Breadth First -(defun eieio-class-precedence-bfs (class) +(defun eieio--class-precedence-bfs (class) "Return all parents of CLASS in breadth-first order." - (let ((result) - (queue (or (eieio-class-parents-fast class) - '(eieio-default-superclass)))) + (let* ((result) + (queue (or (eieio--class-parent class) + `(,eieio-default-superclass)))) (while queue (let ((head (pop queue))) (unless (member head result) (push head result) - (unless (eq head 'eieio-default-superclass) - (setq queue (append queue (or (eieio-class-parents-fast head) - '(eieio-default-superclass)))))))) + (unless (eq head eieio-default-superclass) + (setq queue (append queue (or (eieio--class-parent head) + `(,eieio-default-superclass)))))))) (cons class (nreverse result))) ) ;;; ;; Method Invocation Order -(defun eieio-class-precedence-list (class) +(defun eieio--class-precedence-list (class) "Return (transitively closed) list of parents of CLASS. The order, in which the parents are returned depends on the method invocation orders of the involved classes." - (if (or (null class) (eq class 'eieio-default-superclass)) + (if (or (null class) (eq class eieio-default-superclass)) nil - (case (class-method-invocation-order class) + (unless (eieio--class-default-object-cache class) + (eieio-class-un-autoload (eieio--class-symbol class))) + (cl-case (eieio--class-method-invocation-order class) (:depth-first - (eieio-class-precedence-dfs class)) + (eieio--class-precedence-dfs class)) (:breadth-first - (eieio-class-precedence-bfs class)) + (eieio--class-precedence-bfs class)) (:c3 - (eieio-class-precedence-c3 class)))) + (eieio--class-precedence-c3 class)))) ) (define-obsolete-function-alias - 'class-precedence-list 'eieio-class-precedence-list "24.4") + 'class-precedence-list 'eieio--class-precedence-list "24.4") -;;; CLOS generics internal function handling +;;; Here are some special types of errors ;; -(defvar eieio-generic-call-methodname nil - "When using `call-next-method', provides a context on how to do it.") -(defvar eieio-generic-call-arglst nil - "When using `call-next-method', provides a context for parameters.") -(defvar eieio-generic-call-key nil - "When using `call-next-method', provides a context for the current key. -Keys are a number representing :before, :primary, and :after methods.") -(defvar eieio-generic-call-next-method-list nil - "When executing a PRIMARY or STATIC method, track the 'next-method'. -During executions, the list is first generated, then as each next method -is called, the next method is popped off the stack.") - -(define-obsolete-variable-alias 'eieio-pre-method-execution-hooks - 'eieio-pre-method-execution-functions "24.3") -(defvar eieio-pre-method-execution-functions nil - "Abnormal hook run just before an EIEIO method is executed. -The hook function must accept one argument, the list of forms -about to be executed.") - -(defun eieio-generic-call (method args) - "Call METHOD with ARGS. -ARGS provides the context on which implementation to use. -This should only be called from a generic function." - ;; We must expand our arguments first as they are always - ;; passed in as quoted symbols - (let ((newargs nil) (mclass nil) (lambdas nil) (tlambdas nil) (keys nil) - (eieio-generic-call-methodname method) - (eieio-generic-call-arglst args) - (firstarg nil) - (primarymethodlist nil)) - ;; get a copy - (setq newargs args - firstarg (car newargs)) - ;; Is the class passed in autoloaded? - ;; Since class names are also constructors, they can be autoloaded - ;; via the autoload command. Check for this, and load them in. - ;; It is ok if it doesn't turn out to be a class. Probably want that - ;; function loaded anyway. - (if (and (symbolp firstarg) - (fboundp firstarg) - (listp (symbol-function firstarg)) - (eq 'autoload (car (symbol-function firstarg)))) - (load (nth 1 (symbol-function firstarg)))) - ;; Determine the class to use. - (cond ((eieio-object-p firstarg) - (setq mclass (eieio--object-class firstarg))) - ((class-p firstarg) - (setq mclass firstarg)) - ) - ;; Make sure the class is a valid class - ;; mclass can be nil (meaning a generic for should be used. - ;; mclass cannot have a value that is not a class, however. - (when (and (not (null mclass)) (not (class-p mclass))) - (error "Cannot dispatch method %S on class %S" - method mclass) - ) - ;; Now create a list in reverse order of all the calls we have - ;; make in order to successfully do this right. Rules: - ;; 1) Only call generics if scoped-class is not defined - ;; This prevents multiple calls in the case of recursion - ;; 2) Only call static if this is a static method. - ;; 3) Only call specifics if the definition allows for them. - ;; 4) Call in order based on :before, :primary, and :after - (when (eieio-object-p firstarg) - ;; Non-static calls do all this stuff. - - ;; :after methods - (setq tlambdas - (if mclass - (eieiomt-method-list method method-after mclass) - (list (eieio-generic-form method method-after nil))) - ;;(or (and mclass (eieio-generic-form method method-after mclass)) - ;; (eieio-generic-form method method-after nil)) - ) - (setq lambdas (append tlambdas lambdas) - keys (append (make-list (length tlambdas) method-after) keys)) - - ;; :primary methods - (setq tlambdas - (or (and mclass (eieio-generic-form method method-primary mclass)) - (eieio-generic-form method method-primary nil))) - (when tlambdas - (setq lambdas (cons tlambdas lambdas) - keys (cons method-primary keys) - primarymethodlist - (eieiomt-method-list method method-primary mclass))) - - ;; :before methods - (setq tlambdas - (if mclass - (eieiomt-method-list method method-before mclass) - (list (eieio-generic-form method method-before nil))) - ;;(or (and mclass (eieio-generic-form method method-before mclass)) - ;; (eieio-generic-form method method-before nil)) - ) - (setq lambdas (append tlambdas lambdas) - keys (append (make-list (length tlambdas) method-before) keys)) - ) - - (if mclass - ;; For the case of a class, - ;; if there were no methods found, then there could be :static methods. - (when (not lambdas) - (setq tlambdas - (eieio-generic-form method method-static mclass)) - (setq lambdas (cons tlambdas lambdas) - keys (cons method-static keys) - primarymethodlist ;; Re-use even with bad name here - (eieiomt-method-list method method-static mclass))) - ;; For the case of no class (ie - mclass == nil) then there may - ;; be a primary method. - (setq tlambdas - (eieio-generic-form method method-primary nil)) - (when tlambdas - (setq lambdas (cons tlambdas lambdas) - keys (cons method-primary keys) - primarymethodlist - (eieiomt-method-list method method-primary nil))) - ) - - (run-hook-with-args 'eieio-pre-method-execution-functions - primarymethodlist) - - ;; Now loop through all occurrences forms which we must execute - ;; (which are happily sorted now) and execute them all! - (let ((rval nil) (lastval nil) (rvalever nil) (found nil)) - (while lambdas - (if (car lambdas) - (eieio--with-scoped-class (cdr (car lambdas)) - (let* ((eieio-generic-call-key (car keys)) - (has-return-val - (or (= eieio-generic-call-key method-primary) - (= eieio-generic-call-key method-static))) - (eieio-generic-call-next-method-list - ;; Use the cdr, as the first element is the fcn - ;; we are calling right now. - (when has-return-val (cdr primarymethodlist))) - ) - (setq found t) - ;;(setq rval (apply (car (car lambdas)) newargs)) - (setq lastval (apply (car (car lambdas)) newargs)) - (when has-return-val - (setq rval lastval - rvalever t)) - ))) - (setq lambdas (cdr lambdas) - keys (cdr keys))) - (if (not found) - (if (eieio-object-p (car args)) - (setq rval (apply 'no-applicable-method (car args) method args) - rvalever t) - (signal - 'no-method-definition - (list method args)))) - ;; Right Here... it could be that lastval is returned when - ;; rvalever is nil. Is that right? - rval))) - -(defun eieio-generic-call-primary-only (method args) - "Call METHOD with ARGS for methods with only :PRIMARY implementations. -ARGS provides the context on which implementation to use. -This should only be called from a generic function. - -This method is like `eieio-generic-call', but only -implementations in the :PRIMARY slot are queried. After many -years of use, it appears that over 90% of methods in use -have :PRIMARY implementations only. We can therefore optimize -for this common case to improve performance." - ;; We must expand our arguments first as they are always - ;; passed in as quoted symbols - (let ((newargs nil) (mclass nil) (lambdas nil) - (eieio-generic-call-methodname method) - (eieio-generic-call-arglst args) - (firstarg nil) - (primarymethodlist nil) - ) - ;; get a copy - (setq newargs args - firstarg (car newargs)) - - ;; Determine the class to use. - (cond ((eieio-object-p firstarg) - (setq mclass (eieio--object-class firstarg))) - ((not firstarg) - (error "Method %s called on nil" method)) - ((not (eieio-object-p firstarg)) - (error "Primary-only method %s called on something not an object" method)) - (t - (error "EIEIO Error: Improperly classified method %s as primary only" - method) - )) - ;; Make sure the class is a valid class - ;; mclass can be nil (meaning a generic for should be used. - ;; mclass cannot have a value that is not a class, however. - (when (null mclass) - (error "Cannot dispatch method %S on class %S" method mclass) - ) - - ;; :primary methods - (setq lambdas (eieio-generic-form method method-primary mclass)) - (setq primarymethodlist ;; Re-use even with bad name here - (eieiomt-method-list method method-primary mclass)) - - ;; Now loop through all occurrences forms which we must execute - ;; (which are happily sorted now) and execute them all! - (eieio--with-scoped-class (cdr lambdas) - (let* ((rval nil) (lastval nil) (rvalever nil) - (eieio-generic-call-key method-primary) - ;; Use the cdr, as the first element is the fcn - ;; we are calling right now. - (eieio-generic-call-next-method-list (cdr primarymethodlist)) - ) +(define-error 'invalid-slot-name "Invalid slot name") +(define-error 'invalid-slot-type "Invalid slot type") +(define-error 'unbound-slot "Unbound slot") +(define-error 'inconsistent-class-hierarchy "Inconsistent class hierarchy") + +;;; Hooking into cl-generic. + +(require 'cl-generic) + +;;;; General support to dispatch based on the type of the argument. + +(add-function :before-until cl-generic-tagcode-function + #'eieio--generic-tagcode) +(defun eieio--generic-tagcode (type name) + ;; CLHS says: + ;; A class must be defined before it can be used as a parameter + ;; specializer in a defmethod form. + ;; So we can ignore types that are not known to denote classes. + (and (class-p type) + ;; Prefer (aref ,name 0) over (eieio--class-tag ,name) so that + ;; the tagcode is identical to the tagcode used for cl-struct. + `(50 . (and (vectorp ,name) (aref ,name 0))))) + +(add-function :before-until cl-generic-tag-types-function + #'eieio--generic-tag-types) +(defun eieio--generic-tag-types (tag) + (and (symbolp tag) (boundp tag) (eieio--class-p (symbol-value tag)) + (mapcar #'eieio--class-symbol + (eieio--class-precedence-list (symbol-value tag))))) + +;;;; Dispatch for arguments which are classes. + +;; Since EIEIO does not support metaclasses, users can't easily use the +;; "dispatch on argument type" for class arguments. That's why EIEIO's +;; `defmethod' added the :static qualifier. For cl-generic, such a qualifier +;; would not make much sense (e.g. to which argument should it apply?). +;; Instead, we add a new "subclass" specializer. + +(add-function :before-until cl-generic-tagcode-function + #'eieio--generic-subclass-tagcode) +(defun eieio--generic-subclass-tagcode (type name) + (when (eq 'subclass (car-safe type)) + `(60 . (and (symbolp ,name) (eieio--class-v ,name))))) + +(add-function :before-until cl-generic-tag-types-function + #'eieio--generic-subclass-tag-types) +(defun eieio--generic-subclass-tag-types (tag) + (when (eieio--class-p tag) + (mapcar (lambda (class) + `(subclass + ,(if (symbolp class) class (eieio--class-symbol class)))) + (eieio--class-precedence-list tag)))) - (if (or (not lambdas) (not (car lambdas))) + +;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "b568ffb3c90ed5d0ae673f0051d608ee") +;;; Generated autoloads from eieio-compat.el - ;; No methods found for this impl... - (if (eieio-object-p (car args)) - (setq rval (apply 'no-applicable-method (car args) method args) - rvalever t) - (signal - 'no-method-definition - (list method args))) +(autoload 'eieio--defalias "eieio-compat" "\ +Like `defalias', but with less side-effects. +More specifically, it has no side-effects at all when the new function +definition is the same (`eq') as the old one. - ;; Do the regular implementation here. +\(fn NAME BODY)" nil nil) - (run-hook-with-args 'eieio-pre-method-execution-functions - lambdas) +(autoload 'defgeneric "eieio-compat" "\ +Create a generic function METHOD. +DOC-STRING is the base documentation for this class. A generic +function has no body, as its purpose is to decide which method body +is appropriate to use. Uses `defmethod' to create methods, and calls +`defgeneric' for you. With this implementation the ARGS are +currently ignored. You can use `defgeneric' to apply specialized +top level documentation to a method. - (setq lastval (apply (car lambdas) newargs)) - (setq rval lastval - rvalever t) - ) +\(fn METHOD ARGS &optional DOC-STRING)" nil t) - ;; Right Here... it could be that lastval is returned when - ;; rvalever is nil. Is that right? - rval)))) - -(defun eieiomt-method-list (method key class) - "Return an alist list of methods lambdas. -METHOD is the method name. -KEY represents either :before, or :after methods. -CLASS is the starting class to search from in the method tree. -If CLASS is nil, then an empty list of methods should be returned." - ;; Note: eieiomt - the MT means MethodTree. See more comments below - ;; for the rest of the eieiomt methods. - - ;; Collect lambda expressions stored for the class and its parent - ;; classes. - (let (lambdas) - (dolist (ancestor (eieio-class-precedence-list class)) - ;; Lookup the form to use for the PRIMARY object for the next level - (let ((tmpl (eieio-generic-form method key ancestor))) - (when (and tmpl - (or (not lambdas) - ;; This prevents duplicates coming out of the - ;; class method optimizer. Perhaps we should - ;; just not optimize before/afters? - (not (member tmpl lambdas)))) - (push tmpl lambdas)))) - - ;; Return collected lambda. For :after methods, return in current - ;; order (most general class last); Otherwise, reverse order. - (if (eq key method-after) - lambdas - (nreverse lambdas)))) +(function-put 'defgeneric 'doc-string-elt '3) + +(make-obsolete 'defgeneric 'cl-defgeneric '"25.1") + +(autoload 'defmethod "eieio-compat" "\ +Create a new METHOD through `defgeneric' with ARGS. + +The optional second argument KEY is a specifier that +modifies how the method is called, including: + :before - Method will be called before the :primary + :primary - The default if not specified + :after - Method will be called after the :primary + :static - First arg could be an object or class +The next argument is the ARGLIST. The ARGLIST specifies the arguments +to the method as with `defun'. The first argument can have a type +specifier, such as: + ((VARNAME CLASS) ARG2 ...) +where VARNAME is the name of the local variable for the method being +created. The CLASS is a class symbol for a class made with `defclass'. +A DOCSTRING comes after the ARGLIST, and is optional. +All the rest of the args are the BODY of the method. A method will +return the value of the last form in the BODY. + +Summary: + + (defmethod mymethod [:before | :primary | :after | :static] + ((typearg class-name) arg2 &optional opt &rest rest) + \"doc-string\" + body) + +\(fn METHOD &rest ARGS)" nil t) + +(function-put 'defmethod 'doc-string-elt '3) + +(make-obsolete 'defmethod 'cl-defmethod '"25.1") + +(autoload 'eieio--defgeneric-init-form "eieio-compat" "\ + + +\(fn METHOD DOC-STRING)" nil nil) + +(autoload 'eieio--defmethod "eieio-compat" "\ - -;;; -;; eieio-method-tree : eieiomt- -;; -;; Stored as eieio-method-tree in property list of a generic method -;; -;; (eieio-method-tree . [BEFORE PRIMARY AFTER -;; genericBEFORE genericPRIMARY genericAFTER]) -;; and -;; (eieio-method-obarray . [BEFORE PRIMARY AFTER -;; genericBEFORE genericPRIMARY genericAFTER]) -;; where the association is a vector. -;; (aref 0 -- all static methods. -;; (aref 1 -- all methods classified as :before -;; (aref 2 -- all methods classified as :primary -;; (aref 3 -- all methods classified as :after -;; (aref 4 -- a generic classified as :before -;; (aref 5 -- a generic classified as :primary -;; (aref 6 -- a generic classified as :after -;; -(defvar eieiomt-optimizing-obarray nil - "While mapping atoms, this contain the obarray being optimized.") - -(defun eieiomt-install (method-name) - "Install the method tree, and obarray onto METHOD-NAME. -Do not do the work if they already exist." - (let ((emtv (get method-name 'eieio-method-tree)) - (emto (get method-name 'eieio-method-obarray))) - (if (or (not emtv) (not emto)) - (progn - (setq emtv (put method-name 'eieio-method-tree - (make-vector method-num-slots nil)) - emto (put method-name 'eieio-method-obarray - (make-vector method-num-slots nil))) - (aset emto 0 (make-vector 11 0)) - (aset emto 1 (make-vector 11 0)) - (aset emto 2 (make-vector 41 0)) - (aset emto 3 (make-vector 11 0)) - )))) - -(defun eieiomt-add (method-name method key class) - "Add to METHOD-NAME the forms METHOD in a call position KEY for CLASS. -METHOD-NAME is the name created by a call to `defgeneric'. -METHOD are the forms for a given implementation. -KEY is an integer (see comment in eieio.el near this function) which -is associated with the :static :before :primary and :after tags. -It also indicates if CLASS is defined or not. -CLASS is the class this method is associated with." - (if (or (> key method-num-slots) (< key 0)) - (error "eieiomt-add: method key error!")) - (let ((emtv (get method-name 'eieio-method-tree)) - (emto (get method-name 'eieio-method-obarray))) - ;; Make sure the method tables are available. - (if (or (not emtv) (not emto)) - (error "Programmer error: eieiomt-add")) - ;; only add new cells on if it doesn't already exist! - (if (assq class (aref emtv key)) - (setcdr (assq class (aref emtv key)) method) - (aset emtv key (cons (cons class method) (aref emtv key)))) - ;; Add function definition into newly created symbol, and store - ;; said symbol in the correct obarray, otherwise use the - ;; other array to keep this stuff - (if (< key method-num-lists) - (let ((nsym (intern (symbol-name class) (aref emto key)))) - (fset nsym method))) - ;; Save the defmethod file location in a symbol property. - (let ((fname (if load-in-progress - load-file-name - buffer-file-name)) - loc) - (when fname - (when (string-match "\\.elc$" fname) - (setq fname (substring fname 0 (1- (length fname))))) - (setq loc (get method-name 'method-locations)) - (pushnew (list class fname) loc :test 'equal) - (put method-name 'method-locations loc))) - ;; Now optimize the entire obarray - (if (< key method-num-lists) - (let ((eieiomt-optimizing-obarray (aref emto key))) - ;; @todo - Is this overkill? Should we just clear the symbol? - (mapatoms 'eieiomt-sym-optimize eieiomt-optimizing-obarray))) - )) -(defun eieiomt-next (class) - "Return the next parent class for CLASS. -If CLASS is a superclass, return variable `eieio-default-superclass'. -If CLASS is variable `eieio-default-superclass' then return nil. -This is different from function `class-parent' as class parent returns -nil for superclasses. This function performs no type checking!" - ;; No type-checking because all calls are made from functions which - ;; are safe and do checking for us. - (or (eieio-class-parents-fast class) - (if (eq class 'eieio-default-superclass) - nil - '(eieio-default-superclass)))) - -(defun eieiomt-sym-optimize (s) - "Find the next class above S which has a function body for the optimizer." - ;; Set the value to nil in case there is no nearest cell. - (set s nil) - ;; Find the nearest cell that has a function body. If we find one, - ;; we replace the nil from above. - (let ((external-symbol (intern-soft (symbol-name s)))) - (catch 'done - (dolist (ancestor (rest (eieio-class-precedence-list external-symbol))) - (let ((ov (intern-soft (symbol-name ancestor) - eieiomt-optimizing-obarray))) - (when (fboundp ov) - (set s ov) ;; store ov as our next symbol - (throw 'done ancestor))))))) - -(defun eieio-generic-form (method key class) - "Return the lambda form belonging to METHOD using KEY based upon CLASS. -If CLASS is not a class then use `generic' instead. If class has -no form, but has a parent class, then trace to that parent class. -The first time a form is requested from a symbol, an optimized path -is memorized for faster future use." - (let ((emto (aref (get method 'eieio-method-obarray) - (if class key (eieio-specialized-key-to-generic-key key))))) - (if (class-p class) - ;; 1) find our symbol - (let ((cs (intern-soft (symbol-name class) emto))) - (if (not cs) - ;; 2) If there isn't one, then make one. - ;; This can be slow since it only occurs once - (progn - (setq cs (intern (symbol-name class) emto)) - ;; 2.1) Cache its nearest neighbor with a quick optimize - ;; which should only occur once for this call ever - (let ((eieiomt-optimizing-obarray emto)) - (eieiomt-sym-optimize cs)))) - ;; 3) If it's bound return this one. - (if (fboundp cs) - (cons cs (eieio--class-symbol (class-v class))) - ;; 4) If it's not bound then this variable knows something - (if (symbol-value cs) - (progn - ;; 4.1) This symbol holds the next class in its value - (setq class (symbol-value cs) - cs (intern-soft (symbol-name class) emto)) - ;; 4.2) The optimizer should always have chosen a - ;; function-symbol - ;;(if (fboundp cs) - (cons cs (eieio--class-symbol (class-v (intern (symbol-name class))))) - ;;(error "EIEIO optimizer: erratic data loss!")) - ) - ;; There never will be a funcall... - nil))) - ;; for a generic call, what is a list, is the function body we want. - (let ((emtl (aref (get method 'eieio-method-tree) - (if class key (eieio-specialized-key-to-generic-key key))))) - (if emtl - ;; The car of EMTL is supposed to be a class, which in this - ;; case is nil, so skip it. - (cons (cdr (car emtl)) nil) - nil))))) +\(fn METHOD KIND ARGCLASS CODE)" nil nil) +(autoload 'eieio-defmethod "eieio-compat" "\ +Obsolete work part of an old version of the `defmethod' macro. + +\(fn METHOD ARGS)" nil nil) + +(make-obsolete 'eieio-defmethod 'cl-defmethod '"24.1") + +(autoload 'eieio-defgeneric "eieio-compat" "\ +Obsolete work part of an old version of the `defgeneric' macro. + +\(fn METHOD DOC-STRING)" nil nil) + +(make-obsolete 'eieio-defgeneric 'cl-defgeneric '"24.1") + +(autoload 'eieio-defclass "eieio-compat" "\ + + +\(fn CNAME SUPERCLASSES SLOTS OPTIONS)" nil nil) + +(make-obsolete 'eieio-defclass 'eieio-defclass-internal '"25.1") + +;;;*** -;;; Here are some special types of errors -;; -(intern "no-method-definition") -(put 'no-method-definition 'error-conditions '(no-method-definition error)) -(put 'no-method-definition 'error-message "No method definition") - -(intern "no-next-method") -(put 'no-next-method 'error-conditions '(no-next-method error)) -(put 'no-next-method 'error-message "No next method") - -(intern "invalid-slot-name") -(put 'invalid-slot-name 'error-conditions '(invalid-slot-name error)) -(put 'invalid-slot-name 'error-message "Invalid slot name") - -(intern "invalid-slot-type") -(put 'invalid-slot-type 'error-conditions '(invalid-slot-type error nil)) -(put 'invalid-slot-type 'error-message "Invalid slot type") - -(intern "unbound-slot") -(put 'unbound-slot 'error-conditions '(unbound-slot error nil)) -(put 'unbound-slot 'error-message "Unbound slot") - -(intern "inconsistent-class-hierarchy") -(put 'inconsistent-class-hierarchy 'error-conditions - '(inconsistent-class-hierarchy error nil)) -(put 'inconsistent-class-hierarchy 'error-message "Inconsistent class hierarchy") - -;;; Obsolete backward compatibility functions. -;; Needed to run byte-code compiled with the EIEIO of Emacs-23. - -(defun eieio-defmethod (method args) - "Obsolete work part of an old version of the `defmethod' macro." - (let ((key nil) (body nil) (firstarg nil) (argfix nil) (argclass nil) loopa) - ;; find optional keys - (setq key - (cond ((memq (car args) '(:BEFORE :before)) - (setq args (cdr args)) - method-before) - ((memq (car args) '(:AFTER :after)) - (setq args (cdr args)) - method-after) - ((memq (car args) '(:STATIC :static)) - (setq args (cdr args)) - method-static) - ((memq (car args) '(:PRIMARY :primary)) - (setq args (cdr args)) - method-primary) - ;; Primary key. - (t method-primary))) - ;; Get body, and fix contents of args to be the arguments of the fn. - (setq body (cdr args) - args (car args)) - (setq loopa args) - ;; Create a fixed version of the arguments. - (while loopa - (setq argfix (cons (if (listp (car loopa)) (car (car loopa)) (car loopa)) - argfix)) - (setq loopa (cdr loopa))) - ;; Make sure there is a generic. - (eieio-defgeneric - method - (if (stringp (car body)) - (car body) (format "Generically created method `%s'." method))) - ;; create symbol for property to bind to. If the first arg is of - ;; the form (varname vartype) and `vartype' is a class, then - ;; that class will be the type symbol. If not, then it will fall - ;; under the type `primary' which is a non-specific calling of the - ;; function. - (setq firstarg (car args)) - (if (listp firstarg) - (progn - (setq argclass (nth 1 firstarg)) - (if (not (class-p argclass)) - (error "Unknown class type %s in method parameters" - (nth 1 firstarg)))) - ;; Generics are higher. - (setq key (eieio-specialized-key-to-generic-key key))) - ;; Put this lambda into the symbol so we can find it. - (if (byte-code-function-p (car-safe body)) - (eieiomt-add method (car-safe body) key argclass) - (eieiomt-add method (append (list 'lambda (reverse argfix)) body) - key argclass)) - ) - - (when eieio-optimize-primary-methods-flag - ;; Optimizing step: - ;; - ;; If this method, after this setup, only has primary methods, then - ;; we can setup the generic that way. - (if (generic-primary-only-p method) - ;; If there is only one primary method, then we can go one more - ;; optimization step. - (if (generic-primary-only-one-p method) - (eieio-defgeneric-reset-generic-form-primary-only-one method) - (eieio-defgeneric-reset-generic-form-primary-only method)) - (eieio-defgeneric-reset-generic-form method))) - - method) -(make-obsolete 'eieio-defmethod 'eieio--defmethod "24.1") - -(defun eieio-defgeneric (method doc-string) - "Obsolete work part of an old version of the `defgeneric' macro." - (if (and (fboundp method) (not (generic-p method)) - (or (byte-code-function-p (symbol-function method)) - (not (eq 'autoload (car (symbol-function method))))) - ) - (error "You cannot create a generic/method over an existing symbol: %s" - method)) - ;; Don't do this over and over. - (unless (fboundp 'method) - ;; This defun tells emacs where the first definition of this - ;; method is defined. - `(defun ,method nil) - ;; Make sure the method tables are installed. - (eieiomt-install method) - ;; Apply the actual body of this function. - (fset method (eieio-defgeneric-form method doc-string)) - ;; Return the method - 'method)) -(make-obsolete 'eieio-defgeneric nil "24.1") (provide 'eieio-core) diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el index 84450d8dfb1..0e0b31e4e7e 100644 --- a/lisp/emacs-lisp/eieio-custom.el +++ b/lisp/emacs-lisp/eieio-custom.el @@ -1,4 +1,4 @@ -;;; eieio-custom.el -- eieio object customization +;;; eieio-custom.el -- eieio object customization -*- lexical-binding:t -*- ;; Copyright (C) 1999-2001, 2005, 2007-2015 Free Software Foundation, ;; Inc. @@ -70,7 +70,7 @@ of these.") :documentation "A number of thingies.")) "A class for testing the widget on.") -(defcustom eieio-widget-test (eieio-widget-test-class "Foo") +(defcustom eieio-widget-test (eieio-widget-test-class) "Test variable for editing an object." :type 'object :group 'eieio) @@ -136,7 +136,7 @@ Updates occur regardless of the current customization group.") )) (widget-value-set vc (widget-value vc)))) -(defun eieio-custom-toggle-parent (widget &rest ignore) +(defun eieio-custom-toggle-parent (widget &rest _) "Toggle visibility of parent of WIDGET. Optional argument IGNORE is an extraneous parameter." (eieio-custom-toggle-hide (widget-get widget :parent))) @@ -154,7 +154,7 @@ Optional argument IGNORE is an extraneous parameter." :clone-object-children nil ) -(defun eieio-object-match (widget value) +(defun eieio-object-match (_widget _value) "Match info for WIDGET against VALUE." ;; Write me t) @@ -184,7 +184,7 @@ Optional argument IGNORE is an extraneous parameter." (if (not (widget-get widget :value)) (widget-put widget :value (cond ((widget-get widget :objecttype) - (funcall (class-constructor + (funcall (eieio--class-constructor (widget-get widget :objecttype)) "Custom-new")) ((widget-get widget :objectcreatefcn) @@ -193,7 +193,7 @@ Optional argument IGNORE is an extraneous parameter." (let* ((chil nil) (obj (widget-get widget :value)) (master-group (widget-get widget :eieio-group)) - (cv (class-v (eieio--object-class obj))) + (cv (eieio--object-class-object obj)) (slots (eieio--class-public-a cv)) (flabel (eieio--class-public-custom-label cv)) (fgroup (eieio--class-public-custom-group cv)) @@ -208,7 +208,8 @@ Optional argument IGNORE is an extraneous parameter." chil))) ;; Display information about the group being shown (when master-group - (let ((groups (class-option (eieio--object-class obj) :custom-groups))) + (let ((groups (eieio--class-option (eieio--object-class-object obj) + :custom-groups))) (widget-insert "Groups:") (while groups (widget-insert " ") @@ -216,7 +217,7 @@ Optional argument IGNORE is an extraneous parameter." (widget-insert "*" (capitalize (symbol-name master-group)) "*") (widget-create 'push-button :thing (cons obj (car groups)) - :notify (lambda (widget &rest stuff) + :notify (lambda (widget &rest _) (eieio-customize-object (car (widget-get widget :thing)) (cdr (widget-get widget :thing)))) @@ -260,8 +261,8 @@ Optional argument IGNORE is an extraneous parameter." (car flabel) (let ((s (symbol-name (or - (class-slot-initarg - (eieio--object-class obj) + (eieio--class-slot-initarg + (eieio--object-class-object obj) (car slots)) (car slots))))) (capitalize @@ -288,7 +289,7 @@ Optional argument IGNORE is an extraneous parameter." "Get the value of WIDGET." (let* ((obj (widget-get widget :value)) (master-group eieio-cog) - (cv (class-v (eieio--object-class obj))) + (cv (eieio--object-class-object obj)) (fgroup (eieio--class-public-custom-group cv)) (wids (widget-get widget :children)) (name (if (widget-get widget :eieio-show-name) @@ -296,7 +297,7 @@ Optional argument IGNORE is an extraneous parameter." nil)) (chil (if (widget-get widget :eieio-show-name) (nthcdr 1 wids) wids)) - (cv (class-v (eieio--object-class obj))) + (cv (eieio--object-class-object obj)) (slots (eieio--class-public-a cv)) (fcust (eieio--class-public-custom cv))) ;; If there are any prefix widgets, clear them. @@ -317,11 +318,11 @@ Optional argument IGNORE is an extraneous parameter." fgroup (cdr fgroup) fcust (cdr fcust))) ;; Set any name updates on it. - (if name (setf (eieio--object-name obj) name)) + (if name (eieio-object-set-name-string obj name)) ;; This is the same object we had before. obj)) -(defmethod eieio-done-customizing ((obj eieio-default-superclass)) +(cl-defmethod eieio-done-customizing ((_obj eieio-default-superclass)) "When applying change to a widget, call this method. This method is called by the default widget-edit commands. User made commands should also call this method when applying changes. @@ -344,7 +345,7 @@ Optional argument GROUP is the sub-group of slots to display." "Major mode for customizing EIEIO objects. \\{eieio-custom-mode-map}") -(defmethod eieio-customize-object ((obj eieio-default-superclass) +(cl-defmethod eieio-customize-object ((obj eieio-default-superclass) &optional group) "Customize OBJ in a specialized custom buffer. To override call the `eieio-custom-widget-insert' to just insert the @@ -383,20 +384,20 @@ These groups are specified with the `:group' slot flag." (make-local-variable 'eieio-co) (setq eieio-co obj) (make-local-variable 'eieio-cog) - (setq eieio-cog group))) + (setq eieio-cog g))) -(defmethod eieio-custom-object-apply-reset ((obj eieio-default-superclass)) +(cl-defmethod eieio-custom-object-apply-reset ((_obj eieio-default-superclass)) "Insert an Apply and Reset button into the object editor. Argument OBJ is the object being customized." (widget-create 'push-button - :notify (lambda (&rest ignore) + :notify (lambda (&rest _) (widget-apply eieio-wo :value-get) (eieio-done-customizing eieio-co) (bury-buffer)) "Accept") (widget-insert " ") (widget-create 'push-button - :notify (lambda (&rest ignore) + :notify (lambda (&rest _) ;; I think the act of getting it sets ;; its value through the get function. (message "Applying Changes...") @@ -406,17 +407,17 @@ Argument OBJ is the object being customized." "Apply") (widget-insert " ") (widget-create 'push-button - :notify (lambda (&rest ignore) + :notify (lambda (&rest _) (message "Resetting") (eieio-customize-object eieio-co eieio-cog)) "Reset") (widget-insert " ") (widget-create 'push-button - :notify (lambda (&rest ignore) + :notify (lambda (&rest _) (bury-buffer)) "Cancel")) -(defmethod eieio-custom-widget-insert ((obj eieio-default-superclass) +(cl-defmethod eieio-custom-widget-insert ((obj eieio-default-superclass) &rest flags) "Insert the widget used for editing object OBJ in the current buffer. Arguments FLAGS are widget compatible flags. @@ -431,13 +432,11 @@ Must return the created widget." :clone-object-children t ) -(defun eieio-object-value-to-abstract (widget value) +(defun eieio-object-value-to-abstract (_widget value) "For WIDGET, convert VALUE to an abstract /safe/ representation." - (if (eieio-object-p value) value - (if (null value) value - nil))) + (if (eieio-object-p value) value)) -(defun eieio-object-abstract-to-value (widget value) +(defun eieio-object-abstract-to-value (_widget value) "For WIDGET, convert VALUE from an abstract /safe/ representation." value) @@ -447,21 +446,22 @@ Must return the created widget." ;; These functions provide the ability to create dynamic menus to ;; customize specific sections of an object. They do not hook directly ;; into a filter, but can be used to create easymenu vectors. -(defmethod eieio-customize-object-group ((obj eieio-default-superclass)) +(cl-defmethod eieio-customize-object-group ((obj eieio-default-superclass)) "Create a list of vectors for customizing sections of OBJ." (mapcar (lambda (group) (vector (concat "Group " (symbol-name group)) (list 'customize-object obj (list 'quote group)) t)) - (class-option (eieio--object-class obj) :custom-groups))) + (eieio--class-option (eieio--object-class-object obj) :custom-groups))) (defvar eieio-read-custom-group-history nil "History for the custom group reader.") -(defmethod eieio-read-customization-group ((obj eieio-default-superclass)) +(cl-defmethod eieio-read-customization-group ((obj eieio-default-superclass)) "Do a completing read on the name of a customization group in OBJ. Return the symbol for the group, or nil" - (let ((g (class-option (eieio--object-class obj) :custom-groups))) + (let ((g (eieio--class-option (eieio--object-class-object obj) + :custom-groups))) (if (= (length g) 1) (car g) ;; Make the association list diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el index 0a51ecfa203..119f7cce038 100644 --- a/lisp/emacs-lisp/eieio-datadebug.el +++ b/lisp/emacs-lisp/eieio-datadebug.el @@ -1,4 +1,4 @@ -;;; eieio-datadebug.el --- EIEIO extensions to the data debugger. +;;; eieio-datadebug.el --- EIEIO extensions to the data debugger. -*- lexical-binding:t -*- ;; Copyright (C) 2007-2015 Free Software Foundation, Inc. @@ -79,7 +79,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button." ;; ;; Each object should have an opportunity to show stuff about itself. -(defmethod data-debug/eieio-insert-slots ((obj eieio-default-superclass) +(cl-defmethod data-debug/eieio-insert-slots ((obj eieio-default-superclass) prefix) "Insert the slots of OBJ into the current DDEBUG buffer." (let ((inhibit-read-only t)) @@ -87,8 +87,8 @@ PREBUTTONTEXT is some text between PREFIX and the object button." prefix "Name: ") (let* ((cl (eieio-object-class obj)) - (cv (class-v cl))) - (data-debug-insert-thing (class-constructor cl) + (cv (eieio--class-v cl))) + (data-debug-insert-thing (eieio--class-constructor cl) prefix "Class: ") ;; Loop over all the public slots @@ -96,7 +96,8 @@ PREBUTTONTEXT is some text between PREFIX and the object button." ) (while publa (if (slot-boundp obj (car publa)) - (let* ((i (class-slot-initarg cl (car publa))) + (let* ((i (eieio--class-slot-initarg (eieio--class-v cl) + (car publa))) (v (eieio-oref obj (car publa)))) (data-debug-insert-thing v prefix (concat @@ -104,7 +105,8 @@ PREBUTTONTEXT is some text between PREFIX and the object button." (symbol-name (car publa))) " "))) ;; Unbound case - (let ((i (class-slot-initarg cl (car publa)))) + (let ((i (eieio--class-slot-initarg (eieio--class-v cl) + (car publa)))) (data-debug-insert-custom "#unbound" prefix (concat (if i (symbol-name i) @@ -122,27 +124,11 @@ PREBUTTONTEXT is some text between PREFIX and the object button." ;; ;; A generic function to run DDEBUG on an object and popup a new buffer. ;; -(defmethod data-debug-show ((obj eieio-default-superclass)) +(cl-defmethod data-debug-show ((obj eieio-default-superclass)) "Run ddebug against any EIEIO object OBJ." (data-debug-new-buffer (format "*%s DDEBUG*" (eieio-object-name obj))) (data-debug-insert-object-slots obj "]")) -;;; DEBUG FUNCTIONS -;; -(defun eieio-debug-methodinvoke (method class) - "Show the method invocation order for METHOD with CLASS object." - (interactive "aMethod: \nXClass Expression: ") - (let* ((eieio-pre-method-execution-functions - (lambda (l) (throw 'moose l) )) - (data - (catch 'moose (eieio-generic-call - method (list class)))) - (buf (data-debug-new-buffer "*Method Invocation*")) - (data2 (mapcar (lambda (sym) - (symbol-function (car sym))) - data))) - (data-debug-insert-thing data2 ">" ""))) - (provide 'eieio-datadebug) ;;; eieio-datadebug.el ends here diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index 21843025efd..8d40edf5624 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -60,7 +60,7 @@ Argument PREFIX is the character prefix to use. Argument CH-PREFIX is another character prefix to display." (eieio--check-type class-p this-root) (let ((myname (symbol-name this-root)) - (chl (eieio--class-children (class-v this-root))) + (chl (eieio--class-children (eieio--class-v this-root))) (fprefix (concat ch-prefix " +--")) (mprefix (concat ch-prefix " | ")) (lprefix (concat ch-prefix " "))) @@ -81,7 +81,7 @@ If CLASS is actually an object, then also display current values of that object. ;; Header line (prin1 class) (insert " is a" - (if (class-option class :abstract) + (if (eieio--class-option (eieio--class-v class) :abstract) "n abstract" "") " class") @@ -122,34 +122,23 @@ If CLASS is actually an object, then also display current values of that object. ;; Describe all the slots in this class. (eieio-help-class-slots class) ;; Describe all the methods specific to this class. - (let ((methods (eieio-all-generic-functions class)) - (type [":STATIC" ":BEFORE" ":PRIMARY" ":AFTER"]) - counter doc) - (when methods + (let ((generics (eieio-all-generic-functions class))) + (when generics (insert (propertize "Specialized Methods:\n\n" 'face 'bold)) - (while methods - (setq doc (eieio-method-documentation (car methods) class)) - (insert "`") - (help-insert-xref-button (symbol-name (car methods)) - 'help-function (car methods)) - (insert "'") - (if (not doc) - (insert " Undocumented") - (setq counter 0) - (dolist (cur doc) - (when cur - (insert " " (aref type counter) " " - (prin1-to-string (car cur) (current-buffer)) - "\n" - (or (cdr cur) ""))) - (setq counter (1+ counter)))) - (insert "\n\n") - (setq methods (cdr methods)))))) + (dolist (generic generics) + (insert "`") + (help-insert-xref-button (symbol-name generic) 'help-function generic) + (insert "'") + (pcase-dolist (`(,qualifiers ,args ,doc) + (eieio-method-documentation generic class)) + (insert (format " %s%S\n" qualifiers args) + (or doc ""))) + (insert "\n\n"))))) (defun eieio-help-class-slots (class) "Print help description for the slots in CLASS. Outputs to the current buffer." - (let* ((cv (class-v class)) + (let* ((cv (eieio--class-v class)) (docs (eieio--class-public-doc cv)) (names (eieio--class-public-a cv)) (deflt (eieio--class-public-d cv)) @@ -218,11 +207,10 @@ Outputs to the current buffer." (defun eieio-build-class-list (class) "Return a list of all classes that inherit from CLASS." (if (class-p class) - (apply #'append - (mapcar - (lambda (c) - (append (list c) (eieio-build-class-list c))) - (eieio-class-children-fast class))) + (cl-mapcan + (lambda (c) + (append (list c) (eieio-build-class-list c))) + (eieio--class-children (eieio--class-v class))) (list class))) (defun eieio-build-class-alist (&optional class instantiable-only buildlist) @@ -231,15 +219,16 @@ Optional argument CLASS is the class to start with. If INSTANTIABLE-ONLY is non nil, only allow names of classes which are not abstract, otherwise allow all classes. Optional argument BUILDLIST is more list to attach and is used internally." - (let* ((cc (or class eieio-default-superclass)) - (sublst (eieio--class-children (class-v cc)))) + (let* ((cc (or class 'eieio-default-superclass)) + (sublst (eieio--class-children (eieio--class-v cc)))) (unless (assoc (symbol-name cc) buildlist) (when (or (not instantiable-only) (not (class-abstract-p cc))) + ;; FIXME: Completion tables don't need alists, and ede/generic.el needs + ;; the symbols rather than their names. (setq buildlist (cons (cons (symbol-name cc) 1) buildlist)))) - (while sublst + (dolist (elem sublst) (setq buildlist (eieio-build-class-alist - (car sublst) instantiable-only buildlist)) - (setq sublst (cdr sublst))) + elem instantiable-only buildlist))) buildlist)) (defvar eieio-read-class nil @@ -311,140 +300,50 @@ are not abstract." (eieio-help-class ctr)) )))) - -;;;###autoload -(defun eieio-help-generic (generic) - "Describe GENERIC if it is a generic function." - (when (and (symbolp generic) (generic-p generic)) - (save-excursion - (goto-char (point-min)) - (when (re-search-forward " in `.+'.$" nil t) - (replace-match "."))) - (save-excursion - (insert "\n\nThis is a generic function" - (cond - ((and (generic-primary-only-p generic) - (generic-primary-only-one-p generic)) - " with only one primary method") - ((generic-primary-only-p generic) - " with only primary methods") - (t "")) - ".\n\n") - (insert (propertize "Implementations:\n\n" 'face 'bold)) - (let ((i 4) - (prefix [ ":STATIC" ":BEFORE" ":PRIMARY" ":AFTER" ] )) - ;; Loop over fanciful generics - (while (< i 7) - (let ((gm (aref (get generic 'eieio-method-tree) i))) - (when gm - (insert "Generic " - (aref prefix (- i 3)) - "\n" - (or (nth 2 gm) "Undocumented") - "\n\n"))) - (setq i (1+ i))) - (setq i 0) - ;; Loop over defined class-specific methods - (while (< i 4) - (let* ((gm (reverse (aref (get generic 'eieio-method-tree) i))) - cname location) - (while gm - (setq cname (caar gm)) - (insert "`") - (help-insert-xref-button (symbol-name cname) - 'help-variable cname) - (insert "' " (aref prefix i) " ") - ;; argument list - (let* ((func (cdr (car gm))) - (arglst (eieio-lambda-arglist func))) - (prin1 arglst (current-buffer))) - (insert "\n" - (or (documentation (cdr (car gm))) - "Undocumented")) - ;; Print file location if available - (when (and (setq location (get generic 'method-locations)) - (setq location (assoc cname location))) - (setq location (cadr location)) - (insert "\n\nDefined in `") - (help-insert-xref-button - (file-name-nondirectory location) - 'eieio-method-def cname generic location) - (insert "'\n")) - (setq gm (cdr gm)) - (insert "\n"))) - (setq i (1+ i))))))) - -(defun eieio-lambda-arglist (func) - "Return the argument list of FUNC, a function body." - (if (symbolp func) (setq func (symbol-function func))) - (if (byte-code-function-p func) - (eieio-compiled-function-arglist func) - (car (cdr func)))) +(defun eieio--specializers-apply-to-class-p (specializers class) + "Return non-nil if a method with SPECIALIZERS applies to CLASS." + (let ((applies nil)) + (dolist (specializer specializers) + (if (eq 'subclass (car-safe specializer)) + (setq specializer (nth 1 specializer))) + ;; Don't include the methods that are "too generic", such as those + ;; applying to `eieio-default-superclass'. + (and (not (memq specializer '(t eieio-default-superclass))) + (class-p specializer) + (child-of-class-p class specializer) + (setq applies t))) + applies)) (defun eieio-all-generic-functions (&optional class) "Return a list of all generic functions. Optional CLASS argument returns only those functions that contain methods for CLASS." - (let ((l nil) tree (cn (if class (symbol-name class) nil))) + (let ((l nil)) (mapatoms (lambda (symbol) - (setq tree (get symbol 'eieio-method-obarray)) - (if tree - (progn - ;; A symbol might be interned for that class in one of - ;; these three slots in the method-obarray. - (if (or (not class) - (fboundp (intern-soft cn (aref tree 0))) - (fboundp (intern-soft cn (aref tree 1))) - (fboundp (intern-soft cn (aref tree 2)))) - (setq l (cons symbol l))))))) + (let ((generic (and (fboundp symbol) (cl--generic symbol)))) + (and generic + (catch 'found + (if (null class) (throw 'found t)) + (dolist (method (cl--generic-method-table generic)) + (if (eieio--specializers-apply-to-class-p + (cl--generic-method-specializers method) class) + (throw 'found t)))) + (push symbol l))))) l)) (defun eieio-method-documentation (generic class) - "Return a list of the specific documentation of GENERIC for CLASS. -If there is not an explicit method for CLASS in GENERIC, or if that -function has no documentation, then return nil." - (let ((tree (get generic 'eieio-method-obarray)) - (cn (symbol-name class)) - before primary after) - (if (not tree) - nil - ;; A symbol might be interned for that class in one of - ;; these three slots in the method-obarray. - (setq before (intern-soft cn (aref tree 0)) - primary (intern-soft cn (aref tree 1)) - after (intern-soft cn (aref tree 2))) - (if (not (or (fboundp before) - (fboundp primary) - (fboundp after))) - nil - (list (if (fboundp before) - (cons (eieio-lambda-arglist before) - (documentation before)) - nil) - (if (fboundp primary) - (cons (eieio-lambda-arglist primary) - (documentation primary)) - nil) - (if (fboundp after) - (cons (eieio-lambda-arglist after) - (documentation after)) - nil)))))) - -(defvar eieio-read-generic nil - "History of the `eieio-read-generic' prompt.") - -(defun eieio-read-generic-p (fn) - "Function used in function `eieio-read-generic'. -This is because `generic-p' is a macro. -Argument FN is the function to test." - (generic-p fn)) - -(defun eieio-read-generic (prompt &optional historyvar) - "Read a generic function from the minibuffer with PROMPT. -Optional argument HISTORYVAR is the variable to use as history." - (intern (completing-read prompt obarray 'eieio-read-generic-p - t nil (or historyvar 'eieio-read-generic)))) + "Return info for all methods of GENERIC applicable to CLASS. +The value returned is a list of elements of the form +\(QUALIFIERS ARGS DOC)." + (let ((generic (cl--generic generic)) + (docs ())) + (when generic + (dolist (method (cl--generic-method-table generic)) + (when (eieio--specializers-apply-to-class-p + (cl--generic-method-specializers method) class) + (push (cl--generic-method-info method) docs)))) + docs)) ;;; METHOD STATS ;; @@ -634,21 +533,21 @@ Optional argument HISTORYVAR is the variable to use as history." () "Menu part in easymenu format used in speedbar while in `eieio' mode.") -(defun eieio-class-speedbar (dir-or-object depth) +(defun eieio-class-speedbar (_dir-or-object _depth) "Create buttons in speedbar that represents the current project. DIR-OR-OBJECT is the object to expand, or nil, and DEPTH is the current expansion depth." (when (eq (point-min) (point-max)) ;; This function is only called once, to start the whole deal. ;; Create and expand the default object. - (eieio-class-button eieio-default-superclass 0) + (eieio-class-button 'eieio-default-superclass 0) (forward-line -1) (speedbar-expand-line))) (defun eieio-class-button (class depth) "Draw a speedbar button at the current point for CLASS at DEPTH." (eieio--check-type class-p class) - (let ((subclasses (eieio--class-children (class-v class)))) + (let ((subclasses (eieio--class-children (eieio--class-v class)))) (if subclasses (speedbar-make-tag-line 'angle ?+ 'eieio-sb-expand @@ -673,7 +572,7 @@ Argument INDENT is the depth of indentation." (speedbar-with-writable (save-excursion (end-of-line) (forward-char 1) - (let ((subclasses (eieio--class-children (class-v class)))) + (let ((subclasses (eieio--class-children (eieio--class-v class)))) (while subclasses (eieio-class-button (car subclasses) (1+ indent)) (setq subclasses (cdr subclasses))))))) @@ -683,7 +582,7 @@ Argument INDENT is the depth of indentation." (t (error "Ooops... not sure what to do"))) (speedbar-center-buffer-smartly)) -(defun eieio-describe-class-sb (text token indent) +(defun eieio-describe-class-sb (_text token _indent) "Describe the class TEXT in TOKEN. INDENT is the current indentation level." (dframe-with-attached-buffer diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el index cf676256d43..a1eabcf9700 100644 --- a/lisp/emacs-lisp/eieio-speedbar.el +++ b/lisp/emacs-lisp/eieio-speedbar.el @@ -1,4 +1,4 @@ -;;; eieio-speedbar.el -- Classes for managing speedbar displays. +;;; eieio-speedbar.el -- Classes for managing speedbar displays. -*- lexical-binding:t -*- ;; Copyright (C) 1999-2002, 2005, 2007-2015 Free Software Foundation, ;; Inc. @@ -196,19 +196,19 @@ that path." ;; when no other methods are found, allowing multiple inheritance to work ;; reliably with eieio-speedbar. -(defmethod eieio-speedbar-description (object) +(cl-defmethod eieio-speedbar-description (object) "Return a string describing OBJECT." (eieio-object-name-string object)) -(defmethod eieio-speedbar-derive-line-path (object) +(cl-defmethod eieio-speedbar-derive-line-path (_object) "Return the path which OBJECT has something to do with." nil) -(defmethod eieio-speedbar-object-buttonname (object) +(cl-defmethod eieio-speedbar-object-buttonname (object) "Return a string to use as a speedbar button for OBJECT." (eieio-object-name-string object)) -(defmethod eieio-speedbar-make-tag-line (object depth) +(cl-defmethod eieio-speedbar-make-tag-line (object depth) "Insert a tag line into speedbar at point for OBJECT. By default, all objects appear as simple TAGS with no need to inherit from the special `eieio-speedbar' classes. Child classes should redefine this @@ -221,7 +221,7 @@ Argument DEPTH is the depth at which the tag line is inserted." 'speedbar-tag-face depth)) -(defmethod eieio-speedbar-handle-click (object) +(cl-defmethod eieio-speedbar-handle-click (object) "Handle a click action on OBJECT in speedbar. Any object can be represented as a tag in SPEEDBAR without special attributes. These default objects will be pulled up in a custom @@ -285,7 +285,7 @@ Add one of the child classes to this class to the parent list of a class." ;;; Methods to eieio-speedbar-* which do not need to be overridden ;; -(defmethod eieio-speedbar-make-tag-line ((object eieio-speedbar) +(cl-defmethod eieio-speedbar-make-tag-line ((object eieio-speedbar) depth) "Insert a tag line into speedbar at point for OBJECT. All objects a child of symbol `eieio-speedbar' can be created from @@ -321,12 +321,12 @@ Argument DEPTH is the depth at which the tag line is inserted." (if exp (eieio-speedbar-expand object (1+ depth)))))) -(defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar) depth) +(cl-defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar) _depth) "Base method for creating tag lines for non-object children." (error "You must implement `eieio-speedbar-child-make-tag-lines' for %s" (eieio-object-name object))) -(defmethod eieio-speedbar-expand ((object eieio-speedbar) depth) +(cl-defmethod eieio-speedbar-expand ((object eieio-speedbar) depth) "Expand OBJECT at indentation DEPTH. Inserts a list of new tag lines representing expanded elements within OBJECT." @@ -340,7 +340,7 @@ OBJECT." ;;; Speedbar specific function callbacks. ;; -(defun eieio-speedbar-object-click (text token indent) +(defun eieio-speedbar-object-click (_text token _indent) "Handle a user click on TEXT representing object TOKEN. The object is at indentation level INDENT." (eieio-speedbar-handle-click token)) @@ -362,7 +362,7 @@ TOKEN is the object. INDENT is the current indentation level." (t (error "Ooops... not sure what to do"))) (speedbar-center-buffer-smartly)) -(defmethod eieio-speedbar-child-description ((obj eieio-speedbar)) +(cl-defmethod eieio-speedbar-child-description ((obj eieio-speedbar)) "Return a description for a child of OBJ which is not an object." (error "You must implement `eieio-speedbar-child-description' for %s" (eieio-object-name obj))) @@ -412,7 +412,7 @@ Optional DEPTH is the depth we start at." ;;; Methods to the eieio-speedbar-* classes which need to be overridden. ;; -(defmethod eieio-speedbar-object-children ((object eieio-speedbar)) +(cl-defmethod eieio-speedbar-object-children ((_object eieio-speedbar)) "Return a list of children to be displayed in speedbar. If the return value is a list of OBJECTs, then those objects are queried for details. If the return list is made of strings, diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 1ae1e594b29..91469b4b96c 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -1,4 +1,4 @@ -;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects +;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects -*- lexical-binding:t -*- ;;; or maybe Eric's Implementation of Emacs Interpreted Objects ;; Copyright (C) 1995-1996, 1998-2015 Free Software Foundation, Inc. @@ -36,15 +36,13 @@ ;; Retrieved from: ;; http://192.220.96.201/dylan/linearization-oopsla96.html -;; There is funny stuff going on with typep and deftype. This -;; is the only way I seem to be able to make this stuff load properly. - ;; @TODO - fix :initform to be a form, not a quoted value ;; @TODO - Prefix non-clos functions with `eieio-'. -;;; Code: +;; TODO: better integrate CL's defstructs and classes. E.g. make it possible +;; to create a new class that inherits from a struct. -(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib! +;;; Code: (defvar eieio-version "1.4" "Current version of EIEIO.") @@ -59,13 +57,11 @@ ;;; Defining a new class ;; -(defmacro defclass (name superclass slots &rest options-and-doc) +(defmacro defclass (name superclasses slots &rest options-and-doc) "Define NAME as a new class derived from SUPERCLASS with SLOTS. OPTIONS-AND-DOC is used as the class' options and base documentation. -SUPERCLASS is a list of superclasses to inherit from, with SLOTS -being the slots residing in that class definition. NOTE: Currently -only one slot may exist in SUPERCLASS as multiple inheritance is not -yet supported. Supported tags are: +SUPERCLASSES is a list of superclasses to inherit from, with SLOTS +being the slots residing in that class definition. Supported tags are: :initform - Initializing form. :initarg - Tag used during initialization. @@ -79,8 +75,6 @@ yet supported. Supported tags are: - A string documenting use of this slot. The following are extensions on CLOS: - :protection - Specify protection for this slot. - Defaults to `:public'. Also use `:protected', or `:private'. :custom - When customizing an object, the custom :type. Public only. :label - A text string label used for a slot when customizing. :group - Name of a customization group this slot belongs in. @@ -115,12 +109,179 @@ Options in CLOS not supported in EIEIO: Due to the way class options are set up, you can add any tags you wish, and reference them using the function `class-option'." - ;; This is eval-and-compile only to silence spurious compiler warnings - ;; about functions and variables not known to be defined. - ;; When eieio-defclass code is merged here and this becomes - ;; transparent to the compiler, the eval-and-compile can be removed. - `(eval-and-compile - (eieio-defclass ',name ',superclass ',slots ',options-and-doc))) + (declare (doc-string 4)) + (eieio--check-type listp superclasses) + + (cond ((and (stringp (car options-and-doc)) + (/= 1 (% (length options-and-doc) 2))) + (error "Too many arguments to `defclass'")) + ((and (symbolp (car options-and-doc)) + (/= 0 (% (length options-and-doc) 2))) + (error "Too many arguments to `defclass'"))) + + (if (stringp (car options-and-doc)) + (setq options-and-doc + (cons :documentation options-and-doc))) + + ;; Make sure the method invocation order is a valid value. + (let ((io (eieio--class-option-assoc options-and-doc + :method-invocation-order))) + (when (and io (not (member io '(:depth-first :breadth-first :c3)))) + (error "Method invocation order %s is not allowed" io))) + + (let ((testsym1 (intern (concat (symbol-name name) "-p"))) + (testsym2 (intern (format "eieio--childp--%s" name))) + (accessors ())) + + ;; Collect the accessors we need to define. + (pcase-dolist (`(,sname . ,soptions) slots) + (let* ((acces (plist-get soptions :accessor)) + (initarg (plist-get soptions :initarg)) + (reader (plist-get soptions :reader)) + (writer (plist-get soptions :writer)) + (alloc (plist-get soptions :allocation)) + (label (plist-get soptions :label))) + + (if eieio-error-unsupported-class-tags + (let ((tmp soptions)) + (while tmp + (if (not (member (car tmp) '(:accessor + :initform + :initarg + :documentation + :protection + :reader + :writer + :allocation + :type + :custom + :label + :group + :printer + :allow-nil-initform + :custom-groups))) + (signal 'invalid-slot-type (list (car tmp)))) + (setq tmp (cdr (cdr tmp)))))) + + ;; Make sure the :allocation parameter has a valid value. + (if (not (memq alloc '(nil :class :instance))) + (signal 'invalid-slot-type (list :allocation alloc))) + + ;; Label is nil, or a string + (if (not (or (null label) (stringp label))) + (signal 'invalid-slot-type (list :label label))) + + ;; Is there an initarg, but allocation of class? + (if (and initarg (eq alloc :class)) + (message "Class allocated slots do not need :initarg")) + + ;; Anyone can have an accessor function. This creates a function + ;; of the specified name, and also performs a `defsetf' if applicable + ;; so that users can `setf' the space returned by this function. + (when acces + (push `(cl-defmethod (setf ,acces) (value (this ,name)) + (eieio-oset this ',sname value)) + accessors) + (push `(cl-defmethod ,acces ((this ,name)) + ,(format + "Retrieve the slot `%S' from an object of class `%S'." + sname name) + ;; FIXME: Why is this different from the :reader case? + (if (slot-boundp this ',sname) (eieio-oref this ',sname))) + accessors) + (when (and eieio-backward-compatibility (eq alloc :class)) + ;; FIXME: How could I declare this *method* as obsolete. + (push `(cl-defmethod ,acces ((this (subclass ,name))) + ,(format + "Retrieve the class slot `%S' from a class `%S'. +This method is obsolete." + sname name) + (if (slot-boundp this ',sname) + (eieio-oref-default this ',sname))) + accessors))) + + ;; If a writer is defined, then create a generic method of that + ;; name whose purpose is to set the value of the slot. + (if writer + (push `(cl-defmethod ,writer ((this ,name) value) + ,(format "Set the slot `%S' of an object of class `%S'." + sname name) + (setf (slot-value this ',sname) value)) + accessors)) + ;; If a reader is defined, then create a generic method + ;; of that name whose purpose is to access this slot value. + (if reader + (push `(cl-defmethod ,reader ((this ,name)) + ,(format "Access the slot `%S' from object of class `%S'." + sname name) + (slot-value this ',sname)) + accessors)) + )) + + `(progn + ;; This test must be created right away so we can have self- + ;; referencing classes. ei, a class whose slot can contain only + ;; pointers to itself. + + ;; Create the test function. + (defun ,testsym1 (obj) + ,(format "Test OBJ to see if it an object of type %S." name) + (and (eieio-object-p obj) + (same-class-p obj ',name))) + + (defun ,testsym2 (obj) + ,(format + "Test OBJ to see if it an object is a child of type %S." + name) + (and (eieio-object-p obj) + (object-of-class-p obj ',name))) + + ,@(when eieio-backward-compatibility + (let ((f (intern (format "%s-child-p" name)))) + `((defalias ',f ',testsym2) + (make-obsolete + ',f ,(format "use (cl-typep ... '%s) instead" name) "25.1")))) + + ;; When using typep, (typep OBJ 'myclass) returns t for objects which + ;; are subclasses of myclass. For our predicates, however, it is + ;; important for EIEIO to be backwards compatible, where + ;; myobject-p, and myobject-child-p are different. + ;; "cl" uses this technique to specify symbols with specific typep + ;; test, so we can let typep have the CLOS documented behavior + ;; while keeping our above predicate clean. + + (put ',name 'cl-deftype-satisfies #',testsym2) + + (eieio-defclass-internal ',name ',superclasses ',slots ',options-and-doc) + + ,@accessors + + ;; Create the constructor function + ,(if (eieio--class-option-assoc options-and-doc :abstract) + ;; Abstract classes cannot be instantiated. Say so. + (let ((abs (eieio--class-option-assoc options-and-doc :abstract))) + (if (not (stringp abs)) + (setq abs (format "Class %s is abstract" name))) + `(defun ,name (&rest _) + ,(format "You cannot create a new object of type %S." name) + (error ,abs))) + + ;; Non-abstract classes need a constructor. + `(defun ,name (&rest slots) + ,(format "Create a new object with name NAME of class type %S." + name) + (declare (compiler-macro + (lambda (whole) + (if (not (stringp (car slots))) + whole + (macroexp--warn-and-return + (format "Obsolete name arg %S to constructor %S" + (car slots) (car whole)) + ;; Keep the name arg, for backward compatibility, + ;; but hide it so we don't trigger indefinitely. + `(,(car whole) (identity ,(car slots)) + ,@(cdr slots))))))) + (apply #'eieio-constructor ',name slots)))))) ;;; CLOS style implementation of object creators. @@ -145,73 +306,16 @@ In EIEIO, the class' constructor requires a name for use when printing. `make-instance' in CLOS doesn't use names the way Emacs does, so the class is used as the name slot instead when INITARGS doesn't start with a string." - (if (and (car initargs) (stringp (car initargs))) - (apply (class-constructor class) initargs) - (apply (class-constructor class) - (cond ((symbolp class) (symbol-name class)) - (t (format "%S" class))) - initargs))) + (apply (eieio--class-constructor class) initargs)) -;;; CLOS methods and generics -;; -(defmacro defgeneric (method args &optional doc-string) - "Create a generic function METHOD. -DOC-STRING is the base documentation for this class. A generic -function has no body, as its purpose is to decide which method body -is appropriate to use. Uses `defmethod' to create methods, and calls -`defgeneric' for you. With this implementation the ARGS are -currently ignored. You can use `defgeneric' to apply specialized -top level documentation to a method." - `(eieio--defalias ',method - (eieio--defgeneric-init-form ',method ,doc-string))) - -(defmacro defmethod (method &rest args) - "Create a new METHOD through `defgeneric' with ARGS. - -The optional second argument KEY is a specifier that -modifies how the method is called, including: - :before - Method will be called before the :primary - :primary - The default if not specified - :after - Method will be called after the :primary - :static - First arg could be an object or class -The next argument is the ARGLIST. The ARGLIST specifies the arguments -to the method as with `defun'. The first argument can have a type -specifier, such as: - ((VARNAME CLASS) ARG2 ...) -where VARNAME is the name of the local variable for the method being -created. The CLASS is a class symbol for a class made with `defclass'. -A DOCSTRING comes after the ARGLIST, and is optional. -All the rest of the args are the BODY of the method. A method will -return the value of the last form in the BODY. - -Summary: - - (defmethod mymethod [:before | :primary | :after | :static] - ((typearg class-name) arg2 &optional opt &rest rest) - \"doc-string\" - body)" - (let* ((key (if (keywordp (car args)) (pop args))) - (params (car args)) - (arg1 (car params)) - (fargs (if (consp arg1) - (cons (car arg1) (cdr params)) - params)) - (class (if (consp arg1) (nth 1 arg1))) - (code `(lambda ,fargs ,@(cdr args)))) - `(progn - ;; Make sure there is a generic and the byte-compiler sees it. - (defgeneric ,method ,args - ,(or (documentation code) - (format "Generically created method `%s'." method))) - (eieio--defmethod ',method ',key ',class #',code)))) - ;;; Get/Set slots in an object. ;; (defmacro oref (obj slot) "Retrieve the value stored in OBJ in the slot named by SLOT. Slot is the name of the slot when created by `defclass' or the label created by the :initarg tag." + (declare (debug (form symbolp))) `(eieio-oref ,obj (quote ,slot))) (defalias 'slot-value 'eieio-oref) @@ -222,6 +326,7 @@ created by the :initarg tag." The default value is the value installed in a class with the :initform tag. SLOT can be the slot name, or the tag specified by the :initarg tag in the `defclass' call." + (declare (debug (form symbolp))) `(eieio-oref-default ,obj (quote ,slot))) ;;; Handy CLOS macros @@ -245,7 +350,8 @@ SPEC-LIST is of a form similar to `let'. For example: Where each VAR is the local variable given to the associated SLOT. A slot specified without a variable name is given a variable name of the same name as the slot." - (declare (indent 2)) + (declare (indent 2) (debug (sexp sexp def-body))) + (require 'cl-lib) ;; Transform the spec-list into a cl-symbol-macrolet spec-list. (let ((mappings (mapcar (lambda (entry) (let ((var (if (listp entry) (car entry) entry)) @@ -259,33 +365,45 @@ variable name of the same name as the slot." ;; well embedded into an object. ;; (define-obsolete-function-alias - 'object-class-fast #'eieio--object-class "24.4") + 'object-class-fast #'eieio--object-class-name "24.4") + +(cl-defgeneric eieio-object-name-string (obj) + "Return a string which is OBJ's name." + (declare (obsolete eieio-named "25.1"))) (defun eieio-object-name (obj &optional extra) "Return a Lisp like symbol string for object OBJ. If EXTRA, include that in the string returned to represent the symbol." (eieio--check-type eieio-object-p obj) - (format "#<%s %s%s>" (symbol-name (eieio--object-class obj)) - (eieio--object-name obj) (or extra ""))) + (format "#<%s %s%s>" (eieio--object-class-name obj) + (eieio-object-name-string obj) (or extra ""))) (define-obsolete-function-alias 'object-name #'eieio-object-name "24.4") -(defun eieio-object-name-string (obj) "Return a string which is OBJ's name." - (eieio--check-type eieio-object-p obj) - (eieio--object-name obj)) +(defconst eieio--object-names (make-hash-table :test #'eq :weakness 'key)) + +;; In the past, every EIEIO object had a `name' field, so we had the two method +;; below "for free". Since this field is very rarely used, we got rid of it +;; and instead we keep it in a weak hash-tables, for those very rare objects +;; that use it. +(cl-defmethod eieio-object-name-string (obj) + (or (gethash obj eieio--object-names) + (symbol-name (eieio-object-class obj)))) (define-obsolete-function-alias 'object-name-string #'eieio-object-name-string "24.4") -(defun eieio-object-set-name-string (obj name) +(cl-defmethod eieio-object-set-name-string (obj name) "Set the string which is OBJ's NAME." - (eieio--check-type eieio-object-p obj) + (declare (obsolete eieio-named "25.1")) (eieio--check-type stringp name) - (setf (eieio--object-name obj) name)) + (setf (gethash obj eieio--object-names) name)) (define-obsolete-function-alias 'object-set-name-string 'eieio-object-set-name-string "24.4") -(defun eieio-object-class (obj) "Return the class struct defining OBJ." +(defun eieio-object-class (obj) + "Return the class struct defining OBJ." + ;; FIXME: We say we return a "struct" but we return a symbol instead! (eieio--check-type eieio-object-p obj) - (eieio--object-class obj)) + (eieio--object-class-name obj)) (define-obsolete-function-alias 'object-class #'eieio-object-class "24.4") ;; CLOS name, maybe? (define-obsolete-function-alias 'class-of #'eieio-object-class "24.4") @@ -293,7 +411,7 @@ If EXTRA, include that in the string returned to represent the symbol." (defun eieio-object-class-name (obj) "Return a Lisp like symbol name for OBJ's class." (eieio--check-type eieio-object-p obj) - (eieio-class-name (eieio--object-class obj))) + (eieio-class-name (eieio--object-class-name obj))) (define-obsolete-function-alias 'object-class-name 'eieio-object-class-name "24.4") @@ -301,15 +419,16 @@ If EXTRA, include that in the string returned to represent the symbol." "Return parent classes to CLASS. (overload of variable). The CLOS function `class-direct-superclasses' is aliased to this function." - (eieio--check-type class-p class) - (eieio-class-parents-fast class)) + (let ((c (eieio-class-object class))) + (eieio--class-parent c))) + (define-obsolete-function-alias 'class-parents #'eieio-class-parents "24.4") (defun eieio-class-children (class) "Return child classes to CLASS. The CLOS function `class-direct-subclasses' is aliased to this function." (eieio--check-type class-p class) - (eieio-class-children-fast class)) + (eieio--class-children (eieio--class-v class))) (define-obsolete-function-alias 'class-children #'eieio-class-children "24.4") @@ -324,38 +443,44 @@ The CLOS function `class-direct-subclasses' is aliased to this function." `(car (eieio-class-parents ,class))) (define-obsolete-function-alias 'class-parent 'eieio-class-parent "24.4") -(defun same-class-p (obj class) "Return t if OBJ is of class-type CLASS." - (eieio--check-type class-p class) +(defun same-class-p (obj class) + "Return t if OBJ is of class-type CLASS." + (setq class (eieio--class-object class)) + (eieio--check-type eieio--class-p class) (eieio--check-type eieio-object-p obj) - (same-class-fast-p obj class)) + (eq (eieio--object-class-object obj) class)) (defun object-of-class-p (obj class) "Return non-nil if OBJ is an instance of CLASS or CLASS' subclasses." (eieio--check-type eieio-object-p obj) ;; class will be checked one layer down - (child-of-class-p (eieio--object-class obj) class)) + (child-of-class-p (eieio--object-class-object obj) class)) ;; Backwards compatibility (defalias 'obj-of-class-p 'object-of-class-p) (defun child-of-class-p (child class) "Return non-nil if CHILD class is a subclass of CLASS." - (eieio--check-type class-p class) - (eieio--check-type class-p child) - (let ((p nil)) - (while (and child (not (eq child class))) - (setq p (append p (eieio--class-parent (class-v child))) - child (car p) - p (cdr p))) - (if child t))) + (setq child (eieio--class-object child)) + (eieio--check-type eieio--class-p child) + ;; `eieio-default-superclass' is never mentioned in eieio--class-parent, + ;; so we have to special case it here. + (or (eq class 'eieio-default-superclass) + (let ((p nil)) + (setq class (eieio--class-object class)) + (eieio--check-type eieio--class-p class) + (while (and child (not (eq child class))) + (setq p (append p (eieio--class-parent child)) + child (pop p))) + (if child t)))) (defun object-slots (obj) "Return list of slots available in OBJ." (eieio--check-type eieio-object-p obj) - (eieio--class-public-a (class-v (eieio--object-class obj)))) + (eieio--class-public-a (eieio--object-class-object obj))) -(defun class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg." - (eieio--check-type class-p class) - (let ((ia (eieio--class-initarg-tuples (class-v class))) +(defun eieio--class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg." + (eieio--check-type eieio--class-p class) + (let ((ia (eieio--class-initarg-tuples class)) (f nil)) (while (and ia (not f)) (if (eq (cdr (car ia)) slot) @@ -369,6 +494,7 @@ The CLOS function `class-direct-subclasses' is aliased to this function." "Set the value in OBJ for slot SLOT to VALUE. SLOT is the slot name as specified in `defclass' or the tag created with in the :initarg slot. VALUE can be any Lisp object." + (declare (debug (form symbolp form))) `(eieio-oset ,obj (quote ,slot) ,value)) (defmacro oset-default (class slot value) @@ -376,6 +502,7 @@ with in the :initarg slot. VALUE can be any Lisp object." The default value is usually set with the :initform tag during class creation. This allows users to change the default behavior of classes after they are created." + (declare (debug (form symbolp form))) `(eieio-oset-default ,class (quote ,slot) ,value)) ;;; CLOS queries into classes and slots @@ -400,11 +527,9 @@ OBJECT can be an instance or a class." (defun slot-exists-p (object-or-class slot) "Return non-nil if OBJECT-OR-CLASS has SLOT." - (let ((cv (class-v (cond ((eieio-object-p object-or-class) - (eieio-object-class object-or-class)) - ((class-p object-or-class) - object-or-class)) - ))) + (let ((cv (cond ((eieio-object-p object-or-class) + (eieio--object-class-object object-or-class)) + (t (eieio-class-object object-or-class))))) (or (memq slot (eieio--class-public-a cv)) (memq slot (eieio--class-class-allocation-a cv))) )) @@ -416,7 +541,7 @@ If ERRORP is non-nil, `wrong-argument-type' is signaled." (if (not (class-p symbol)) (if errorp (signal 'wrong-type-argument (list 'class-p symbol)) nil) - (class-v symbol))) + (eieio--class-v symbol))) ;;; Slightly more complex utility functions for objects ;; @@ -494,68 +619,10 @@ If SLOT is unbound, do nothing." nil (eieio-oset object slot (delete item (eieio-oref object slot))))) -;;; -;; Method Calling Functions - -(defun next-method-p () - "Return non-nil if there is a next method. -Returns a list of lambda expressions which is the `next-method' -order." - eieio-generic-call-next-method-list) - -(defun call-next-method (&rest replacement-args) - "Call the superclass method from a subclass method. -The superclass method is specified in the current method list, -and is called the next method. - -If REPLACEMENT-ARGS is non-nil, then use them instead of -`eieio-generic-call-arglst'. The generic arg list are the -arguments passed in at the top level. - -Use `next-method-p' to find out if there is a next method to call." - (if (not (eieio--scoped-class)) - (error "`call-next-method' not called within a class specific method")) - (if (and (/= eieio-generic-call-key method-primary) - (/= eieio-generic-call-key method-static)) - (error "Cannot `call-next-method' except in :primary or :static methods") - ) - (let ((newargs (or replacement-args eieio-generic-call-arglst)) - (next (car eieio-generic-call-next-method-list)) - ) - (if (or (not next) (not (car next))) - (apply 'no-next-method (car newargs) (cdr newargs)) - (let* ((eieio-generic-call-next-method-list - (cdr eieio-generic-call-next-method-list)) - (eieio-generic-call-arglst newargs) - (fcn (car next)) - ) - (eieio--with-scoped-class (cdr next) - (apply fcn newargs)) )))) - ;;; Here are some CLOS items that need the CL package ;; -(defsetf eieio-oref eieio-oset) - -(if (eval-when-compile (fboundp 'gv-define-expander)) - ;; Not needed for Emacs>=24.3 since gv.el's setf expands macros and - ;; follows aliases. - nil -(defsetf slot-value eieio-oset) - -;; The below setf method was written by Arnd Kohrs <kohrs@acm.org> -(define-setf-method oref (obj slot) - (with-no-warnings - (require 'cl) - (let ((obj-temp (gensym)) - (slot-temp (gensym)) - (store-temp (gensym))) - (list (list obj-temp slot-temp) - (list obj `(quote ,slot)) - (list store-temp) - (list 'set-slot-value obj-temp slot-temp - store-temp) - (list 'slot-value obj-temp slot-temp)))))) +(gv-define-simple-setter eieio-oref eieio-oset) ;;; @@ -574,48 +641,55 @@ Its slots are automatically adopted by classes with no specified parents. This class is not stored in the `parent' slot of a class vector." :abstract t) +(setq eieio-default-superclass (eieio--class-v 'eieio-default-superclass)) + (defalias 'standard-class 'eieio-default-superclass) -(defgeneric constructor (class newname &rest slots) +(cl-defgeneric eieio-constructor (class &rest slots) "Default constructor for CLASS `eieio-default-superclass'.") -(defmethod constructor :static - ((class eieio-default-superclass) newname &rest slots) +(define-obsolete-function-alias 'constructor #'eieio-constructor "25.1") + +(cl-defmethod eieio-constructor + ((class (subclass eieio-default-superclass)) &rest slots) "Default constructor for CLASS `eieio-default-superclass'. -NEWNAME is the name to be given to the constructed object. SLOTS are the initialization slots used by `shared-initialize'. This static method is called when an object is constructed. It allocates the vector used to represent an EIEIO object, and then calls `shared-initialize' on that object." - (let* ((new-object (copy-sequence (eieio--class-default-object-cache (class-v class))))) - ;; Update the name for the newly created object. - (setf (eieio--object-name new-object) newname) + (let* ((new-object (copy-sequence (eieio--class-default-object-cache + (eieio--class-v class))))) + (if (and slots + (let ((x (car slots))) + (or (stringp x) (null x)))) + (funcall (if eieio-backward-compatibility #'ignore #'message) + "Obsolete name %S passed to %S constructor" + (pop slots) class)) ;; Call the initialize method on the new object with the slots ;; that were passed down to us. (initialize-instance new-object slots) ;; Return the created object. new-object)) -(defgeneric shared-initialize (obj slots) +(cl-defgeneric shared-initialize (obj slots) "Set slots of OBJ with SLOTS which is a list of name/value pairs. Called from the constructor routine.") -(defmethod shared-initialize ((obj eieio-default-superclass) slots) +(cl-defmethod shared-initialize ((obj eieio-default-superclass) slots) "Set slots of OBJ with SLOTS which is a list of name/value pairs. Called from the constructor routine." - (eieio--with-scoped-class (eieio--object-class obj) - (while slots - (let ((rn (eieio-initarg-to-attribute (eieio--object-class obj) - (car slots)))) - (if (not rn) - (slot-missing obj (car slots) 'oset (car (cdr slots))) - (eieio-oset obj rn (car (cdr slots))))) - (setq slots (cdr (cdr slots)))))) - -(defgeneric initialize-instance (this &optional slots) + (while slots + (let ((rn (eieio--initarg-to-attribute (eieio--object-class-object obj) + (car slots)))) + (if (not rn) + (slot-missing obj (car slots) 'oset (car (cdr slots))) + (eieio-oset obj rn (car (cdr slots))))) + (setq slots (cdr (cdr slots))))) + +(cl-defgeneric initialize-instance (this &optional slots) "Construct the new object THIS based on SLOTS.") -(defmethod initialize-instance ((this eieio-default-superclass) +(cl-defmethod initialize-instance ((this eieio-default-superclass) &optional slots) "Construct the new object THIS based on SLOTS. SLOTS is a tagged list where odd numbered elements are tags, and @@ -627,7 +701,7 @@ not taken, then new objects of your class will not have their values dynamically set from SLOTS." ;; First, see if any of our defaults are `lambda', and ;; re-evaluate them and apply the value to our slots. - (let* ((this-class (class-v (eieio--object-class this))) + (let* ((this-class (eieio--object-class-object this)) (slot (eieio--class-public-a this-class)) (defaults (eieio--class-public-d this-class))) (while slot @@ -647,11 +721,11 @@ dynamically set from SLOTS." ;; Shared initialize will parse our slots for us. (shared-initialize this slots)) -(defgeneric slot-missing (object slot-name operation &optional new-value) +(cl-defgeneric slot-missing (object slot-name operation &optional new-value) "Method invoked when an attempt to access a slot in OBJECT fails.") -(defmethod slot-missing ((object eieio-default-superclass) slot-name - operation &optional new-value) +(cl-defmethod slot-missing ((object eieio-default-superclass) slot-name + _operation &optional _new-value) "Method invoked when an attempt to access a slot in OBJECT fails. SLOT-NAME is the name of the failed slot, OPERATION is the type of access that was requested, and optional NEW-VALUE is the value that was desired @@ -662,10 +736,10 @@ directly reference slots in EIEIO objects." (signal 'invalid-slot-name (list (eieio-object-name object) slot-name))) -(defgeneric slot-unbound (object class slot-name fn) +(cl-defgeneric slot-unbound (object class slot-name fn) "Slot unbound is invoked during an attempt to reference an unbound slot.") -(defmethod slot-unbound ((object eieio-default-superclass) +(cl-defmethod slot-unbound ((object eieio-default-superclass) class slot-name fn) "Slot unbound is invoked during an attempt to reference an unbound slot. OBJECT is the instance of the object being reference. CLASS is the @@ -680,75 +754,40 @@ EIEIO can only dispatch on the first argument, so the first two are swapped." (signal 'unbound-slot (list (eieio-class-name class) (eieio-object-name object) slot-name fn))) -(defgeneric no-applicable-method (object method &rest args) - "Called if there are no implementations for OBJECT in METHOD.") - -(defmethod no-applicable-method ((object eieio-default-superclass) - method &rest args) - "Called if there are no implementations for OBJECT in METHOD. -OBJECT is the object which has no method implementation. -ARGS are the arguments that were passed to METHOD. - -Implement this for a class to block this signal. The return -value becomes the return value of the original method call." - (signal 'no-method-definition (list method (eieio-object-name object))) - ) - -(defgeneric no-next-method (object &rest args) -"Called from `call-next-method' when no additional methods are available.") - -(defmethod no-next-method ((object eieio-default-superclass) - &rest args) - "Called from `call-next-method' when no additional methods are available. -OBJECT is othe object being called on `call-next-method'. -ARGS are the arguments it is called by. -This method signals `no-next-method' by default. Override this -method to not throw an error, and its return value becomes the -return value of `call-next-method'." - (signal 'no-next-method (list (eieio-object-name object) args)) - ) - -(defgeneric clone (obj &rest params) +(cl-defgeneric clone (obj &rest params) "Make a copy of OBJ, and then supply PARAMS. PARAMS is a parameter list of the same form used by `initialize-instance'. When overloading `clone', be sure to call `call-next-method' first and modify the returned object.") -(defmethod clone ((obj eieio-default-superclass) &rest params) +(cl-defmethod clone ((obj eieio-default-superclass) &rest params) "Make a copy of OBJ, and then apply PARAMS." - (let ((nobj (copy-sequence obj)) - (nm (eieio--object-name obj)) - (passname (and params (stringp (car params)))) - (num 1)) - (if params (shared-initialize nobj (if passname (cdr params) params))) - (if (not passname) - (save-match-data - (if (string-match "-\\([0-9]+\\)" nm) - (setq num (1+ (string-to-number (match-string 1 nm))) - nm (substring nm 0 (match-beginning 0)))) - (setf (eieio--object-name nobj) (concat nm "-" (int-to-string num)))) - (setf (eieio--object-name nobj) (car params))) + (let ((nobj (copy-sequence obj))) + (if (stringp (car params)) + (funcall (if eieio-backward-compatibility #'ignore #'message) + "Obsolete name %S passed to clone" (pop params))) + (if params (shared-initialize nobj params)) nobj)) -(defgeneric destructor (this &rest params) +(cl-defgeneric destructor (this &rest params) "Destructor for cleaning up any dynamic links to our object.") -(defmethod destructor ((this eieio-default-superclass) &rest params) +(cl-defmethod destructor ((_this eieio-default-superclass) &rest _params) "Destructor for cleaning up any dynamic links to our object. Argument THIS is the object being destroyed. PARAMS are additional ignored parameters." ;; No cleanup... yet. ) -(defgeneric object-print (this &rest strings) +(cl-defgeneric object-print (this &rest strings) "Pretty printer for object THIS. Call function `object-name' with STRINGS. It is sometimes useful to put a summary of the object into the default #<notation> string when using EIEIO browsing tools. Implement this method to customize the summary.") -(defmethod object-print ((this eieio-default-superclass) &rest strings) +(cl-defmethod object-print ((this eieio-default-superclass) &rest strings) "Pretty printer for object THIS. Call function `object-name' with STRINGS. The default method for printing object THIS is to use the function `object-name'. @@ -760,16 +799,16 @@ Implement this function and specify STRINGS in a call to `call-next-method' to provide additional summary information. When passing in extra strings from child classes, always remember to prepend a space." - (eieio-object-name this (apply 'concat strings))) + (eieio-object-name this (apply #'concat strings))) (defvar eieio-print-depth 0 "When printing, keep track of the current indentation depth.") -(defgeneric object-write (this &optional comment) +(cl-defgeneric object-write (this &optional comment) "Write out object THIS to the current stream. Optional COMMENT will add comments to the beginning of the output.") -(defmethod object-write ((this eieio-default-superclass) &optional comment) +(cl-defmethod object-write ((this eieio-default-superclass) &optional comment) "Write object THIS out to the current stream. This writes out the vector version of this object. Complex and recursive object are discouraged from being written. @@ -782,14 +821,14 @@ this object." (princ comment) (princ "\n")) (let* ((cl (eieio-object-class this)) - (cv (class-v cl))) + (cv (eieio--class-v cl))) ;; Now output readable lisp to recreate this object ;; It should look like this: ;; (<constructor> <name> <slot> <slot> ... ) ;; Each slot's slot is writen using its :writer. (princ (make-string (* eieio-print-depth 2) ? )) (princ "(") - (princ (symbol-name (class-constructor (eieio-object-class this)))) + (princ (symbol-name (eieio--class-constructor (eieio-object-class this)))) (princ " ") (prin1 (eieio-object-name-string this)) (princ "\n") @@ -800,7 +839,7 @@ this object." (eieio-print-depth (1+ eieio-print-depth))) (while publa (when (slot-boundp this (car publa)) - (let ((i (class-slot-initarg cl (car publa))) + (let ((i (eieio--class-slot-initarg cv (car publa))) (v (eieio-oref this (car publa))) ) (unless (or (not i) (equal v (car publd))) @@ -859,64 +898,40 @@ this object." ;;; Unimplemented functions from CLOS ;; -(defun change-class (obj class) +(defun change-class (_obj _class) "Change the class of OBJ to type CLASS. This may create or delete slots, but does not affect the return value of `eq'." (error "EIEIO: `change-class' is unimplemented")) ;; Hook ourselves into help system for describing classes and methods. -(add-hook 'help-fns-describe-function-functions 'eieio-help-generic) (add-hook 'help-fns-describe-function-functions 'eieio-help-constructor) ;;; Interfacing with edebug ;; -(defun eieio-edebug-prin1-to-string (object &optional noescape) +(defun eieio-edebug-prin1-to-string (print-function object &optional noescape) "Display EIEIO OBJECT in fancy format. -Overrides the edebug default. -Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate." - (cond ((class-p object) (eieio-class-name object)) + +Used as advice around `edebug-prin1-to-string', held in the +variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to +`prin1-to-string' when appropriate." + (cond ((eieio--class-p object) (eieio-class-name object)) ((eieio-object-p object) (object-print object)) - ((and (listp object) (or (class-p (car object)) + ((and (listp object) (or (eieio--class-p (car object)) (eieio-object-p (car object)))) - (concat "(" (mapconcat 'eieio-edebug-prin1-to-string object " ") ")")) - (t (prin1-to-string object noescape)))) - -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec defmethod - (&define ; this means we are defining something - [&or name ("setf" :name setf name)] - ;; ^^ This is the methods symbol - [ &optional symbolp ] ; this is key :before etc - list ; arguments - [ &optional stringp ] ; documentation string - def-body ; part to be debugged - )) - ;; The rest of the macros - (def-edebug-spec oref (form quote)) - (def-edebug-spec oref-default (form quote)) - (def-edebug-spec oset (form quote form)) - (def-edebug-spec oset-default (form quote form)) - (def-edebug-spec class-v form) - (def-edebug-spec class-p form) - (def-edebug-spec eieio-object-p form) - (def-edebug-spec class-constructor form) - (def-edebug-spec generic-p form) - (def-edebug-spec with-slots (list list def-body)) - ;; I suspect this isn't the best way to do this, but when - ;; cust-print was used on my system all my objects - ;; appeared as "#1 =" which was not useful. This allows - ;; edebug to print my objects in the nice way they were - ;; meant to with `object-print' and `class-name' - ;; (defalias 'edebug-prin1-to-string 'eieio-edebug-prin1-to-string) - ) - ) + (concat "(" (mapconcat + (lambda (x) (eieio-edebug-prin1-to-string print-function x)) + object " ") + ")")) + (t (funcall print-function object noescape)))) + +(advice-add 'edebug-prin1-to-string + :around #'eieio-edebug-prin1-to-string) ;;; Start of automatically extracted autoloads. -;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "f15421ce19e293c6f84c825545ce0b8d") +;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "2ec91e473fcad1ff20cd76edc4aab706") ;;; Generated autoloads from eieio-custom.el (autoload 'customize-object "eieio-custom" "\ @@ -927,7 +942,7 @@ Optional argument GROUP is the sub-group of slots to display. ;;;*** -;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "fc27fb3e17d23e43ad99d98572aa7b19") +;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "b849f8bf1312d5ef57e53d02173e4b5a") ;;; Generated autoloads from eieio-opt.el (autoload 'eieio-browse "eieio-opt" "\ @@ -948,11 +963,6 @@ Describe CTR if it is a class constructor. \(fn CTR)" nil nil) -(autoload 'eieio-help-generic "eieio-opt" "\ -Describe GENERIC if it is a generic function. - -\(fn GENERIC)" nil nil) - ;;;*** ;;; End of automatically extracted autoloads. diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 9542bc3b8b1..d527d676d51 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -1,4 +1,4 @@ -;;; eldoc.el --- show function arglist or variable docstring in echo area -*- lexical-binding: t; -*- +;;; eldoc.el --- Show function arglist or variable docstring in echo area -*- lexical-binding:t; -*- ;; Copyright (C) 1996-2015 Free Software Foundation, Inc. @@ -47,8 +47,6 @@ ;;; Code: -(require 'help-fns) ;For fundoc-usage handling functions. - (defgroup eldoc nil "Show function arglist or variable docstring in echo area." :group 'lisp @@ -75,18 +73,19 @@ Changing the value requires toggling `eldoc-mode'." :type '(choice string (const :tag "None" nil)) :group 'eldoc) -(defcustom eldoc-argument-case 'upcase +(defcustom eldoc-argument-case #'identity "Case to display argument names of functions, as a symbol. This has two preferred values: `upcase' or `downcase'. Actually, any name of a function which takes a string as an argument and returns another string is acceptable. -Note that if `eldoc-documentation-function' is non-nil, this variable -has no effect, unless the function handles it explicitly." +Note that this variable has no effect, unless +`eldoc-documentation-function' handles it explicitly." :type '(radio (function-item upcase) (function-item downcase) function) :group 'eldoc) +(make-obsolete-variable 'eldoc-argument-case nil "25.1") (defcustom eldoc-echo-area-use-multiline-p 'truncate-sym-name-if-fit "Allow long ElDoc messages to resize echo area display. @@ -103,8 +102,8 @@ If value is nil, messages are always truncated to fit in a single line of display in the echo area. Function or variable symbol name may be truncated to make more of the arglist or documentation string visible. -Note that if `eldoc-documentation-function' is non-nil, this variable -has no effect, unless the function handles it explicitly." +Note that this variable has no effect, unless +`eldoc-documentation-function' handles it explicitly." :type '(radio (const :tag "Always" t) (const :tag "Never" nil) (const :tag "Yes, but truncate symbol names if it will\ @@ -114,8 +113,8 @@ has no effect, unless the function handles it explicitly." (defface eldoc-highlight-function-argument '((t (:inherit bold))) "Face used for the argument at point in a function's argument list. -Note that if `eldoc-documentation-function' is non-nil, this face -has no effect, unless the function handles it explicitly." +Note that this face has no effect unless the `eldoc-documentation-function' +handles it explicitly." :group 'eldoc) ;;; No user options below here. @@ -127,7 +126,8 @@ choose to increase the number of buckets, you must do so before loading this file since the obarray is initialized at load time. Remember to keep it a prime number to improve hash performance.") -(defconst eldoc-message-commands +(defvar eldoc-message-commands + ;; Don't define as `defconst' since it would then go to (read-only) purespace. (make-vector eldoc-message-commands-table-size 0) "Commands after which it is appropriate to print in the echo area. ElDoc does not try to print function arglists, etc., after just any command, @@ -138,12 +138,14 @@ This variable contains an obarray of symbols; do not manipulate it directly. Instead, use `eldoc-add-command' and `eldoc-remove-command'.") ;; Not a constant. -(defconst eldoc-last-data (make-vector 3 nil) +(defvar eldoc-last-data (make-vector 3 nil) + ;; Don't define as `defconst' since it would then go to (read-only) purespace. "Bookkeeping; elements are as follows: 0 - contains the last symbol read from the buffer. 1 - contains the string last displayed in the echo area for variables, or argument string for functions. - 2 - 'function if function args, 'variable if variable documentation.") + 2 - `function' if function args, `variable' if variable documentation.") +(make-obsolete-variable 'eldoc-last-data "use your own instead" "25.1") (defvar eldoc-last-message nil) @@ -183,15 +185,33 @@ it displays the argument list of the function called in the expression point is on." :group 'eldoc :lighter eldoc-minor-mode-string (setq eldoc-last-message nil) - (if eldoc-mode - (progn - (when eldoc-print-after-edit - (setq-local eldoc-message-commands (eldoc-edit-message-commands))) - (add-hook 'post-command-hook 'eldoc-schedule-timer nil t) - (add-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area nil t)) + (cond + ((memq eldoc-documentation-function '(nil ignore)) + (message "There is no ElDoc support in this buffer") + (setq eldoc-mode nil)) + (eldoc-mode + (when eldoc-print-after-edit + (setq-local eldoc-message-commands (eldoc-edit-message-commands))) + (add-hook 'post-command-hook 'eldoc-schedule-timer nil t) + (add-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area nil t)) + (t (kill-local-variable 'eldoc-message-commands) (remove-hook 'post-command-hook 'eldoc-schedule-timer t) - (remove-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area t))) + (remove-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area t)))) + +;;;###autoload +(define-minor-mode global-eldoc-mode + "Enable `eldoc-mode' in all buffers where it's applicable." + :group 'eldoc :global t + :initialize 'custom-initialize-delay + :init-value t + (setq eldoc-last-message nil) + (if global-eldoc-mode + (progn + (add-hook 'post-command-hook #'eldoc-schedule-timer) + (add-hook 'pre-command-hook #'eldoc-pre-command-refresh-echo-area)) + (remove-hook 'post-command-hook #'eldoc-schedule-timer) + (remove-hook 'pre-command-hook #'eldoc-pre-command-refresh-echo-area))) ;;;###autoload (define-obsolete-function-alias 'turn-on-eldoc-mode 'eldoc-mode "24.4") @@ -199,11 +219,16 @@ expression point is on." (defun eldoc-schedule-timer () (or (and eldoc-timer - (memq eldoc-timer timer-idle-list)) + (memq eldoc-timer timer-idle-list)) ;FIXME: Why? (setq eldoc-timer (run-with-idle-timer eldoc-idle-delay t - (lambda () (and eldoc-mode (eldoc-print-current-symbol-info)))))) + (lambda () + (when (or eldoc-mode + (and global-eldoc-mode + (not (memq eldoc-documentation-function + '(nil ignore))))) + (eldoc-print-current-symbol-info)))))) ;; If user has changed the idle delay, update the timer. (cond ((not (= eldoc-idle-delay eldoc-current-idle-delay)) @@ -298,8 +323,8 @@ Otherwise work like `message'." ;;;###autoload -(defvar eldoc-documentation-function nil - "If non-nil, function to call to return doc string. +(defvar eldoc-documentation-function #'ignore + "Function to call to return doc string. The function of no args should return a one-line string for displaying doc about a function etc. appropriate to the context around point. It should return nil if there's no doc appropriate for the context. @@ -311,8 +336,12 @@ the variables `eldoc-argument-case' and `eldoc-echo-area-use-multiline-p', and the face `eldoc-highlight-function-argument', if they are to have any effect. -This variable is expected to be made buffer-local by modes (other than -Emacs Lisp mode) that support ElDoc.") +Major modes should modify this variable using `add-function', for example: + (add-function :before-until (local 'eldoc-documentation-function) + #'foo-mode-eldoc-function) +so that the global documentation function (i.e. the default value of the +variable) is taken into account if the major mode specific function does not +return any documentation.") (defun eldoc-print-current-symbol-info () ;; This is run from post-command-hook or some idle timer thing, @@ -323,240 +352,7 @@ Emacs Lisp mode) that support ElDoc.") (when eldoc-last-message (eldoc-message nil) nil)) - (if eldoc-documentation-function - (eldoc-message (funcall eldoc-documentation-function)) - (let* ((current-symbol (eldoc-current-symbol)) - (current-fnsym (eldoc-fnsym-in-current-sexp)) - (doc (cond - ((null current-fnsym) - nil) - ((eq current-symbol (car current-fnsym)) - (or (apply 'eldoc-get-fnsym-args-string - current-fnsym) - (eldoc-get-var-docstring current-symbol))) - (t - (or (eldoc-get-var-docstring current-symbol) - (apply 'eldoc-get-fnsym-args-string - current-fnsym)))))) - (eldoc-message doc)))))) - -(defun eldoc-get-fnsym-args-string (sym &optional index) - "Return a string containing the parameter list of the function SYM. -If SYM is a subr and no arglist is obtainable from the docstring -or elsewhere, return a 1-line docstring. Calls the functions -`eldoc-function-argstring-format' and -`eldoc-highlight-function-argument' to format the result. The -former calls `eldoc-argument-case'; the latter gives the -function name `font-lock-function-name-face', and optionally -highlights argument number INDEX." - (let (args doc advertised) - (cond ((not (and sym (symbolp sym) (fboundp sym)))) - ((and (eq sym (aref eldoc-last-data 0)) - (eq 'function (aref eldoc-last-data 2))) - (setq doc (aref eldoc-last-data 1))) - ((listp (setq advertised (gethash (indirect-function sym) - advertised-signature-table t))) - (setq args advertised)) - ((setq doc (help-split-fundoc (documentation sym t) sym)) - (setq args (car doc)) - ;; Remove any enclosing (), since e-function-argstring adds them. - (string-match "\\`[^ )]* ?" args) - (setq args (substring args (match-end 0))) - (if (string-match-p ")\\'" args) - (setq args (substring args 0 -1)))) - (t - (setq args (help-function-arglist sym)))) - (if args - ;; Stringify, and store before highlighting, downcasing, etc. - ;; FIXME should truncate before storing. - (eldoc-last-data-store sym (setq args (eldoc-function-argstring args)) - 'function) - (setq args doc)) ; use stored value - ;; Change case, highlight, truncate. - (if args - (eldoc-highlight-function-argument - sym (eldoc-function-argstring-format args) index)))) - -(defun eldoc-highlight-function-argument (sym args index) - "Highlight argument INDEX in ARGS list for function SYM. -In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." - (let ((start nil) - (end 0) - (argument-face 'eldoc-highlight-function-argument)) - ;; Find the current argument in the argument string. We need to - ;; handle `&rest' and informal `...' properly. - ;; - ;; FIXME: What to do with optional arguments, like in - ;; (defun NAME ARGLIST [DOCSTRING] BODY...) case? - ;; The problem is there is no robust way to determine if - ;; the current argument is indeed a docstring. - (while (and index (>= index 1)) - (if (string-match "[^ ()]+" args end) - (progn - (setq start (match-beginning 0) - end (match-end 0)) - (let ((argument (match-string 0 args))) - (cond ((string= argument "&rest") - ;; All the rest arguments are the same. - (setq index 1)) - ((string= argument "&optional")) - ((string-match-p "\\.\\.\\.$" argument) - (setq index 0)) - (t - (setq index (1- index)))))) - (setq end (length args) - start (1- end) - argument-face 'font-lock-warning-face - index 0))) - (let ((doc args)) - (when start - (setq doc (copy-sequence args)) - (add-text-properties start end (list 'face argument-face) doc)) - (setq doc (eldoc-docstring-format-sym-doc - sym doc (if (functionp sym) 'font-lock-function-name-face - 'font-lock-keyword-face))) - doc))) - -;; Return a string containing a brief (one-line) documentation string for -;; the variable. -(defun eldoc-get-var-docstring (sym) - (when sym - (cond ((and (eq sym (aref eldoc-last-data 0)) - (eq 'variable (aref eldoc-last-data 2))) - (aref eldoc-last-data 1)) - (t - (let ((doc (documentation-property sym 'variable-documentation t))) - (cond (doc - (setq doc (eldoc-docstring-format-sym-doc - sym (eldoc-docstring-first-line doc) - 'font-lock-variable-name-face)) - (eldoc-last-data-store sym doc 'variable))) - doc))))) - -(defun eldoc-last-data-store (symbol doc type) - (aset eldoc-last-data 0 symbol) - (aset eldoc-last-data 1 doc) - (aset eldoc-last-data 2 type)) - -;; Note that any leading `*' in the docstring (which indicates the variable -;; is a user option) is removed. -(defun eldoc-docstring-first-line (doc) - (and (stringp doc) - (substitute-command-keys - (save-match-data - ;; Don't use "^" in the regexp below since it may match - ;; anywhere in the doc-string. - (let ((start (if (string-match "\\`\\*" doc) (match-end 0) 0))) - (cond ((string-match "\n" doc) - (substring doc start (match-beginning 0))) - ((zerop start) doc) - (t (substring doc start)))))))) - -;; If the entire line cannot fit in the echo area, the symbol name may be -;; truncated or eliminated entirely from the output to make room for the -;; description. -(defun eldoc-docstring-format-sym-doc (sym doc face) - (save-match-data - (let* ((name (symbol-name sym)) - (ea-multi eldoc-echo-area-use-multiline-p) - ;; Subtract 1 from window width since emacs will not write - ;; any chars to the last column, or in later versions, will - ;; cause a wraparound and resize of the echo area. - (ea-width (1- (window-width (minibuffer-window)))) - (strip (- (+ (length name) (length ": ") (length doc)) ea-width))) - (cond ((or (<= strip 0) - (eq ea-multi t) - (and ea-multi (> (length doc) ea-width))) - (format "%s: %s" (propertize name 'face face) doc)) - ((> (length doc) ea-width) - (substring (format "%s" doc) 0 ea-width)) - ((>= strip (length name)) - (format "%s" doc)) - (t - ;; Show the end of the partial symbol name, rather - ;; than the beginning, since the former is more likely - ;; to be unique given package namespace conventions. - (setq name (substring name strip)) - (format "%s: %s" (propertize name 'face face) doc)))))) - - -;; Return a list of current function name and argument index. -(defun eldoc-fnsym-in-current-sexp () - (save-excursion - (let ((argument-index (1- (eldoc-beginning-of-sexp)))) - ;; If we are at the beginning of function name, this will be -1. - (when (< argument-index 0) - (setq argument-index 0)) - ;; Don't do anything if current word is inside a string. - (if (= (or (char-after (1- (point))) 0) ?\") - nil - (list (eldoc-current-symbol) argument-index))))) - -;; Move to the beginning of current sexp. Return the number of nested -;; sexp the point was over or after. -(defun eldoc-beginning-of-sexp () - (let ((parse-sexp-ignore-comments t) - (num-skipped-sexps 0)) - (condition-case _ - (progn - ;; First account for the case the point is directly over a - ;; beginning of a nested sexp. - (condition-case _ - (let ((p (point))) - (forward-sexp -1) - (forward-sexp 1) - (when (< (point) p) - (setq num-skipped-sexps 1))) - (error)) - (while - (let ((p (point))) - (forward-sexp -1) - (when (< (point) p) - (setq num-skipped-sexps (1+ num-skipped-sexps)))))) - (error)) - num-skipped-sexps)) - -;; returns nil unless current word is an interned symbol. -(defun eldoc-current-symbol () - (let ((c (char-after (point)))) - (and c - (memq (char-syntax c) '(?w ?_)) - (intern-soft (current-word))))) - -;; Do indirect function resolution if possible. -(defun eldoc-symbol-function (fsym) - (let ((defn (symbol-function fsym))) - (and (symbolp defn) - (condition-case _ - (setq defn (indirect-function fsym)) - (error (setq defn nil)))) - defn)) - -(defun eldoc-function-argstring (arglist) - "Return ARGLIST as a string enclosed by (). -ARGLIST is either a string, or a list of strings or symbols." - (cond ((stringp arglist)) - ((not (listp arglist)) - (setq arglist nil)) - ((symbolp (car arglist)) - (setq arglist - (mapconcat (lambda (s) (symbol-name s)) - arglist " "))) - ((stringp (car arglist)) - (setq arglist - (mapconcat (lambda (s) s) - arglist " ")))) - (if arglist - (format "(%s)" arglist))) - -(defun eldoc-function-argstring-format (argstring) - "Apply `eldoc-argument-case' to each word in ARGSTRING. -The words \"&rest\", \"&optional\" are returned unchanged." - (mapconcat (lambda (s) - (if (string-match-p "\\`(?&\\(?:optional\\|rest\\))?\\'" s) - s - (funcall eldoc-argument-case s))) - (split-string argstring) " ")) + (eldoc-message (funcall eldoc-documentation-function))))) ;; When point is in a sexp, the function args are not reprinted in the echo @@ -573,7 +369,7 @@ The words \"&rest\", \"&optional\" are returned unchanged." (defun eldoc-add-command-completions (&rest names) (dolist (name names) - (apply 'eldoc-add-command (all-completions name obarray 'commandp)))) + (apply #'eldoc-add-command (all-completions name obarray 'commandp)))) (defun eldoc-remove-command (&rest cmds) (dolist (name cmds) @@ -583,7 +379,7 @@ The words \"&rest\", \"&optional\" are returned unchanged." (defun eldoc-remove-command-completions (&rest names) (dolist (name names) - (apply 'eldoc-remove-command + (apply #'eldoc-remove-command (all-completions name eldoc-message-commands)))) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 3af43fbf142..4ffd8cd8558 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1320,7 +1320,7 @@ RESULT must be an `ert-test-result-with-condition'." (unwind-protect (progn (insert message "\n") - (setq end (copy-marker (point))) + (setq end (point-marker)) (goto-char begin) (insert " " prefix) (forward-line 1) @@ -1463,6 +1463,65 @@ the tests)." (kill-emacs 2)))) +(defun ert-summarize-tests-batch-and-exit () + "Summarize the results of testing. +Expects to be called in batch mode, with logfiles as command-line arguments. +The logfiles should have the `ert-run-tests-batch' format. When finished, +this exits Emacs, with status as per `ert-run-tests-batch-and-exit'." + (or noninteractive + (user-error "This function is only for use in batch mode")) + (let ((nlogs (length command-line-args-left)) + (ntests 0) (nrun 0) (nexpected 0) (nunexpected 0) (nskipped 0) + nnotrun logfile notests badtests unexpected) + (with-temp-buffer + (while (setq logfile (pop command-line-args-left)) + (erase-buffer) + (insert-file-contents logfile) + (if (not (re-search-forward "^Running \\([0-9]+\\) tests" nil t)) + (push logfile notests) + (setq ntests (+ ntests (string-to-number (match-string 1)))) + (if (not (re-search-forward "^\\(Aborted: \\)?\ +Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\ +\\(?:, \\([0-9]+\\) unexpected\\)?\ +\\(?:, \\([0-9]+\\) skipped\\)?" nil t)) + (push logfile badtests) + (if (match-string 1) (push logfile badtests)) + (setq nrun (+ nrun (string-to-number (match-string 2))) + nexpected (+ nexpected (string-to-number (match-string 3)))) + (when (match-string 4) + (push logfile unexpected) + (setq nunexpected (+ nunexpected + (string-to-number (match-string 4))))) + (if (match-string 5) + (setq nskipped (+ nskipped + (string-to-number (match-string 5))))))))) + (setq nnotrun (- ntests nrun)) + (message "\nSUMMARY OF TEST RESULTS") + (message "-----------------------") + (message "Files examined: %d" nlogs) + (message "Ran %d tests%s, %d results as expected%s%s" + nrun + (if (zerop nnotrun) "" (format ", %d failed to run" nnotrun)) + nexpected + (if (zerop nunexpected) + "" + (format ", %d unexpected" nunexpected)) + (if (zerop nskipped) + "" + (format ", %d skipped" nskipped))) + (when notests + (message "%d files did not contain any tests:" (length notests)) + (mapc (lambda (l) (message " %s" l)) notests)) + (when badtests + (message "%d files did not finish:" (length badtests)) + (mapc (lambda (l) (message " %s" l)) badtests)) + (when unexpected + (message "%d files contained unexpected results:" (length unexpected)) + (mapc (lambda (l) (message " %s" l)) unexpected)) + (kill-emacs (cond ((or notests badtests (not (zerop nnotrun))) 2) + (unexpected 1) + (t 0))))) + ;;; Utility functions for load/unload actions. (defun ert--activate-font-lock-keywords () diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 71e8865b01f..7ea13d4637b 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -1,4 +1,4 @@ -;;; find-func.el --- find the definition of the Emacs Lisp function near point +;;; find-func.el --- find the definition of the Emacs Lisp function near point -*- lexical-binding:t -*- ;; Copyright (C) 1997, 1999, 2001-2015 Free Software Foundation, Inc. @@ -59,7 +59,7 @@ (concat "^\\s-*(\\(def\\(ine-skeleton\\|ine-generic-mode\\|ine-derived-mode\\|\ ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\ -foo\\|[^icfgv]\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\ +foo\\|\\(?:[^icfgv]\\|g[^r]\\)\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\ menu-bar-make-toggle\\)" find-function-space-re "\\('\\|\(quote \\)?%s\\(\\s-\\|$\\|\(\\|\)\\)") @@ -106,7 +106,10 @@ Please send improvements and fixes to the maintainer." (defface . find-face-regexp)) "Alist mapping definition types into regexp variables. Each regexp variable's value should actually be a format string -to be used to substitute the desired symbol name into the regexp.") +to be used to substitute the desired symbol name into the regexp. +Instead of regexp variable, types can be mapped to functions as well, +in which case the function is called with one argument (the object +we're looking for) and it should search for it.") (put 'find-function-regexp-alist 'risky-local-variable t) (defcustom find-function-source-path nil @@ -178,8 +181,7 @@ LIBRARY should be a string (the name of the library)." (defvar find-function-C-source-directory (let ((dir (expand-file-name "src" source-directory))) - (when (and (file-directory-p dir) (file-readable-p dir)) - dir)) + (if (file-accessible-directory-p dir) dir)) "Directory where the C source files of Emacs can be found. If nil, do not try to find the source code of functions and variables defined in C.") @@ -283,35 +285,78 @@ The search is done in the source for library LIBRARY." (let* ((filename (find-library-name library)) (regexp-symbol (cdr (assq type find-function-regexp-alist)))) (with-current-buffer (find-file-noselect filename) - (let ((regexp (format (symbol-value regexp-symbol) - ;; Entry for ` (backquote) macro in loaddefs.el, - ;; (defalias (quote \`)..., has a \ but - ;; (symbol-name symbol) doesn't. Add an - ;; optional \ to catch this. - (concat "\\\\?" - (regexp-quote (symbol-name symbol))))) + (let ((regexp (if (functionp regexp-symbol) regexp-symbol + (format (symbol-value regexp-symbol) + ;; Entry for ` (backquote) macro in loaddefs.el, + ;; (defalias (quote \`)..., has a \ but + ;; (symbol-name symbol) doesn't. Add an + ;; optional \ to catch this. + (concat "\\\\?" + (regexp-quote (symbol-name symbol)))))) (case-fold-search)) (with-syntax-table emacs-lisp-mode-syntax-table (goto-char (point-min)) - (if (or (re-search-forward regexp nil t) - ;; `regexp' matches definitions using known forms like - ;; `defun', or `defvar'. But some functions/variables - ;; are defined using special macros (or functions), so - ;; if `regexp' can't find the definition, we look for - ;; something of the form "(SOMETHING <symbol> ...)". - ;; This fails to distinguish function definitions from - ;; variable declarations (or even uses thereof), but is - ;; a good pragmatic fallback. - (re-search-forward - (concat "^([^ ]+" find-function-space-re "['(]?" - (regexp-quote (symbol-name symbol)) - "\\_>") - nil t)) + (if (if (functionp regexp) + (funcall regexp symbol) + (or (re-search-forward regexp nil t) + ;; `regexp' matches definitions using known forms like + ;; `defun', or `defvar'. But some functions/variables + ;; are defined using special macros (or functions), so + ;; if `regexp' can't find the definition, we look for + ;; something of the form "(SOMETHING <symbol> ...)". + ;; This fails to distinguish function definitions from + ;; variable declarations (or even uses thereof), but is + ;; a good pragmatic fallback. + (re-search-forward + (concat "^([^ ]+" find-function-space-re "['(]?" + (regexp-quote (symbol-name symbol)) + "\\_>") + nil t))) (progn (beginning-of-line) (cons (current-buffer) (point))) (cons (current-buffer) nil)))))))) +(defun find-function-library (function &optional lisp-only verbose) + "Return the pair (ORIG-FUNCTION . LIBRARY) for FUNCTION. + +ORIG-FUNCTION is the original name, after removing all advice and +resolving aliases. LIBRARY is an absolute file name, a relative +file name inside the C sources directory, or a name of an +autoloaded feature. + +If ORIG-FUNCTION is a built-in function and LISP-ONLY is non-nil, +signal an error. + +If VERBOSE is non-nil, and FUNCTION is an alias, display a +message about the whole chain of aliases." + (let ((def (if (symbolp function) + (symbol-function (find-function-advised-original function)))) + aliases) + ;; FIXME for completeness, it might be nice to print something like: + ;; foo (which is advised), which is an alias for bar (which is advised). + (while (and def (symbolp def)) + (or (eq def function) + (not verbose) + (setq aliases (if aliases + (concat aliases + (format ", which is an alias for `%s'" + (symbol-name def))) + (format "`%s' is an alias for `%s'" + function (symbol-name def))))) + (setq function (symbol-function (find-function-advised-original function)) + def (symbol-function (find-function-advised-original function)))) + (if aliases + (message "%s" aliases)) + (cons function + (cond + ((autoloadp def) (nth 1 def)) + ((subrp def) + (if lisp-only + (error "%s is a built-in function" function)) + (help-C-file-name def 'subr)) + ((symbol-file function 'defun)))))) + ;;;###autoload (defun find-function-noselect (function &optional lisp-only) "Return a pair (BUFFER . POINT) pointing to the definition of FUNCTION. @@ -330,30 +375,8 @@ searched for in `find-function-source-path' if non-nil, otherwise in `load-path'." (if (not function) (error "You didn't specify a function")) - (let ((def (symbol-function (find-function-advised-original function))) - aliases) - ;; FIXME for completeness, it might be nice to print something like: - ;; foo (which is advised), which is an alias for bar (which is advised). - (while (symbolp def) - (or (eq def function) - (if aliases - (setq aliases (concat aliases - (format ", which is an alias for `%s'" - (symbol-name def)))) - (setq aliases (format "`%s' is an alias for `%s'" - function (symbol-name def))))) - (setq function (symbol-function (find-function-advised-original function)) - def (symbol-function (find-function-advised-original function)))) - (if aliases - (message "%s" aliases)) - (let ((library - (cond ((autoloadp def) (nth 1 def)) - ((subrp def) - (if lisp-only - (error "%s is a built-in function" function)) - (help-C-file-name def 'subr)) - ((symbol-file function 'defun))))) - (find-function-search-for-symbol function nil library)))) + (let ((func-lib (find-function-library function lisp-only t))) + (find-function-search-for-symbol (car func-lib) nil (cdr func-lib)))) (defun find-function-read (&optional type) "Read and return an interned symbol, defaulting to the one near point. @@ -392,7 +415,6 @@ See also `find-function-after-hook'. Set mark before moving, if the buffer already existed." (let* ((orig-point (point)) - (orig-buf (window-buffer)) (orig-buffers (buffer-list)) (buffer-point (save-excursion (find-definition-noselect symbol type))) diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index bc87f131164..5d6e6e1b372 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -89,10 +89,10 @@ DO must return an Elisp expression." (let* ((head (car place)) (gf (function-get head 'gv-expander 'autoload))) (if gf (apply gf do (cdr place)) - (let ((me (macroexpand place ;FIXME: expand one step at a time! - ;; (append macroexpand-all-environment - ;; gv--macro-environment) - macroexpand-all-environment))) + (let ((me (macroexpand-1 place + ;; (append macroexpand-all-environment + ;; gv--macro-environment) + macroexpand-all-environment))) (if (and (eq me place) (get head 'compiler-macro)) ;; Expand compiler macros: this takes care of all the accessors ;; defined via cl-defsubst, such as cXXXr and defstruct slots. @@ -357,6 +357,34 @@ The return value is the last VAL in the list. (macroexp-let2 nil v val `(with-current-buffer ,buf (set (make-local-variable ,var) ,v)))) +(gv-define-expander alist-get + (lambda (do key alist &optional default remove) + (macroexp-let2 macroexp-copyable-p k key + (gv-letplace (getter setter) alist + (macroexp-let2 nil p `(assq ,k ,getter) + (funcall do (if (null default) `(cdr ,p) + `(if ,p (cdr ,p) ,default)) + (lambda (v) + (macroexp-let2 nil v v + (let ((set-exp + `(if ,p (setcdr ,p ,v) + ,(funcall setter + `(cons (setq ,p (cons ,k ,v)) + ,getter))))) + (cond + ((null remove) set-exp) + ((or (eql v default) + (and (eq (car-safe v) 'quote) + (eq (car-safe default) 'quote) + (eql (cadr v) (cadr default)))) + `(if ,p ,(funcall setter `(delq ,p ,getter)))) + (t + `(cond + ((not (eql ,default ,v)) ,set-exp) + (,p ,(funcall setter + `(delq ,p ,getter))))))))))))))) + + ;;; Some occasionally handy extensions. ;; While several of the "places" below are not terribly useful for direct use, @@ -479,22 +507,13 @@ REF must have been previously obtained with `gv-ref'." ;; … => (load "gv.el") => (macroexpand-all (defsubst gv-deref …)) => (macroexpand (defun …)) => (load "gv.el") (gv-define-setter gv-deref (v ref) `(funcall (cdr ,ref) ,v)) -;;; Vaguely related definitions that should be moved elsewhere. - -;; (defun alist-get (key alist) -;; "Get the value associated to KEY in ALIST." -;; (declare -;; (gv-expander -;; (lambda (do) -;; (macroexp-let2 macroexp-copyable-p k key -;; (gv-letplace (getter setter) alist -;; (macroexp-let2 nil p `(assoc ,k ,getter) -;; (funcall do `(cdr ,p) -;; (lambda (v) -;; `(if ,p (setcdr ,p ,v) -;; ,(funcall setter -;; `(cons (cons ,k ,v) ,getter))))))))))) -;; (cdr (assoc key alist))) +;; (defmacro gv-letref (vars place &rest body) +;; (declare (indent 2) (debug (sexp form &rest body))) +;; (require 'cl-lib) ;Can't require cl-lib at top-level for bootstrap reasons! +;; (gv-letplace (getter setter) place +;; `(cl-macrolet ((,(nth 0 vars) () ',getter) +;; (,(nth 1 vars) (v) (funcall ',setter v))) +;; ,@body))) (provide 'gv) ;;; gv.el ends here diff --git a/lisp/emacs-lisp/inline.el b/lisp/emacs-lisp/inline.el new file mode 100644 index 00000000000..c3f696feda1 --- /dev/null +++ b/lisp/emacs-lisp/inline.el @@ -0,0 +1,262 @@ +;;; inline.el --- Define functions by their inliner -*- lexical-binding:t; -*- + +;; Copyright (C) 2014-2015 Free Software Foundation, Inc. + +;; Author: Stefan Monnier <monnier@iro.umontreal.ca> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This package provides the macro `define-inline' which lets you define +;; functions by defining their (exhaustive) compiler macro. +;; +;; The idea is that instead of doing like defsubst and cl-defsubst (i.e. from +;; the function's definition, guess the best way to inline the function), +;; we go the other way around: the programmer provides the code that does the +;; inlining (as a compiler-macro) and from that we derive the definition of the +;; function itself. The idea originated in an attempt to clean up `cl-typep', +;; whose function definition amounted to (eval (cl--make-type-test EXP TYPE)). +;; +;; The simplest use is for plain and simple inlinable functions. Rather than: +;; +;; (defmacro myaccessor (obj) +;; (macroexp-let2 macroexp-copyable-p obj obj +;; `(if (foop ,obj) (aref (cdr ,obj) 3) (aref ,obj 2)))) +;; Or +;; (defsubst myaccessor (obj) +;; (if (foop obj) (aref (cdr obj) 3) (aref obj 2))) +;; Or +;; (cl-defsubst myaccessor (obj) +;; (if (foop obj) (aref (cdr obj) 3) (aref obj 2))) +;; +;; You'd do +;; +;; (define-inline myaccessor (obj) +;; (inline-letevals (obj) +;; (inline-quote (if (foop ,obj) (aref (cdr ,obj) 3) (aref ,obj 2))))) +;; +;; Other than verbosity, you get the best of all 3 above without their +;; respective downsides: +;; - defmacro: can't be passed to `mapcar' since it's not a function. +;; - defsubst: not as efficient, and doesn't work as a `gv' place. +;; - cl-defsubst: only works by accident, since it has latent bugs in its +;; handling of variables and scopes which could bite you at any time. +;; (e.g. try (cl-defsubst my-test1 (x) (let ((y 5)) (+ x y))) +;; and then M-: (macroexpand-all '(my-test1 y)) RET) +;; There is still one downside shared with the defmacro and cl-defsubst +;; approach: when the function is inlined, the scoping rules (dynamic or +;; lexical) will be inherited from the the call site. + +;; Of course, since define-inline defines a compiler macro, you can also do +;; call-site optimizations, just like you can with `defmacro', but not with +;; defsubst nor cl-defsubst. + +;;; Code: + +(require 'macroexp) + +(defmacro inline-quote (_exp) + "Similar to backquote, but quotes code and only accepts , and not ,@." + (declare (debug t)) + (error "inline-quote can only be used within define-inline")) + +(defmacro inline-const-p (_exp) + "Return non-nil if the value of EXP is already known." + (declare (debug t)) + (error "inline-const-p can only be used within define-inline")) + +(defmacro inline-const-val (_exp) + "Return the value of EXP." + (declare (debug t)) + (error "inline-const-val can only be used within define-inline")) + +(defmacro inline-error (_format &rest _args) + "Signal an error." + (declare (debug t)) + (error "inline-error can only be used within define-inline")) + +(defmacro inline--leteval (_var-exp &rest _body) + (declare (indent 1) (debug (sexp &rest body))) + (error "inline-letevals can only be used within define-inline")) +(defmacro inline--letlisteval (_list &rest _body) + (declare (indent 1) (debug (sexp &rest body))) + (error "inline-letevals can only be used within define-inline")) + +(defmacro inline-letevals (vars &rest body) + "Make sure the expressions in VARS are evaluated. +VARS should be a list of elements of the form (VAR EXP) or just VAR, in case +EXP is equal to VAR. The result is to evaluate EXP and bind the result to VAR. + +The tail of VARS can be either nil or a symbol VAR which should hold a list +of arguments,in which case each argument is evaluated and the resulting +new list is re-bound to VAR. + +After VARS is handled, BODY is evaluated in the new environment." + (declare (indent 1) (debug (sexp &rest form))) + (cond + ((consp vars) + `(inline--leteval ,(pop vars) (inline-letevals ,vars ,@body))) + (vars + `(inline--letlisteval ,vars ,@body)) + (t (macroexp-progn body)))) + +;; (defmacro inline-if (testfun testexp then else) +;; (declare (indent 2) (debug (sexp symbolp form form))) +;; (macroexp-let2 macroexp-copyable-p testsym testexp +;; `(if (inline-const-p ,testexp) +;; (if (,testfun (inline-const-val ,testexp)) ,then ,else) +;; (inline-quote (if (,testfun ,testexp) ,(list '\, then) +;; ,(list '\, else)))))) + +;;;###autoload +(defmacro define-inline (name args &rest body) + ;; FIXME: How can this work with CL arglists? + (declare (indent defun) (debug defun) (doc-string 3)) + (let ((doc (if (stringp (car-safe body)) (list (pop body)))) + (declares (if (eq (car-safe (car-safe body)) 'declare) (pop body))) + (cm-name (intern (format "%s--inliner" name))) + (bodyexp (macroexp-progn body))) + ;; If the function is autoloaded then when we load the .el file, the + ;; `compiler-macro' property is already set (from loaddefs.el) and might + ;; hence be called during the macroexpand-all calls below (if the function + ;; is recursive). + ;; So we disable any pre-loaded compiler-macro setting to avoid this. + (function-put name 'compiler-macro nil) + `(progn + (defun ,name ,args + ,@doc + (declare (compiler-macro ,cm-name) ,@(cdr declares)) + ,(macroexpand-all bodyexp + `((inline-quote . inline--dont-quote) + ;; (inline-\` . inline--dont-quote) + (inline--leteval . inline--dont-leteval) + (inline--letlisteval . inline--dont-letlisteval) + (inline-const-p . inline--alwaysconst-p) + (inline-const-val . inline--alwaysconst-val) + (inline-error . inline--error) + ,@macroexpand-all-environment))) + :autoload-end + (eval-and-compile + (defun ,cm-name ,(cons 'inline--form args) + (ignore inline--form) ;In case it's not used! + (catch 'inline--just-use + ,(macroexpand-all + bodyexp + `((inline-quote . inline--do-quote) + ;; (inline-\` . inline--do-quote) + (inline--leteval . inline--do-leteval) + (inline--letlisteval + . inline--do-letlisteval) + (inline-const-p . inline--testconst-p) + (inline-const-val . inline--getconst-val) + (inline-error . inline--warning) + ,@macroexpand-all-environment)))))))) + +(defun inline--do-quote (exp) + (pcase exp + (`(,'\, ,e) e) ;Eval `e' now *and* later. + (`'(,'\, ,e) `(list 'quote ,e)) ;Only eval `e' now, not later. + (`#'(,'\, ,e) `(list 'function ,e)) ;Only eval `e' now, not later. + ((pred consp) + (let ((args ())) + (while (and (consp exp) (not (eq '\, (car exp)))) + (push (inline--do-quote (pop exp)) args)) + (setq args (nreverse args)) + (if exp + `(backquote-list* ,@args ,(inline--do-quote exp)) + `(list ,@args)))) + (_ (macroexp-quote exp)))) + +(defun inline--dont-quote (exp) + (pcase exp + (`(,'\, ,e) e) + (`'(,'\, ,e) e) + (`#'(,'\, ,e) e) + ((pred consp) + (let ((args ())) + (while (and (consp exp) (not (eq '\, (car exp)))) + (push (inline--dont-quote (pop exp)) args)) + (setq args (nreverse args)) + (if exp + `(apply ,@args ,(inline--dont-quote exp)) + args))) + (_ exp))) + +(defun inline--do-leteval (var-exp &rest body) + `(macroexp-let2 ,(if (symbolp var-exp) #'macroexp-copyable-p #'ignore) + ,(or (car-safe var-exp) var-exp) + ,(or (car (cdr-safe var-exp)) var-exp) + ,@body)) + +(defun inline--dont-leteval (var-exp &rest body) + (if (symbolp var-exp) + (macroexp-progn body) + `(let (,var-exp) ,@body))) + +(defun inline--do-letlisteval (listvar &rest body) + ;; Here's a sample situation: + ;; (define-inline foo (arg &rest keys) + ;; (inline-letevals (arg . keys) + ;; <check-keys>)) + ;; I.e. in <check-keys> we need `keys' to contain a list of + ;; macroexp-copyable-p expressions. + (let ((bsym (make-symbol "bindings"))) + `(let* ((,bsym ()) + (,listvar (mapcar (lambda (e) + (if (macroexp-copyable-p e) e + (let ((v (make-symbol "v"))) + (push (list v e) ,bsym) + v))) + ,listvar))) + (macroexp-let* (nreverse ,bsym) + ,(macroexp-progn body))))) + +(defun inline--dont-letlisteval (_listvar &rest body) + (macroexp-progn body)) + +(defun inline--testconst-p (exp) + (macroexp-let2 macroexp-copyable-p exp exp + `(or (macroexp-const-p ,exp) + (eq (car-safe ,exp) 'function)))) + +(defun inline--alwaysconst-p (_exp) + t) + +(defun inline--getconst-val (exp) + (macroexp-let2 macroexp-copyable-p exp exp + `(cond + ((not ,(inline--testconst-p exp)) + (throw 'inline--just-use inline--form)) + ((consp ,exp) (cadr ,exp)) + (t ,exp)))) + +(defun inline--alwaysconst-val (exp) + exp) + +(defun inline--error (&rest args) + `(error ,@args)) + +(defun inline--warning (&rest _args) + `(throw 'inline--just-use + ;; FIXME: This would inf-loop by calling us right back when + ;; macroexpand-all recurses to expand inline--form. + ;; (macroexp--warn-and-return (format ,@args) + ;; inline--form) + inline--form)) + +(provide 'inline) +;;; inline.el ends here diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 6073de51639..868a9578b0d 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -33,17 +33,10 @@ (defvar font-lock-keywords-case-fold-search) (defvar font-lock-string-face) -(defvar lisp-mode-abbrev-table nil) (define-abbrev-table 'lisp-mode-abbrev-table () "Abbrev table for Lisp mode.") -(defvar emacs-lisp-mode-abbrev-table nil) -(define-abbrev-table 'emacs-lisp-mode-abbrev-table () - "Abbrev table for Emacs Lisp mode. -It has `lisp-mode-abbrev-table' as its parent." - :parents (list lisp-mode-abbrev-table)) - -(defvar emacs-lisp-mode-syntax-table +(defvar lisp--mode-syntax-table (let ((table (make-syntax-table)) (i 0)) (while (< i ?0) @@ -82,13 +75,11 @@ It has `lisp-mode-abbrev-table' as its parent." (modify-syntax-entry ?\\ "\\ " table) (modify-syntax-entry ?\( "() " table) (modify-syntax-entry ?\) ")( " table) - (modify-syntax-entry ?\[ "(] " table) - (modify-syntax-entry ?\] ")[ " table) table) - "Syntax table used in `emacs-lisp-mode'.") + "Parent syntax table used in Lisp modes.") (defvar lisp-mode-syntax-table - (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) + (let ((table (make-syntax-table lisp--mode-syntax-table))) (modify-syntax-entry ?\[ "_ " table) (modify-syntax-entry ?\] "_ " table) (modify-syntax-entry ?# "' 14" table) @@ -102,25 +93,35 @@ It has `lisp-mode-abbrev-table' as its parent." (purecopy (concat "^\\s-*(" (eval-when-compile (regexp-opt - '("defun" "defun*" "defsubst" "defmacro" - "defadvice" "define-skeleton" - "define-minor-mode" "define-global-minor-mode" + '("defun" "defmacro" + ;; Elisp. + "defun*" "defsubst" + "define-advice" "defadvice" "define-skeleton" + "define-compilation-mode" "define-minor-mode" + "define-global-minor-mode" "define-globalized-minor-mode" "define-derived-mode" "define-generic-mode" + "cl-defun" "cl-defsubst" "cl-defmacro" + "cl-define-compiler-macro" + ;; CL. "define-compiler-macro" "define-modify-macro" "defsetf" "define-setf-expander" "define-method-combination" - "defgeneric" "defmethod" - "cl-defun" "cl-defsubst" "cl-defmacro" - "cl-define-compiler-macro") t)) + ;; CLOS and EIEIO + "defgeneric" "defmethod") + t)) "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)")) 2) (list (purecopy "Variables") (purecopy (concat "^\\s-*(" (eval-when-compile (regexp-opt - '("defconst" "defconstant" "defcustom" - "defparameter" "define-symbol-macro") t)) + '(;; Elisp + "defconst" "defcustom" + ;; CL + "defconstant" + "defparameter" "define-symbol-macro") + t)) "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)")) 2) ;; For `defvar', we ignore (defvar FOO) constructs. @@ -132,10 +133,16 @@ It has `lisp-mode-abbrev-table' as its parent." (purecopy (concat "^\\s-*(" (eval-when-compile (regexp-opt - '("defgroup" "deftheme" "deftype" "defstruct" - "defclass" "define-condition" "define-widget" - "defface" "defpackage" "cl-deftype" - "cl-defstruct") t)) + '(;; Elisp + "defgroup" "deftheme" + "define-widget" "define-error" + "defface" "cl-deftype" "cl-defstruct" + ;; CL + "deftype" "defstruct" + "define-condition" "defpackage" + ;; CLOS and EIEIO + "defclass") + t)) "\\s-+'?\\(\\(\\sw\\|\\s_\\)+\\)")) 2)) @@ -156,6 +163,24 @@ It has `lisp-mode-abbrev-table' as its parent." ;;;; Font-lock support. +(defun lisp--match-hidden-arg (limit) + (let ((res nil)) + (while + (let ((ppss (parse-partial-sexp (line-beginning-position) + (line-end-position) + -1))) + (skip-syntax-forward " )") + (if (or (>= (car ppss) 0) + (looking-at ";\\|$")) + (progn + (forward-line 1) + (< (point) limit)) + (looking-at ".*") ;Set the match-data. + (forward-line 1) + (setq res (point)) + nil))) + res)) + (pcase-let ((`(,vdefs ,tdefs ,el-defs-re ,cl-defs-re @@ -170,7 +195,7 @@ It has `lisp-mode-abbrev-table' as its parent." "ignore-errors" "dotimes" "dolist" "declare")) (lisp-errs '("warn" "error" "signal")) ;; Elisp constructs. FIXME: update dynamically from obarray. - (el-fdefs '("defadvice" "defalias" + (el-fdefs '("define-advice" "defadvice" "defalias" "define-derived-mode" "define-minor-mode" "define-generic-mode" "define-global-minor-mode" "define-globalized-minor-mode" "define-skeleton" @@ -178,9 +203,9 @@ It has `lisp-mode-abbrev-table' as its parent." (el-vdefs '("defconst" "defcustom" "defvaralias" "defvar-local" "defface")) (el-tdefs '("defgroup" "deftheme")) - (el-kw '("while-no-input" "letrec" "pcase" "pcase-let" - "pcase-let*" "save-restriction" "save-excursion" - "save-selected-window" + (el-kw '("while-no-input" "letrec" "pcase" "pcase-exhaustive" + "pcase-let" "pcase-let*" "save-restriction" + "save-excursion" "save-selected-window" ;; "eval-after-load" "eval-next-after-load" "save-window-excursion" "save-current-buffer" "save-match-data" "combine-after-change-calls" @@ -189,6 +214,7 @@ It has `lisp-mode-abbrev-table' as its parent." "with-category-table" "with-coding-priority" "with-current-buffer" "with-demoted-errors" "with-electric-help" "with-eval-after-load" + "with-file-modes" "with-local-quit" "with-no-warnings" "with-output-to-temp-buffer" "with-selected-window" "with-selected-frame" "with-silent-modifications" @@ -207,7 +233,7 @@ It has `lisp-mode-abbrev-table' as its parent." "etypecase" "ccase" "ctypecase" "loop" "do" "do*" "the" "locally" "proclaim" "declaim" "letf" "go" ;; "lexical-let" "lexical-let*" - "symbol-macrolet" "flet" "destructuring-bind" + "symbol-macrolet" "flet" "flet*" "destructuring-bind" "labels" "macrolet" "tagbody" "multiple-value-bind" "block" "return" "return-from")) (cl-lib-errs '("assert" "check-type")) @@ -347,6 +373,9 @@ It has `lisp-mode-abbrev-table' as its parent." ;; and that they get the wrong color. ;; ;; CL `with-' and `do-' constructs ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face) + (lisp--match-hidden-arg + (0 '(face font-lock-warning-face + help-echo "Hidden behind deeper element; move to another line?"))) )) "Gaudy level highlighting for Emacs Lisp mode.") @@ -377,6 +406,9 @@ It has `lisp-mode-abbrev-table' as its parent." ;; and that they get the wrong color. ;; ;; CL `with-' and `do-' constructs ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face) + (lisp--match-hidden-arg + (0 '(face font-lock-warning-face + help-echo "Hidden behind deeper element; move to another line?"))) )) "Gaudy level highlighting for Lisp modes.")) @@ -387,6 +419,41 @@ It has `lisp-mode-abbrev-table' as its parent." (defvar lisp-cl-font-lock-keywords lisp-cl-font-lock-keywords-1 "Default expressions to highlight in Lisp modes.") +(defun lisp-string-in-doc-position-p (listbeg startpos) + (let* ((firstsym (and listbeg + (save-excursion + (goto-char listbeg) + (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)") + (match-string 1))))) + (docelt (and firstsym + (function-get (intern-soft firstsym) + lisp-doc-string-elt-property)))) + (and docelt + ;; It's a string in a form that can have a docstring. + ;; Check whether it's in docstring position. + (save-excursion + (when (functionp docelt) + (goto-char (match-end 1)) + (setq docelt (funcall docelt))) + (goto-char listbeg) + (forward-char 1) + (condition-case nil + (while (and (> docelt 0) (< (point) startpos) + (progn (forward-sexp 1) t)) + (setq docelt (1- docelt))) + (error nil)) + (and (zerop docelt) (<= (point) startpos) + (progn (forward-comment (point-max)) t) + (= (point) startpos)))))) + +(defun lisp-string-after-doc-keyword-p (listbeg startpos) + (and listbeg ; We are inside a Lisp form. + (save-excursion + (goto-char startpos) + (ignore-errors + (progn (backward-sexp 1) + (looking-at ":documentation\\_>")))))) + (defun lisp-font-lock-syntactic-face-function (state) (if (nth 3 state) ;; This might be a (doc)string or a |...| symbol. @@ -394,32 +461,9 @@ It has `lisp-mode-abbrev-table' as its parent." (if (eq (char-after startpos) ?|) ;; This is not a string, but a |...| symbol. nil - (let* ((listbeg (nth 1 state)) - (firstsym (and listbeg - (save-excursion - (goto-char listbeg) - (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)") - (match-string 1))))) - (docelt (and firstsym - (function-get (intern-soft firstsym) - lisp-doc-string-elt-property)))) - (if (and docelt - ;; It's a string in a form that can have a docstring. - ;; Check whether it's in docstring position. - (save-excursion - (when (functionp docelt) - (goto-char (match-end 1)) - (setq docelt (funcall docelt))) - (goto-char listbeg) - (forward-char 1) - (condition-case nil - (while (and (> docelt 0) (< (point) startpos) - (progn (forward-sexp 1) t)) - (setq docelt (1- docelt))) - (error nil)) - (and (zerop docelt) (<= (point) startpos) - (progn (forward-comment (point-max)) t) - (= (point) (nth 8 state))))) + (let ((listbeg (nth 1 state))) + (if (or (lisp-string-in-doc-position-p listbeg startpos) + (lisp-string-after-doc-keyword-p listbeg startpos)) font-lock-doc-face font-lock-string-face)))) font-lock-comment-face)) @@ -465,10 +509,10 @@ font-lock keywords will not be case sensitive." lisp-cl-font-lock-keywords-2)) nil ,keywords-case-insensitive nil nil (font-lock-mark-block-function . mark-defun) + (font-lock-extra-managed-props help-echo) (font-lock-syntactic-face-function . lisp-font-lock-syntactic-face-function))) (setq-local prettify-symbols-alist lisp--prettify-symbols-alist) - ;; electric (when elisp (setq-local electric-pair-text-pairs (cons '(?\` . ?\') electric-pair-text-pairs))) @@ -520,166 +564,6 @@ font-lock keywords will not be case sensitive." map) "Keymap for commands shared by all sorts of Lisp modes.") -(defvar emacs-lisp-mode-map - (let ((map (make-sparse-keymap "Emacs-Lisp")) - (menu-map (make-sparse-keymap "Emacs-Lisp")) - (lint-map (make-sparse-keymap)) - (prof-map (make-sparse-keymap)) - (tracing-map (make-sparse-keymap))) - (set-keymap-parent map lisp-mode-shared-map) - (define-key map "\e\t" 'completion-at-point) - (define-key map "\e\C-x" 'eval-defun) - (define-key map "\e\C-q" 'indent-pp-sexp) - (bindings--define-key map [menu-bar emacs-lisp] - (cons "Emacs-Lisp" menu-map)) - (bindings--define-key menu-map [eldoc] - '(menu-item "Auto-Display Documentation Strings" eldoc-mode - :button (:toggle . (bound-and-true-p eldoc-mode)) - :help "Display the documentation string for the item under cursor")) - (bindings--define-key menu-map [checkdoc] - '(menu-item "Check Documentation Strings" checkdoc - :help "Check documentation strings for style requirements")) - (bindings--define-key menu-map [re-builder] - '(menu-item "Construct Regexp" re-builder - :help "Construct a regexp interactively")) - (bindings--define-key menu-map [tracing] (cons "Tracing" tracing-map)) - (bindings--define-key tracing-map [tr-a] - '(menu-item "Untrace All" untrace-all - :help "Untrace all currently traced functions")) - (bindings--define-key tracing-map [tr-uf] - '(menu-item "Untrace Function..." untrace-function - :help "Untrace function, and possibly activate all remaining advice")) - (bindings--define-key tracing-map [tr-sep] menu-bar-separator) - (bindings--define-key tracing-map [tr-q] - '(menu-item "Trace Function Quietly..." trace-function-background - :help "Trace the function with trace output going quietly to a buffer")) - (bindings--define-key tracing-map [tr-f] - '(menu-item "Trace Function..." trace-function - :help "Trace the function given as an argument")) - (bindings--define-key menu-map [profiling] (cons "Profiling" prof-map)) - (bindings--define-key prof-map [prof-restall] - '(menu-item "Remove Instrumentation for All Functions" elp-restore-all - :help "Restore the original definitions of all functions being profiled")) - (bindings--define-key prof-map [prof-restfunc] - '(menu-item "Remove Instrumentation for Function..." elp-restore-function - :help "Restore an instrumented function to its original definition")) - - (bindings--define-key prof-map [sep-rem] menu-bar-separator) - (bindings--define-key prof-map [prof-resall] - '(menu-item "Reset Counters for All Functions" elp-reset-all - :help "Reset the profiling information for all functions being profiled")) - (bindings--define-key prof-map [prof-resfunc] - '(menu-item "Reset Counters for Function..." elp-reset-function - :help "Reset the profiling information for a function")) - (bindings--define-key prof-map [prof-res] - '(menu-item "Show Profiling Results" elp-results - :help "Display current profiling results")) - (bindings--define-key prof-map [prof-pack] - '(menu-item "Instrument Package..." elp-instrument-package - :help "Instrument for profiling all function that start with a prefix")) - (bindings--define-key prof-map [prof-func] - '(menu-item "Instrument Function..." elp-instrument-function - :help "Instrument a function for profiling")) - ;; Maybe this should be in a separate submenu from the ELP stuff? - (bindings--define-key prof-map [sep-natprof] menu-bar-separator) - (bindings--define-key prof-map [prof-natprof-stop] - '(menu-item "Stop Native Profiler" profiler-stop - :help "Stop recording profiling information" - :enable (and (featurep 'profiler) - (profiler-running-p)))) - (bindings--define-key prof-map [prof-natprof-report] - '(menu-item "Show Profiler Report" profiler-report - :help "Show the current profiler report" - :enable (and (featurep 'profiler) - (profiler-running-p)))) - (bindings--define-key prof-map [prof-natprof-start] - '(menu-item "Start Native Profiler..." profiler-start - :help "Start recording profiling information")) - - (bindings--define-key menu-map [lint] (cons "Linting" lint-map)) - (bindings--define-key lint-map [lint-di] - '(menu-item "Lint Directory..." elint-directory - :help "Lint a directory")) - (bindings--define-key lint-map [lint-f] - '(menu-item "Lint File..." elint-file - :help "Lint a file")) - (bindings--define-key lint-map [lint-b] - '(menu-item "Lint Buffer" elint-current-buffer - :help "Lint the current buffer")) - (bindings--define-key lint-map [lint-d] - '(menu-item "Lint Defun" elint-defun - :help "Lint the function at point")) - (bindings--define-key menu-map [edebug-defun] - '(menu-item "Instrument Function for Debugging" edebug-defun - :help "Evaluate the top level form point is in, stepping through with Edebug" - :keys "C-u C-M-x")) - (bindings--define-key menu-map [separator-byte] menu-bar-separator) - (bindings--define-key menu-map [disas] - '(menu-item "Disassemble Byte Compiled Object..." disassemble - :help "Print disassembled code for OBJECT in a buffer")) - (bindings--define-key menu-map [byte-recompile] - '(menu-item "Byte-recompile Directory..." byte-recompile-directory - :help "Recompile every `.el' file in DIRECTORY that needs recompilation")) - (bindings--define-key menu-map [emacs-byte-compile-and-load] - '(menu-item "Byte-compile and Load" emacs-lisp-byte-compile-and-load - :help "Byte-compile the current file (if it has changed), then load compiled code")) - (bindings--define-key menu-map [byte-compile] - '(menu-item "Byte-compile This File" emacs-lisp-byte-compile - :help "Byte compile the file containing the current buffer")) - (bindings--define-key menu-map [separator-eval] menu-bar-separator) - (bindings--define-key menu-map [ielm] - '(menu-item "Interactive Expression Evaluation" ielm - :help "Interactively evaluate Emacs Lisp expressions")) - (bindings--define-key menu-map [eval-buffer] - '(menu-item "Evaluate Buffer" eval-buffer - :help "Execute the current buffer as Lisp code")) - (bindings--define-key menu-map [eval-region] - '(menu-item "Evaluate Region" eval-region - :help "Execute the region as Lisp code" - :enable mark-active)) - (bindings--define-key menu-map [eval-sexp] - '(menu-item "Evaluate Last S-expression" eval-last-sexp - :help "Evaluate sexp before point; print value in echo area")) - (bindings--define-key menu-map [separator-format] menu-bar-separator) - (bindings--define-key menu-map [comment-region] - '(menu-item "Comment Out Region" comment-region - :help "Comment or uncomment each line in the region" - :enable mark-active)) - (bindings--define-key menu-map [indent-region] - '(menu-item "Indent Region" indent-region - :help "Indent each nonblank line in the region" - :enable mark-active)) - (bindings--define-key menu-map [indent-line] - '(menu-item "Indent Line" lisp-indent-line)) - map) - "Keymap for Emacs Lisp mode. -All commands in `lisp-mode-shared-map' are inherited by this map.") - -(defun emacs-lisp-byte-compile () - "Byte compile the file containing the current buffer." - (interactive) - (if buffer-file-name - (byte-compile-file buffer-file-name) - (error "The buffer must be saved in a file first"))) - -(defun emacs-lisp-byte-compile-and-load () - "Byte-compile the current file (if it has changed), then load compiled code." - (interactive) - (or buffer-file-name - (error "The buffer must be saved in a file first")) - (require 'bytecomp) - ;; Recompile if file or buffer has changed since last compilation. - (if (and (buffer-modified-p) - (y-or-n-p (format "Save buffer %s first? " (buffer-name)))) - (save-buffer)) - (byte-recompile-file buffer-file-name nil 0 t)) - -(defcustom emacs-lisp-mode-hook nil - "Hook run when entering Emacs Lisp mode." - :options '(eldoc-mode imenu-add-menubar-index checkdoc-minor-mode) - :type 'hook - :group 'lisp) - (defcustom lisp-mode-hook nil "Hook run when entering Lisp mode." :options '(imenu-add-menubar-index) @@ -695,72 +579,6 @@ All commands in `lisp-mode-shared-map' are inherited by this map.") (defconst lisp--prettify-symbols-alist '(("lambda" . ?λ))) -(define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp" - "Major mode for editing Lisp code to run in Emacs. -Commands: -Delete converts tabs to spaces as it moves back. -Blank lines separate paragraphs. Semicolons start comments. - -\\{emacs-lisp-mode-map}" - :group 'lisp - (lisp-mode-variables nil nil 'elisp) - (setq imenu-case-fold-search nil) - (add-hook 'completion-at-point-functions - 'lisp-completion-at-point nil 'local)) - -;;; Emacs Lisp Byte-Code mode - -(eval-and-compile - (defconst emacs-list-byte-code-comment-re - (concat "\\(#\\)@\\([0-9]+\\) " - ;; Make sure it's a docstring and not a lazy-loaded byte-code. - "\\(?:[^(]\\|([^\"]\\)"))) - -(defun emacs-lisp-byte-code-comment (end &optional _point) - "Try to syntactically mark the #@NNN ....^_ docstrings in byte-code files." - (let ((ppss (syntax-ppss))) - (when (and (nth 4 ppss) - (eq (char-after (nth 8 ppss)) ?#)) - (let* ((n (save-excursion - (goto-char (nth 8 ppss)) - (when (looking-at emacs-list-byte-code-comment-re) - (string-to-number (match-string 2))))) - ;; `maxdiff' tries to make sure the loop below terminates. - (maxdiff n)) - (when n - (let* ((bchar (match-end 2)) - (b (position-bytes bchar))) - (goto-char (+ b n)) - (while (let ((diff (- (position-bytes (point)) b n))) - (unless (zerop diff) - (when (> diff maxdiff) (setq diff maxdiff)) - (forward-char (- diff)) - (setq maxdiff (if (> diff 0) diff - (max (1- maxdiff) 1))) - t)))) - (if (<= (point) end) - (put-text-property (1- (point)) (point) - 'syntax-table - (string-to-syntax "> b")) - (goto-char end))))))) - -(defun emacs-lisp-byte-code-syntax-propertize (start end) - (emacs-lisp-byte-code-comment end (point)) - (funcall - (syntax-propertize-rules - (emacs-list-byte-code-comment-re - (1 (prog1 "< b" (emacs-lisp-byte-code-comment end (point)))))) - start end)) - -(add-to-list 'auto-mode-alist '("\\.elc\\'" . emacs-lisp-byte-code-mode)) -(define-derived-mode emacs-lisp-byte-code-mode emacs-lisp-mode - "Elisp-Byte-Code" - "Major mode for *.elc files." - ;; TODO: Add way to disassemble byte-code under point. - (setq-local open-paren-in-column-0-is-defun-start nil) - (setq-local syntax-propertize-function - #'emacs-lisp-byte-code-syntax-propertize)) - ;;; Generic Lisp mode. (defvar lisp-mode-map @@ -814,421 +632,6 @@ or to switch back to an existing one." (interactive) (error "Process lisp does not exist")) -(defvar lisp-interaction-mode-map - (let ((map (make-sparse-keymap)) - (menu-map (make-sparse-keymap "Lisp-Interaction"))) - (set-keymap-parent map lisp-mode-shared-map) - (define-key map "\e\C-x" 'eval-defun) - (define-key map "\e\C-q" 'indent-pp-sexp) - (define-key map "\e\t" 'completion-at-point) - (define-key map "\n" 'eval-print-last-sexp) - (bindings--define-key map [menu-bar lisp-interaction] - (cons "Lisp-Interaction" menu-map)) - (bindings--define-key menu-map [eval-defun] - '(menu-item "Evaluate Defun" eval-defun - :help "Evaluate the top-level form containing point, or after point")) - (bindings--define-key menu-map [eval-print-last-sexp] - '(menu-item "Evaluate and Print" eval-print-last-sexp - :help "Evaluate sexp before point; print value into current buffer")) - (bindings--define-key menu-map [edebug-defun-lisp-interaction] - '(menu-item "Instrument Function for Debugging" edebug-defun - :help "Evaluate the top level form point is in, stepping through with Edebug" - :keys "C-u C-M-x")) - (bindings--define-key menu-map [indent-pp-sexp] - '(menu-item "Indent or Pretty-Print" indent-pp-sexp - :help "Indent each line of the list starting just after point, or prettyprint it")) - (bindings--define-key menu-map [complete-symbol] - '(menu-item "Complete Lisp Symbol" completion-at-point - :help "Perform completion on Lisp symbol preceding point")) - map) - "Keymap for Lisp Interaction mode. -All commands in `lisp-mode-shared-map' are inherited by this map.") - -(define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction" - "Major mode for typing and evaluating Lisp forms. -Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression -before point, and prints its value into the buffer, advancing point. -Note that printing is controlled by `eval-expression-print-length' -and `eval-expression-print-level'. - -Commands: -Delete converts tabs to spaces as it moves back. -Paragraphs are separated only by blank lines. -Semicolons start comments. - -\\{lisp-interaction-mode-map}" - :abbrev-table nil) - -(defun eval-print-last-sexp (&optional eval-last-sexp-arg-internal) - "Evaluate sexp before point; print value into current buffer. - -Normally, this function truncates long output according to the value -of the variables `eval-expression-print-length' and -`eval-expression-print-level'. With a prefix argument of zero, -however, there is no such truncation. Such a prefix argument -also causes integers to be printed in several additional formats -\(octal, hexadecimal, and character). - -If `eval-expression-debug-on-error' is non-nil, which is the default, -this command arranges for all errors to enter the debugger." - (interactive "P") - (let ((standard-output (current-buffer))) - (terpri) - (eval-last-sexp (or eval-last-sexp-arg-internal t)) - (terpri))) - - -(defun last-sexp-setup-props (beg end value alt1 alt2) - "Set up text properties for the output of `eval-last-sexp-1'. -BEG and END are the start and end of the output in current-buffer. -VALUE is the Lisp value printed, ALT1 and ALT2 are strings for the -alternative printed representations that can be displayed." - (let ((map (make-sparse-keymap))) - (define-key map "\C-m" 'last-sexp-toggle-display) - (define-key map [down-mouse-2] 'mouse-set-point) - (define-key map [mouse-2] 'last-sexp-toggle-display) - (add-text-properties - beg end - `(printed-value (,value ,alt1 ,alt2) - mouse-face highlight - keymap ,map - help-echo "RET, mouse-2: toggle abbreviated display" - rear-nonsticky (mouse-face keymap help-echo - printed-value))))) - - -(defun last-sexp-toggle-display (&optional _arg) - "Toggle between abbreviated and unabbreviated printed representations." - (interactive "P") - (save-restriction - (widen) - (let ((value (get-text-property (point) 'printed-value))) - (when value - (let ((beg (or (previous-single-property-change (min (point-max) (1+ (point))) - 'printed-value) - (point))) - (end (or (next-single-char-property-change (point) 'printed-value) (point))) - (standard-output (current-buffer)) - (point (point))) - (delete-region beg end) - (insert (nth 1 value)) - (or (= beg point) - (setq point (1- (point)))) - (last-sexp-setup-props beg (point) - (nth 0 value) - (nth 2 value) - (nth 1 value)) - (goto-char (min (point-max) point))))))) - -(defun prin1-char (char) - "Return a string representing CHAR as a character rather than as an integer. -If CHAR is not a character, return nil." - (and (integerp char) - (eventp char) - (let ((c (event-basic-type char)) - (mods (event-modifiers char)) - string) - ;; Prevent ?A from turning into ?\S-a. - (if (and (memq 'shift mods) - (zerop (logand char ?\S-\^@)) - (not (let ((case-fold-search nil)) - (char-equal c (upcase c))))) - (setq c (upcase c) mods nil)) - ;; What string are we considering using? - (condition-case nil - (setq string - (concat - "?" - (mapconcat - (lambda (modif) - (cond ((eq modif 'super) "\\s-") - (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-)))) - mods "") - (cond - ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c)) - ((eq c 127) "\\C-?") - (t - (string c))))) - (error nil)) - ;; Verify the string reads a CHAR, not to some other character. - ;; If it doesn't, return nil instead. - (and string - (= (car (read-from-string string)) char) - string)))) - - -(defun preceding-sexp () - "Return sexp before the point." - (let ((opoint (point)) - ignore-quotes - expr) - (save-excursion - (with-syntax-table emacs-lisp-mode-syntax-table - ;; If this sexp appears to be enclosed in `...' - ;; then ignore the surrounding quotes. - (setq ignore-quotes - (or (eq (following-char) ?\') - (eq (preceding-char) ?\'))) - (forward-sexp -1) - ;; If we were after `?\e' (or similar case), - ;; use the whole thing, not just the `e'. - (when (eq (preceding-char) ?\\) - (forward-char -1) - (when (eq (preceding-char) ??) - (forward-char -1))) - - ;; Skip over hash table read syntax. - (and (> (point) (1+ (point-min))) - (looking-back "#s" (- (point) 2)) - (forward-char -2)) - - ;; Skip over `#N='s. - (when (eq (preceding-char) ?=) - (let (labeled-p) - (save-excursion - (skip-chars-backward "0-9#=") - (setq labeled-p (looking-at "\\(#[0-9]+=\\)+"))) - (when labeled-p - (forward-sexp -1)))) - - (save-restriction - ;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in - ;; `variable' so that the value is returned, not the - ;; name - (if (and ignore-quotes - (eq (following-char) ?`)) - (forward-char)) - (narrow-to-region (point-min) opoint) - (setq expr (read (current-buffer))) - ;; If it's an (interactive ...) form, it's more - ;; useful to show how an interactive call would - ;; use it. - (and (consp expr) - (eq (car expr) 'interactive) - (setq expr - (list 'call-interactively - (list 'quote - (list 'lambda - '(&rest args) - expr - 'args))))) - expr))))) - - -(defun eval-last-sexp-1 (eval-last-sexp-arg-internal) - "Evaluate sexp before point; print value in the echo area. -With argument, print output into current buffer. -With a zero prefix arg, print output with no limit on the length -and level of lists, and include additional formats for integers -\(octal, hexadecimal, and character)." - (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t))) - ;; Setup the lexical environment if lexical-binding is enabled. - (eval-last-sexp-print-value - (eval (eval-sexp-add-defvars (preceding-sexp)) lexical-binding) - eval-last-sexp-arg-internal))) - - -(defun eval-last-sexp-print-value (value &optional eval-last-sexp-arg-internal) - (let ((unabbreviated (let ((print-length nil) (print-level nil)) - (prin1-to-string value))) - (print-length (and (not (zerop (prefix-numeric-value - eval-last-sexp-arg-internal))) - eval-expression-print-length)) - (print-level (and (not (zerop (prefix-numeric-value - eval-last-sexp-arg-internal))) - eval-expression-print-level)) - (beg (point)) - end) - (prog1 - (prin1 value) - (let ((str (eval-expression-print-format value))) - (if str (princ str))) - (setq end (point)) - (when (and (bufferp standard-output) - (or (not (null print-length)) - (not (null print-level))) - (not (string= unabbreviated - (buffer-substring-no-properties beg end)))) - (last-sexp-setup-props beg end value - unabbreviated - (buffer-substring-no-properties beg end)) - )))) - - -(defvar eval-last-sexp-fake-value (make-symbol "t")) - -(defun eval-sexp-add-defvars (exp &optional pos) - "Prepend EXP with all the `defvar's that precede it in the buffer. -POS specifies the starting position where EXP was found and defaults to point." - (setq exp (macroexpand-all exp)) ;Eager macro-expansion. - (if (not lexical-binding) - exp - (save-excursion - (unless pos (setq pos (point))) - (let ((vars ())) - (goto-char (point-min)) - (while (re-search-forward - "(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)" - pos t) - (let ((var (intern (match-string 1)))) - (and (not (special-variable-p var)) - (save-excursion - (zerop (car (syntax-ppss (match-beginning 0))))) - (push var vars)))) - `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp))))) - -(defun eval-last-sexp (eval-last-sexp-arg-internal) - "Evaluate sexp before point; print value in the echo area. -Interactively, with prefix argument, print output into current buffer. - -Normally, this function truncates long output according to the value -of the variables `eval-expression-print-length' and -`eval-expression-print-level'. With a prefix argument of zero, -however, there is no such truncation. Such a prefix argument -also causes integers to be printed in several additional formats -\(octal, hexadecimal, and character). - -If `eval-expression-debug-on-error' is non-nil, which is the default, -this command arranges for all errors to enter the debugger." - (interactive "P") - (if (null eval-expression-debug-on-error) - (eval-last-sexp-1 eval-last-sexp-arg-internal) - (let ((value - (let ((debug-on-error eval-last-sexp-fake-value)) - (cons (eval-last-sexp-1 eval-last-sexp-arg-internal) - debug-on-error)))) - (unless (eq (cdr value) eval-last-sexp-fake-value) - (setq debug-on-error (cdr value))) - (car value)))) - -(defun eval-defun-1 (form) - "Treat some expressions specially. -Reset the `defvar' and `defcustom' variables to the initial value. -\(For `defcustom', use the :set function if there is one.) -Reinitialize the face according to the `defface' specification." - ;; The code in edebug-defun should be consistent with this, but not - ;; the same, since this gets a macroexpanded form. - (cond ((not (listp form)) - form) - ((and (eq (car form) 'defvar) - (cdr-safe (cdr-safe form)) - (boundp (cadr form))) - ;; Force variable to be re-set. - `(progn (defvar ,(nth 1 form) nil ,@(nthcdr 3 form)) - (setq-default ,(nth 1 form) ,(nth 2 form)))) - ;; `defcustom' is now macroexpanded to - ;; `custom-declare-variable' with a quoted value arg. - ((and (eq (car form) 'custom-declare-variable) - (default-boundp (eval (nth 1 form) lexical-binding))) - ;; Force variable to be bound, using :set function if specified. - (let ((setfunc (memq :set form))) - (when setfunc - (setq setfunc (car-safe (cdr-safe setfunc))) - (or (functionp setfunc) (setq setfunc nil))) - (funcall (or setfunc 'set-default) - (eval (nth 1 form) lexical-binding) - ;; The second arg is an expression that evaluates to - ;; an expression. The second evaluation is the one - ;; normally performed not by normal execution but by - ;; custom-initialize-set (for example), which does not - ;; use lexical-binding. - (eval (eval (nth 2 form) lexical-binding)))) - form) - ;; `defface' is macroexpanded to `custom-declare-face'. - ((eq (car form) 'custom-declare-face) - ;; Reset the face. - (let ((face-symbol (eval (nth 1 form) lexical-binding))) - (setq face-new-frame-defaults - (assq-delete-all face-symbol face-new-frame-defaults)) - (put face-symbol 'face-defface-spec nil) - (put face-symbol 'face-override-spec nil)) - form) - ((eq (car form) 'progn) - (cons 'progn (mapcar 'eval-defun-1 (cdr form)))) - (t form))) - -(defun eval-defun-2 () - "Evaluate defun that point is in or before. -The value is displayed in the echo area. -If the current defun is actually a call to `defvar', -then reset the variable using the initial value expression -even if the variable already has some other value. -\(Normally `defvar' does not change the variable's value -if it already has a value.\) - -Return the result of evaluation." - ;; FIXME: the print-length/level bindings should only be applied while - ;; printing, not while evaluating. - (let ((debug-on-error eval-expression-debug-on-error) - (print-length eval-expression-print-length) - (print-level eval-expression-print-level)) - (save-excursion - ;; Arrange for eval-region to "read" the (possibly) altered form. - ;; eval-region handles recording which file defines a function or - ;; variable. - (let ((standard-output t) - beg end form) - ;; Read the form from the buffer, and record where it ends. - (save-excursion - (end-of-defun) - (beginning-of-defun) - (setq beg (point)) - (setq form (read (current-buffer))) - (setq end (point))) - ;; Alter the form if necessary. - (let ((form (eval-sexp-add-defvars - (eval-defun-1 (macroexpand form))))) - (eval-region beg end standard-output - (lambda (_ignore) - ;; Skipping to the end of the specified region - ;; will make eval-region return. - (goto-char end) - form)))))) - (let ((str (eval-expression-print-format (car values)))) - (if str (princ str))) - ;; The result of evaluation has been put onto VALUES. So return it. - (car values)) - -(defun eval-defun (edebug-it) - "Evaluate the top-level form containing point, or after point. - -If the current defun is actually a call to `defvar' or `defcustom', -evaluating it this way resets the variable using its initial value -expression (using the defcustom's :set function if there is one), even -if the variable already has some other value. \(Normally `defvar' and -`defcustom' do not alter the value if there already is one.) In an -analogous way, evaluating a `defface' overrides any customizations of -the face, so that it becomes defined exactly as the `defface' expression -says. - -If `eval-expression-debug-on-error' is non-nil, which is the default, -this command arranges for all errors to enter the debugger. - -With a prefix argument, instrument the code for Edebug. - -If acting on a `defun' for FUNCTION, and the function was -instrumented, `Edebug: FUNCTION' is printed in the echo area. If not -instrumented, just FUNCTION is printed. - -If not acting on a `defun', the result of evaluation is displayed in -the echo area. This display is controlled by the variables -`eval-expression-print-length' and `eval-expression-print-level', -which see." - (interactive "P") - (cond (edebug-it - (require 'edebug) - (eval-defun (not edebug-all-defs))) - (t - (if (null eval-expression-debug-on-error) - (eval-defun-2) - (let ((old-value (make-symbol "t")) new-value value) - (let ((debug-on-error old-value)) - (setq value (eval-defun-2)) - (setq new-value debug-on-error)) - (unless (eq old-value new-value) - (setq debug-on-error new-value)) - value))))) - ;; May still be used by some external Lisp-mode variant. (define-obsolete-function-alias 'lisp-comment-indent 'comment-indent-default "22.1") @@ -1551,19 +954,21 @@ Lisp function does not specify a special indentation." ;; like defun if the first form is placed on the next line, otherwise ;; it is indented like any other form (i.e. forms line up under first). -(put 'autoload 'lisp-indent-function 'defun) +(put 'autoload 'lisp-indent-function 'defun) ;Elisp (put 'progn 'lisp-indent-function 0) (put 'prog1 'lisp-indent-function 1) (put 'prog2 'lisp-indent-function 2) -(put 'save-excursion 'lisp-indent-function 0) -(put 'save-restriction 'lisp-indent-function 0) -(put 'save-current-buffer 'lisp-indent-function 0) +(put 'save-excursion 'lisp-indent-function 0) ;Elisp +(put 'save-restriction 'lisp-indent-function 0) ;Elisp +(put 'save-current-buffer 'lisp-indent-function 0) ;Elisp (put 'let 'lisp-indent-function 1) (put 'let* 'lisp-indent-function 1) (put 'while 'lisp-indent-function 1) (put 'if 'lisp-indent-function 2) (put 'catch 'lisp-indent-function 1) (put 'condition-case 'lisp-indent-function 2) +(put 'handler-case 'lisp-indent-function 1) ;CL +(put 'handler-bind 'lisp-indent-function 1) ;CL (put 'unwind-protect 'lisp-indent-function 1) (put 'with-output-to-temp-buffer 'lisp-indent-function 1) diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index f8ca6f6a172..214bed7622d 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -57,10 +57,14 @@ Should take the same arguments and behave similarly to `forward-sexp'.") (defun forward-sexp (&optional arg) "Move forward across one balanced expression (sexp). -With ARG, do it that many times. Negative arg -N means -move backward across N balanced expressions. -This command assumes point is not in a string or comment. -Calls `forward-sexp-function' to do the work, if that is non-nil." +With ARG, do it that many times. Negative arg -N means move +backward across N balanced expressions. This command assumes +point is not in a string or comment. Calls +`forward-sexp-function' to do the work, if that is non-nil. If +unable to move over a sexp, signal `scan-error' with three +arguments: a message, the start of the obstacle (usually a +parenthesis or list marker of some kind), and end of the +obstacle." (interactive "^p") (or arg (setq arg 1)) (if forward-sexp-function @@ -140,38 +144,92 @@ This command assumes point is not in a string or comment." (goto-char (or (scan-lists (point) inc -1) (buffer-end arg))) (setq arg (- arg inc))))) -(defun backward-up-list (&optional arg) +(defun backward-up-list (&optional arg escape-strings no-syntax-crossing) "Move backward out of one level of parentheses. This command will also work on other parentheses-like expressions -defined by the current language mode. -With ARG, do this that many times. -A negative argument means move forward but still to a less deep spot. -This command assumes point is not in a string or comment." - (interactive "^p") - (up-list (- (or arg 1)))) - -(defun up-list (&optional arg) +defined by the current language mode. With ARG, do this that +many times. A negative argument means move forward but still to +a less deep spot. If ESCAPE-STRINGS is non-nil (as it is +interactively), move out of enclosing strings as well. If +NO-SYNTAX-CROSSING is non-nil (as it is interactively), prefer to +break out of any enclosing string instead of moving to the start +of a list broken across multiple strings. On error, location of +point is unspecified." + (interactive "^p\nd\nd") + (up-list (- (or arg 1)) escape-strings no-syntax-crossing)) + +(defun up-list (&optional arg escape-strings no-syntax-crossing) "Move forward out of one level of parentheses. This command will also work on other parentheses-like expressions -defined by the current language mode. -With ARG, do this that many times. -A negative argument means move backward but still to a less deep spot. -This command assumes point is not in a string or comment." - (interactive "^p") +defined by the current language mode. With ARG, do this that +many times. A negative argument means move backward but still to +a less deep spot. If ESCAPE-STRINGS is non-nil (as it is +interactively), move out of enclosing strings as well. If +NO-SYNTAX-CROSSING is non-nil (as it is interactively), prefer to +break out of any enclosing string instead of moving to the start +of a list broken across multiple strings. On error, location of +point is unspecified." + (interactive "^p\nd\nd") (or arg (setq arg 1)) (let ((inc (if (> arg 0) 1 -1)) - pos) + (pos nil)) (while (/= arg 0) - (if (null forward-sexp-function) - (goto-char (or (scan-lists (point) inc 1) (buffer-end arg))) - (condition-case err - (while (progn (setq pos (point)) - (forward-sexp inc) - (/= (point) pos))) - (scan-error (goto-char (nth (if (> arg 0) 3 2) err)))) - (if (= (point) pos) - (signal 'scan-error - (list "Unbalanced parentheses" (point) (point))))) + (condition-case err + (save-restriction + ;; If we've been asked not to cross string boundaries + ;; and we're inside a string, narrow to that string so + ;; that scan-lists doesn't find a match in a different + ;; string. + (when no-syntax-crossing + (let* ((syntax (syntax-ppss)) + (string-comment-start (nth 8 syntax))) + (when string-comment-start + (save-excursion + (goto-char string-comment-start) + (narrow-to-region + (point) + (if (nth 3 syntax) ; in string + (condition-case nil + (progn (forward-sexp) (point)) + (scan-error (point-max))) + (forward-comment 1) + (point))))))) + (if (null forward-sexp-function) + (goto-char (or (scan-lists (point) inc 1) + (buffer-end arg))) + (condition-case err + (while (progn (setq pos (point)) + (forward-sexp inc) + (/= (point) pos))) + (scan-error (goto-char (nth (if (> arg 0) 3 2) err)))) + (if (= (point) pos) + (signal 'scan-error + (list "Unbalanced parentheses" (point) (point)))))) + (scan-error + (let ((syntax nil)) + (or + ;; If we bumped up against the end of a list, see whether + ;; we're inside a string: if so, just go to the beginning + ;; or end of that string. + (and escape-strings + (or syntax (setf syntax (syntax-ppss))) + (nth 3 syntax) + (goto-char (nth 8 syntax)) + (progn (when (> inc 0) + (forward-sexp)) + t)) + ;; If we narrowed to a comment above and failed to escape + ;; it, the error might be our fault, not an indication + ;; that we're out of syntax. Try again from beginning or + ;; end of the comment. + (and no-syntax-crossing + (or syntax (setf syntax (syntax-ppss))) + (nth 4 syntax) + (goto-char (nth 8 syntax)) + (or (< inc 0) + (forward-comment 1)) + (setf arg (+ arg inc))) + (signal (car err) (cdr err)))))) (setq arg (- arg inc))))) (defun kill-sexp (&optional arg) @@ -464,11 +522,15 @@ it marks the next defun after the ones already marked." (beginning-of-defun)) (re-search-backward "^\n" (- (point) 1) t))))) -(defun narrow-to-defun (&optional _arg) +(defvar narrow-to-defun-include-comments nil + "If non-nil, `narrow-to-defun' will also show comments preceding the defun.") + +(defun narrow-to-defun (&optional include-comments) "Make text outside current defun invisible. -The defun visible is the one that contains point or follows point. -Optional ARG is ignored." - (interactive) +The current defun is the one that contains point or follows point. +Preceding comments are included if INCLUDE-COMMENTS is non-nil. +Interactively, the behavior depends on `narrow-to-defun-include-comments'." + (interactive (list narrow-to-defun-include-comments)) (save-excursion (widen) (let ((opoint (point)) @@ -504,6 +566,18 @@ Optional ARG is ignored." (setq end (point)) (beginning-of-defun) (setq beg (point))) + (when include-comments + (goto-char beg) + ;; Move back past all preceding comments (and whitespace). + (when (forward-comment -1) + (while (forward-comment -1)) + ;; Move forwards past any page breaks within these comments. + (when (and page-delimiter (not (string= page-delimiter ""))) + (while (re-search-forward page-delimiter beg t))) + ;; Lastly, move past any empty lines. + (skip-chars-forward "[:space:]\n") + (beginning-of-line) + (setq beg (point)))) (goto-char end) (re-search-backward "^\n" (- (point) 1) t) (narrow-to-region beg end)))) @@ -684,248 +758,4 @@ considered." (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data) (plist-get plist :predicate)))))) -(defun lisp--local-variables-1 (vars sexp) - "Return the vars locally bound around the witness, or nil if not found." - (let (res) - (while - (unless - (setq res - (pcase sexp - (`(,(or `let `let*) ,bindings) - (let ((vars vars)) - (when (eq 'let* (car sexp)) - (dolist (binding (cdr (reverse bindings))) - (push (or (car-safe binding) binding) vars))) - (lisp--local-variables-1 - vars (car (cdr-safe (car (last bindings))))))) - (`(,(or `let `let*) ,bindings . ,body) - (let ((vars vars)) - (dolist (binding bindings) - (push (or (car-safe binding) binding) vars)) - (lisp--local-variables-1 vars (car (last body))))) - (`(lambda ,_) (setq sexp nil)) - (`(lambda ,args . ,body) - (lisp--local-variables-1 - (append args vars) (car (last body)))) - (`(condition-case ,_ ,e) (lisp--local-variables-1 vars e)) - (`(condition-case ,v ,_ . ,catches) - (lisp--local-variables-1 - (cons v vars) (cdr (car (last catches))))) - (`(quote . ,_) (setq sexp nil)) - (`(,_ . ,_) - (lisp--local-variables-1 vars (car (last sexp)))) - (`lisp--witness--lisp (or vars '(nil))) - (_ nil))) - (setq sexp (ignore-errors (butlast sexp))))) - res)) - -(defun lisp--local-variables () - "Return a list of locally let-bound variables at point." - (save-excursion - (skip-syntax-backward "w_") - (let* ((ppss (syntax-ppss)) - (txt (buffer-substring-no-properties (or (car (nth 9 ppss)) (point)) - (or (nth 8 ppss) (point)))) - (closer ())) - (dolist (p (nth 9 ppss)) - (push (cdr (syntax-after p)) closer)) - (setq closer (apply #'string closer)) - (let* ((sexp (condition-case nil - (car (read-from-string - (concat txt "lisp--witness--lisp" closer))) - (end-of-file nil))) - (macroexpand-advice (lambda (expander form &rest args) - (condition-case nil - (apply expander form args) - (error form)))) - (sexp - (unwind-protect - (progn - (advice-add 'macroexpand :around macroexpand-advice) - (macroexpand-all sexp)) - (advice-remove 'macroexpand macroexpand-advice))) - (vars (lisp--local-variables-1 nil sexp))) - (delq nil - (mapcar (lambda (var) - (and (symbolp var) - (not (string-match (symbol-name var) "\\`[&_]")) - ;; Eliminate uninterned vars. - (intern-soft var) - var)) - vars)))))) - -(defvar lisp--local-variables-completion-table - ;; Use `defvar' rather than `defconst' since defconst would purecopy this - ;; value, which would doubly fail: it would fail because purecopy can't - ;; handle the recursive bytecode object, and it would fail because it would - ;; move `lastpos' and `lastvars' to pure space where they'd be immutable! - (let ((lastpos nil) (lastvars nil)) - (letrec ((hookfun (lambda () - (setq lastpos nil) - (remove-hook 'post-command-hook hookfun)))) - (completion-table-dynamic - (lambda (_string) - (save-excursion - (skip-syntax-backward "_w") - (let ((newpos (cons (point) (current-buffer)))) - (unless (equal lastpos newpos) - (add-hook 'post-command-hook hookfun) - (setq lastpos newpos) - (setq lastvars - (mapcar #'symbol-name (lisp--local-variables)))))) - lastvars))))) - -;; FIXME: Support for Company brings in features which straddle eldoc. -;; We should consolidate this, so that major modes can provide all that -;; data all at once: -;; - a function to extract "the reference at point" (may be more complex -;; than a mere string, to distinguish various namespaces). -;; - a function to jump to such a reference. -;; - a function to show the signature/interface of such a reference. -;; - a function to build a help-buffer about that reference. -;; FIXME: Those functions should also be used by the normal completion code in -;; the *Completions* buffer. - -(defun lisp--company-doc-buffer (str) - (let ((symbol (intern-soft str))) - ;; FIXME: we really don't want to "display-buffer and then undo it". - (save-window-excursion - ;; Make sure we don't display it in another frame, otherwise - ;; save-window-excursion won't be able to undo it. - (let ((display-buffer-overriding-action - '(nil . ((inhibit-switch-frame . t))))) - (ignore-errors - (cond - ((fboundp symbol) (describe-function symbol)) - ((boundp symbol) (describe-variable symbol)) - ((featurep symbol) (describe-package symbol)) - ((facep symbol) (describe-face symbol)) - (t (signal 'user-error nil))) - (help-buffer)))))) - -(defun lisp--company-doc-string (str) - (let* ((symbol (intern-soft str)) - (doc (if (fboundp symbol) - (documentation symbol t) - (documentation-property symbol 'variable-documentation t)))) - (and (stringp doc) - (string-match ".*$" doc) - (match-string 0 doc)))) - -(declare-function find-library-name "find-func" (library)) - -(defun lisp--company-location (str) - (let ((sym (intern-soft str))) - (cond - ((fboundp sym) (find-definition-noselect sym nil)) - ((boundp sym) (find-definition-noselect sym 'defvar)) - ((featurep sym) - (require 'find-func) - (cons (find-file-noselect (find-library-name - (symbol-name sym))) - 0)) - ((facep sym) (find-definition-noselect sym 'defface))))) - -(defun lisp-completion-at-point (&optional _predicate) - "Function used for `completion-at-point-functions' in `emacs-lisp-mode'." - (with-syntax-table emacs-lisp-mode-syntax-table - (let* ((pos (point)) - (beg (condition-case nil - (save-excursion - (backward-sexp 1) - (skip-syntax-forward "'") - (point)) - (scan-error pos))) - (end - (unless (or (eq beg (point-max)) - (member (char-syntax (char-after beg)) - '(?\s ?\" ?\( ?\)))) - (condition-case nil - (save-excursion - (goto-char beg) - (forward-sexp 1) - (when (>= (point) pos) - (point))) - (scan-error pos)))) - (funpos (eq (char-before beg) ?\()) ;t if in function position. - (table-etc - (if (not funpos) - ;; FIXME: We could look at the first element of the list and - ;; use it to provide a more specific completion table in some - ;; cases. E.g. filter out keywords that are not understood by - ;; the macro/function being called. - (list nil (completion-table-merge - lisp--local-variables-completion-table - (apply-partially #'completion-table-with-predicate - obarray - ;; Don't include all symbols - ;; (bug#16646). - (lambda (sym) - (or (boundp sym) - (fboundp sym) - (symbol-plist sym))) - 'strict)) - :annotation-function - (lambda (str) (if (fboundp (intern-soft str)) " <f>")) - :company-doc-buffer #'lisp--company-doc-buffer - :company-docsig #'lisp--company-doc-string - :company-location #'lisp--company-location) - ;; Looks like a funcall position. Let's double check. - (save-excursion - (goto-char (1- beg)) - (let ((parent - (condition-case nil - (progn (up-list -1) (forward-char 1) - (let ((c (char-after))) - (if (eq c ?\() ?\( - (if (memq (char-syntax c) '(?w ?_)) - (read (current-buffer)))))) - (error nil)))) - (pcase parent - ;; FIXME: Rather than hardcode special cases here, - ;; we should use something like a symbol-property. - (`declare - (list t (mapcar (lambda (x) (symbol-name (car x))) - (delete-dups - ;; FIXME: We should include some - ;; docstring with each entry. - (append - macro-declarations-alist - defun-declarations-alist))))) - ((and (or `condition-case `condition-case-unless-debug) - (guard (save-excursion - (ignore-errors - (forward-sexp 2) - (< (point) beg))))) - (list t obarray - :predicate (lambda (sym) (get sym 'error-conditions)))) - ((and ?\( - (guard (save-excursion - (goto-char (1- beg)) - (up-list -1) - (forward-symbol -1) - (looking-at "\\_<let\\*?\\_>")))) - (list t obarray - :predicate #'boundp - :company-doc-buffer #'lisp--company-doc-buffer - :company-docsig #'lisp--company-doc-string - :company-location #'lisp--company-location)) - (_ (list nil obarray - :predicate #'fboundp - :company-doc-buffer #'lisp--company-doc-buffer - :company-docsig #'lisp--company-doc-string - :company-location #'lisp--company-location - )))))))) - (when end - (let ((tail (if (null (car table-etc)) - (cdr table-etc) - (cons - (if (memq (char-syntax (or (char-after end) ?\s)) - '(?\s ?>)) - (cadr table-etc) - (apply-partially 'completion-table-with-terminator - " " (cadr table-etc))) - (cddr table-etc))))) - `(,beg ,end ,@tail)))))) - ;;; lisp.el ends here diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index bd619bc83b7..797de9abb5b 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -25,7 +25,6 @@ ;; This file contains macro-expansions functions that are not defined in ;; the Lisp core, namely `macroexpand-all', which expands all macros in ;; a form, not just a top-level one. -;; ;;; Code: @@ -97,7 +96,8 @@ each clause." (defun macroexp--compiler-macro (handler form) (condition-case err (apply handler form (cdr form)) - (error (message "Compiler-macro error for %S: %S" (car form) err) + (error + (message "Compiler-macro error for %S: %S" (car form) err) form))) (defun macroexp--funcall-if-compiled (_form) @@ -144,11 +144,55 @@ and also to avoid outputting the warning during normal execution." (instead (format "; use `%s' instead." instead)) (t "."))))) +(defun macroexpand-1 (form &optional environment) + "Perform (at most) one step of macroexpansion." + (cond + ((consp form) + (let* ((head (car form)) + (env-expander (assq head environment))) + (if env-expander + (if (cdr env-expander) + (apply (cdr env-expander) (cdr form)) + form) + (if (not (and (symbolp head) (fboundp head))) + form + (let ((def (autoload-do-load (symbol-function head) head 'macro))) + (cond + ;; Follow alias, but only for macros, otherwise we may end up + ;; skipping an important compiler-macro (e.g. cl--block-wrapper). + ((and (symbolp def) (macrop def)) (cons def (cdr form))) + ((not (consp def)) form) + (t + (if (eq 'macro (car def)) + (apply (cdr def) (cdr form)) + form)))))))) + (t form))) + +(defun macroexp-macroexpand (form env) + "Like `macroexpand' but checking obsolescence." + (let ((new-form + (macroexpand form env))) + (if (and (not (eq form new-form)) ;It was a macro call. + (car-safe form) + (symbolp (car form)) + (get (car form) 'byte-obsolete-info) + (or (not (fboundp 'byte-compile-warning-enabled-p)) + (byte-compile-warning-enabled-p 'obsolete))) + (let* ((fun (car form)) + (obsolete (get fun 'byte-obsolete-info))) + (macroexp--warn-and-return + (macroexp--obsolete-warning + fun obsolete + (if (symbolp (symbol-function fun)) + "alias" "macro")) + new-form)) + new-form))) + (defun macroexp--expand-all (form) "Expand all macros in FORM. This is an internal version of `macroexpand-all'. Assumes the caller has bound `macroexpand-all-environment'." - (if (and (listp form) (eq (car form) 'backquote-list*)) + (if (eq (car-safe form) 'backquote-list*) ;; Special-case `backquote-list*', as it is normally a macro that ;; generates exceedingly deep expansions from relatively shallow input ;; forms. We just process it `in reverse' -- first we expand all the @@ -156,24 +200,7 @@ Assumes the caller has bound `macroexpand-all-environment'." (macroexpand (macroexp--all-forms form 1) macroexpand-all-environment) ;; Normal form; get its expansion, and then expand arguments. - (let ((new-form - (macroexpand form macroexpand-all-environment))) - (setq form - (if (and (not (eq form new-form)) ;It was a macro call. - (car-safe form) - (symbolp (car form)) - (get (car form) 'byte-obsolete-info) - (or (not (fboundp 'byte-compile-warning-enabled-p)) - (byte-compile-warning-enabled-p 'obsolete))) - (let* ((fun (car form)) - (obsolete (get fun 'byte-obsolete-info))) - (macroexp--warn-and-return - (macroexp--obsolete-warning - fun obsolete - (if (symbolp (symbol-function fun)) - "alias" "macro")) - new-form)) - new-form))) + (setq form (macroexp-macroexpand form macroexpand-all-environment)) (pcase form (`(cond . ,clauses) (macroexp--cons 'cond (macroexp--all-clauses clauses) form)) @@ -225,6 +252,10 @@ Assumes the caller has bound `macroexpand-all-environment'." (format "%s quoted with ' rather than with #'" (list 'lambda (nth 1 f) '...)) (macroexp--expand-all `(,fun ,arg1 ,f . ,args)))) + (`(funcall (,(or 'quote 'function) ,(and f (pred symbolp)) . ,_) . ,args) + ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo' + ;; has a compiler-macro. + (macroexp--expand-all `(,f . ,args))) (`(,func . ,_) ;; Macro expand compiler macros. This cannot be delayed to ;; byte-optimize-form because the output of the compiler-macro can @@ -238,7 +269,7 @@ Assumes the caller has bound `macroexpand-all-environment'." ;; If the handler is not loaded yet, try (auto)loading the ;; function itself, which may in turn load the handler. (unless (functionp handler) - (ignore-errors + (with-demoted-errors "macroexp--expand-all: %S" (autoload-do-load (indirect-function func) func))) (let ((newform (macroexp--compiler-macro handler form))) (if (eq form newform) @@ -316,6 +347,15 @@ be skipped; if nil, as is usual, `macroexp-const-p' is used." (macroexp-let* (list (list ,var ,expsym)) ,bodysym))))) +(defmacro macroexp-let2* (test bindings &rest body) + "Bind each binding in BINDINGS as `macroexp-let2' does." + (declare (indent 2) (debug (sexp (&rest (sexp form)) body))) + (pcase-exhaustive bindings + (`nil (macroexp-progn body)) + (`((,var ,exp) . ,tl) + `(macroexp-let2 ,test ,var ,exp + (macroexp-let2* ,test ,tl ,@body))))) + (defun macroexp--maxsize (exp size) (cond ((< size 0) size) ((symbolp exp) (1- size)) @@ -367,6 +407,18 @@ symbol itself." "Return non-nil if EXP can be copied without extra cost." (or (symbolp exp) (macroexp-const-p exp))) +(defun macroexp-quote (v) + "Return an expression E such that `(eval E)' is V. + +E is either V or (quote V) depending on whether V evaluates to +itself or not." + (if (and (not (consp v)) + (or (keywordp v) + (not (symbolp v)) + (memq v '(nil t)))) + v + (list 'quote v))) + ;;; Load-time macro-expansion. ;; Because macro-expansion used to be more lazy, eager macro-expansion @@ -402,7 +454,7 @@ symbol itself." (defvar macroexp--pending-eager-loads nil "Stack of files currently undergoing eager macro-expansion.") -(defun internal-macroexpand-for-load (form) +(defun internal-macroexpand-for-load (form full-p) ;; Called from the eager-macroexpansion in readevalloop. (cond ;; Don't repeat the same warning for every top-level element. @@ -425,7 +477,9 @@ symbol itself." (condition-case err (let ((macroexp--pending-eager-loads (cons load-file-name macroexp--pending-eager-loads))) - (macroexpand-all form)) + (if full-p + (macroexpand-all form) + (macroexpand form))) (error ;; Hopefully this shouldn't happen thanks to the cycle detection, ;; but in case it does happen, let's catch the error and give the diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 8a3c0cc9800..faebe269044 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -236,11 +236,12 @@ different, but `function-equal' will hopefully ignore those differences.") ;; This function acts like the t special value in buffer-local hooks. (lambda (&rest args) (apply (default-value var) args))))) -(defun advice--normalize-place (place) - (cond ((eq 'local (car-safe place)) `(advice--buffer-local ,@(cdr place))) - ((eq 'var (car-safe place)) (nth 1 place)) - ((symbolp place) `(default-value ',place)) - (t place))) +(eval-and-compile + (defun advice--normalize-place (place) + (cond ((eq 'local (car-safe place)) `(advice--buffer-local ,@(cdr place))) + ((eq 'var (car-safe place)) (nth 1 place)) + ((symbolp place) `(default-value ',place)) + (t place)))) ;;;###autoload (defmacro add-function (where place function &optional props) @@ -440,6 +441,30 @@ of the piece of advice." (fset symbol (car (get symbol 'advice--saved-rewrite))))))) nil) +;;;###autoload +(defmacro define-advice (symbol args &rest body) + "Define an advice and add it to function named SYMBOL. +See `advice-add' and `add-function' for explanation on the +arguments. Note if NAME is nil the advice is anonymous; +otherwise it is named `SYMBOL@NAME'. + +\(fn SYMBOL (WHERE LAMBDA-LIST &optional NAME DEPTH) &rest BODY)" + (declare (indent 2) (doc-string 3) (debug (sexp sexp body))) + (or (listp args) (signal 'wrong-type-argument (list 'listp args))) + (or (<= 2 (length args) 4) + (signal 'wrong-number-of-arguments (list 2 4 (length args)))) + (let* ((where (nth 0 args)) + (lambda-list (nth 1 args)) + (name (nth 2 args)) + (depth (nth 3 args)) + (props (and depth `((depth . ,depth)))) + (advice (cond ((null name) `(lambda ,lambda-list ,@body)) + ((or (stringp name) (symbolp name)) + (intern (format "%s@%s" symbol name))) + (t (error "Unrecognized name spec `%S'" name))))) + `(prog1 ,@(and (symbolp advice) `((defun ,advice ,lambda-list ,@body))) + (advice-add ',symbol ,where #',advice ,@(and props `(',props)))))) + (defun advice-mapc (fun symbol) "Apply FUN to every advice function in SYMBOL. FUN is called with a two arguments: the function that was added, and the diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el index f2bcdad1720..e0945d47a45 100644 --- a/lisp/emacs-lisp/package-x.el +++ b/lisp/emacs-lisp/package-x.el @@ -207,6 +207,10 @@ if it exists." (pkg-version (package-version-join split-version)) (pkg-buffer (current-buffer))) + ;; `package-upload-file' will error if given a directory, + ;; but we check it here as well just in case. + (when (eq 'dir file-type) + (user-error "Can't upload directory, tar it instead")) ;; Get archive-contents from ARCHIVE-URL if it's non-nil, or ;; from `package-archive-upload-base' otherwise. (let ((contents (or (package--archive-contents-from-url archive-url) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 5203e74dc64..88fc950ee21 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -162,8 +162,10 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'epg)) ;For setf accessors. (require 'tabulated-list) +(require 'macroexp) (defgroup package nil "Manager for Emacs Lisp packages." @@ -226,6 +228,23 @@ a package can run arbitrary code." :group 'package :version "24.1") +(defcustom package-archive-priorities nil + "An alist of priorities for packages. + +Each element has the form (ARCHIVE-ID . PRIORITY). + +When installing packages, the package with the highest version +number from the archive with the highest priority is +selected. When higher versions are available from archives with +lower priorities, the user has to select those manually. + +Archives not in this list have the priority 0." + :type '(alist :key-type (string :tag "Archive name") + :value-type (integer :tag "Priority (default is 0)")) + :risky t + :group 'package + :version "25.1") + (defcustom package-pinned-packages nil "An alist of packages that are pinned to specific archives. This can be useful if you have multiple package archives enabled, @@ -289,6 +308,8 @@ contrast, `package-user-dir' contains packages for personal use." :group 'package :version "24.1") +(defvar epg-gpg-program) + (defcustom package-check-signature (if (progn (require 'epg-config) (executable-find epg-gpg-program)) 'allow-unsigned) @@ -393,6 +414,7 @@ Slots: (pcase (package-desc-kind pkg-desc) (`single ".el") (`tar ".tar") + (`dir "") (kind (error "Unknown package kind: %s" kind)))) (defun package-desc--keywords (pkg-desc) @@ -512,7 +534,11 @@ Return the max version (as a string) if the package is held at a lower version." force)) (t (error "Invalid element in `package-load-list'"))))) -(defun package-activate-1 (pkg-desc) +(defun package-activate-1 (pkg-desc &optional reload) + "Activate package given by PKG-DESC, even if it was already active. +If RELOAD is non-nil, also `load' any files inside the package which +correspond to previously loaded files (those returned by +`package--list-loaded-files')." (let* ((name (package-desc-name pkg-desc)) (pkg-dir (package-desc-dir pkg-desc)) (pkg-dir-dir (file-name-as-directory pkg-dir))) @@ -520,15 +546,27 @@ Return the max version (as a string) if the package is held at a lower version." (error "Internal error: unable to find directory for `%s'" (package-desc-full-name pkg-desc))) ;; Add to load path, add autoloads, and activate the package. - (let ((old-lp load-path)) - (with-demoted-errors - (load (expand-file-name (format "%s-autoloads" name) pkg-dir) nil t)) + (let* ((old-lp load-path) + (autoloads-file (expand-file-name + (format "%s-autoloads" name) pkg-dir)) + (loaded-files-list (and reload (package--list-loaded-files pkg-dir)))) + (with-demoted-errors "Error in package-activate-1: %s" + (load autoloads-file nil t)) (when (and (eq old-lp load-path) (not (or (member pkg-dir load-path) (member pkg-dir-dir load-path)))) ;; Old packages don't add themselves to the `load-path', so we have to ;; do it ourselves. - (push pkg-dir load-path))) + (push pkg-dir load-path)) + ;; Call `load' on all files in `pkg-dir' already present in + ;; `load-history'. This is done so that macros in these files are updated + ;; to their new definitions. If another package is being installed which + ;; depends on this new definition, not doing this update would cause + ;; compilation errors and break the installation. + (with-demoted-errors "Error in package-activate-1: %s" + (mapc (lambda (feature) (load feature nil t)) + ;; Skip autoloads file since we already evaluated it above. + (remove (file-truename autoloads-file) loaded-files-list)))) ;; Add info node. (when (file-exists-p (expand-file-name "dir" pkg-dir)) ;; FIXME: not the friendliest, but simple. @@ -539,6 +577,41 @@ Return the max version (as a string) if the package is held at a lower version." ;; Don't return nil. t)) +(declare-function find-library-name "find-func" (library)) +(defun package--list-loaded-files (dir) + "Recursively list all files in DIR which correspond to loaded features. +Returns the `file-name-sans-extension' of each file, relative to +DIR, sorted by most recently loaded last." + (let* ((history (delq nil + (mapcar (lambda (x) + (let ((f (car x))) + (and f (file-name-sans-extension f)))) + load-history))) + (dir (file-truename dir)) + ;; List all files that have already been loaded. + (list-of-conflicts + (delq + nil + (mapcar + (lambda (x) (let* ((file (file-relative-name x dir)) + ;; Previously loaded file, if any. + (previous + (ignore-errors + (file-name-sans-extension + (file-truename (find-library-name file))))) + (pos (when previous (member previous history)))) + ;; Return (RELATIVE-FILENAME . HISTORY-POSITION) + (when pos + (cons (file-name-sans-extension file) (length pos))))) + (directory-files-recursively dir "\\`[^\\.].*\\.el\\'"))))) + ;; Turn the list of (FILENAME . POS) back into a list of features. Files in + ;; subdirectories are returned relative to DIR (so not actually features). + (let ((default-directory (file-name-as-directory dir))) + (mapcar (lambda (x) (file-truename (car x))) + (sort list-of-conflicts + ;; Sort the files by ascending HISTORY-POSITION. + (lambda (x y) (< (cdr x) (cdr y)))))))) + (defun package-built-in-p (package &optional min-version) "Return true if PACKAGE is built-in to Emacs. Optional arg MIN-VERSION, if non-nil, should be a version list @@ -588,14 +661,14 @@ If FORCE is true, (re-)activate it if it's already activated." (fail (catch 'dep-failure ;; Activate its dependencies recursively. (dolist (req (package-desc-reqs pkg-vec)) - (unless (package-activate (car req) (cadr req)) + (unless (package-activate (car req)) (throw 'dep-failure req)))))) (if fail (warn "Unable to activate package `%s'. Required package `%s-%s' is unavailable" package (car fail) (package-version-join (cadr fail))) ;; If all goes well, activate the package itself. - (package-activate-1 pkg-vec))))))) + (package-activate-1 pkg-vec force))))))) (defun define-package (_name-string _version-string &optional _docstring _requirements @@ -659,6 +732,7 @@ EXTRA-PROPERTIES is currently unused." (let* ((auto-name (format "%s-autoloads.el" name)) ;;(ignore-name (concat name "-pkg.el")) (generated-autoload-file (expand-file-name auto-name pkg-dir)) + (backup-inhibited t) (version-control 'never)) (package-autoload-ensure-default-file generated-autoload-file) (update-directory-autoloads pkg-dir) @@ -698,6 +772,7 @@ untar into a directory named DIR; otherwise, signal an error." (print-length nil)) (write-region (concat + ";;; -*- no-byte-compile: t -*-\n" (prin1-to-string (nconc (list 'define-package @@ -718,21 +793,29 @@ untar into a directory named DIR; otherwise, signal an error." nil pkg-file nil 'silent)))) (defun package--alist-to-plist-args (alist) - (mapcar (lambda (x) - (if (and (not (consp x)) - (or (keywordp x) - (not (symbolp x)) - (memq x '(nil t)))) - x `',x)) + (mapcar 'macroexp-quote (apply #'nconc (mapcar (lambda (pair) (list (car pair) (cdr pair))) alist)))) - (defun package-unpack (pkg-desc) "Install the contents of the current buffer as a package." (let* ((name (package-desc-name pkg-desc)) (dirname (package-desc-full-name pkg-desc)) (pkg-dir (expand-file-name dirname package-user-dir))) (pcase (package-desc-kind pkg-desc) + (`dir + (make-directory pkg-dir t) + (let ((file-list + (directory-files + default-directory 'full "\\`[^.].*\\.el\\'" 'nosort))) + (dolist (source-file file-list) + (let ((target-el-file + (expand-file-name (file-name-nondirectory source-file) pkg-dir))) + (copy-file source-file target-el-file t))) + ;; Now that the files have been installed, this package is + ;; indistinguishable from a `tar' or a `single'. Let's make + ;; things simple by ensuring we're one of them. + (setf (package-desc-kind pkg-desc) + (if (> (length file-list) 1) 'tar 'single)))) (`tar (make-directory package-user-dir t) ;; FIXME: should we delete PKG-DIR if it exists? @@ -806,13 +889,24 @@ buffer is killed afterwards. Return the last value in BODY." cipher-algorithm digest-algorithm compress-algorithm)) -(declare-function epg-context-set-home-directory "epg" (context directory)) (declare-function epg-verify-string "epg" (context signature &optional signed-text)) (declare-function epg-context-result-for "epg" (context name)) (declare-function epg-signature-status "epg" (signature)) (declare-function epg-signature-to-string "epg" (signature)) +(defun package--display-verify-error (context sig-file) + (unless (equal (epg-context-error-output context) "") + (with-output-to-temp-buffer "*Error*" + (with-current-buffer standard-output + (if (epg-context-result-for context 'verify) + (insert (format "Failed to verify signature %s:\n" sig-file) + (mapconcat #'epg-signature-to-string + (epg-context-result-for context 'verify) + "\n")) + (insert (format "Error while verifying signature %s:\n" sig-file))) + (insert "\nCommand output:\n" (epg-context-error-output context)))))) + (defun package--check-signature (location file) "Check signature of the current buffer. GnuPG keyring is located under \"gnupg\" in `package-user-dir'." @@ -821,8 +915,12 @@ GnuPG keyring is located under \"gnupg\" in `package-user-dir'." (sig-file (concat file ".sig")) (sig-content (package--with-work-buffer location sig-file (buffer-string)))) - (epg-context-set-home-directory context homedir) - (epg-verify-string context sig-content (buffer-string)) + (setf (epg-context-home-directory context) homedir) + (condition-case error + (epg-verify-string context sig-content (buffer-string)) + (error + (package--display-verify-error context sig-file) + (signal (car error) (cdr error)))) (let (good-signatures had-fatal-error) ;; The .sig file may contain multiple signatures. Success if one ;; of the signatures is good. @@ -836,15 +934,16 @@ GnuPG keyring is located under \"gnupg\" in `package-user-dir'." (unless (and (eq package-check-signature 'allow-unsigned) (eq (epg-signature-status sig) 'no-pubkey)) (setq had-fatal-error t)))) - (if (and (null good-signatures) had-fatal-error) - (error "Failed to verify signature %s: %S" - sig-file - (mapcar #'epg-signature-to-string - (epg-context-result-for context 'verify))) - good-signatures)))) + (when (and (null good-signatures) had-fatal-error) + (package--display-verify-error context sig-file) + (error "Failed to verify signature %s" sig-file)) + good-signatures))) (defun package-install-from-archive (pkg-desc) "Download and install a tar package." + ;; This won't happen, unless the archive is doing something wrong. + (when (eq (package-desc-kind pkg-desc) 'dir) + (error "Can't install directory package from archive")) (let* ((location (package-archive-base pkg-desc)) (file (concat (package-desc-full-name pkg-desc) (package-desc-suffix pkg-desc))) @@ -1050,23 +1149,34 @@ Also, add the originating archive to the `package-desc' structure." ;; Older archive-contents files have only 4 ;; elements here. (package--ac-desc-extras (cdr package))))) - (existing-packages (assq name package-archive-contents)) (pinned-to-archive (assoc name package-pinned-packages))) - (cond - ;; Skip entirely if pinned to another archive. - ((and pinned-to-archive - (not (equal (cdr pinned-to-archive) archive))) - nil) - ((not existing-packages) - (push (list name pkg-desc) package-archive-contents)) - (t - (while - (if (and (cdr existing-packages) - (version-list-< - version (package-desc-version (cadr existing-packages)))) - (setq existing-packages (cdr existing-packages)) - (push pkg-desc (cdr existing-packages)) - nil)))))) + ;; Skip entirely if pinned to another archive. + (when (not (and pinned-to-archive + (not (equal (cdr pinned-to-archive) archive)))) + (setq package-archive-contents + (package--append-to-alist pkg-desc package-archive-contents))))) + +(defun package--append-to-alist (pkg-desc alist) + "Append an entry for PKG-DESC to the start of ALIST and return it. +This entry takes the form (`package-desc-name' PKG-DESC). + +If ALIST already has an entry with this name, destructively add +PKG-DESC to the cdr of this entry instead, sorted by version +number." + (let* ((name (package-desc-name pkg-desc)) + (priority-version (package-desc-priority-version pkg-desc)) + (existing-packages (assq name alist))) + (if (not existing-packages) + (cons (list name pkg-desc) + alist) + (while (if (and (cdr existing-packages) + (version-list-< priority-version + (package-desc-priority-version + (cadr existing-packages)))) + (setq existing-packages (cdr existing-packages)) + (push pkg-desc (cdr existing-packages)) + nil)) + alist))) (defun package-download-transaction (packages) "Download and install all the packages in PACKAGES. @@ -1188,30 +1298,74 @@ The return result is a `package-desc'." (unless tar-desc (error "No package descriptor file found")) (with-current-buffer (tar--extract tar-desc) - (goto-char (point-min)) (unwind-protect - (let* ((pkg-def-parsed (read (current-buffer))) - (pkg-desc - (if (not (eq (car pkg-def-parsed) 'define-package)) - (error "Can't find define-package in %s" - (tar-header-name tar-desc)) - (apply #'package-desc-from-define - (append (cdr pkg-def-parsed)))))) - (setf (package-desc-kind pkg-desc) 'tar) - pkg-desc) + (package--read-pkg-desc 'tar) (kill-buffer (current-buffer)))))) +(defun package-dir-info () + "Find package information for a directory. +The return result is a `package-desc'." + (cl-assert (derived-mode-p 'dired-mode)) + (let* ((desc-file (package--description-file default-directory))) + (if (file-readable-p desc-file) + (with-temp-buffer + (insert-file-contents desc-file) + (package--read-pkg-desc 'dir)) + (let ((files (directory-files default-directory t "\\.el\\'" t)) + info) + (while files + (with-temp-buffer + (insert-file-contents (pop files)) + ;; When we find the file with the data, + (when (setq info (ignore-errors (package-buffer-info))) + ;; stop looping, + (setq files nil) + ;; set the 'dir kind, + (setf (package-desc-kind info) 'dir)))) + ;; and return the info. + info)))) + +(defun package--read-pkg-desc (kind) + "Read a `define-package' form in current buffer. +Return the pkg-desc, with desc-kind set to KIND." + (goto-char (point-min)) + (unwind-protect + (let* ((pkg-def-parsed (read (current-buffer))) + (pkg-desc + (if (not (eq (car pkg-def-parsed) 'define-package)) + (error "Can't find define-package in %s" + (tar-header-name tar-desc)) + (apply #'package-desc-from-define + (append (cdr pkg-def-parsed)))))) + (setf (package-desc-kind pkg-desc) kind) + pkg-desc))) + ;;;###autoload (defun package-install-from-buffer () "Install a package from the current buffer. -The current buffer is assumed to be a single .el or .tar file that follows the -packaging guidelines; see info node `(elisp)Packaging'. +The current buffer is assumed to be a single .el or .tar file or +a directory. These must follow the packaging guidelines (see +info node `(elisp)Packaging'). + +Specially, if current buffer is a directory, the -pkg.el +description file is not mandatory, in which case the information +is derived from the main .el file in the directory. + Downloads and installs required packages as needed." (interactive) - (let ((pkg-desc (if (derived-mode-p 'tar-mode) - (package-tar-file-info) - (package-buffer-info)))) + (let ((pkg-desc + (cond + ((derived-mode-p 'dired-mode) + ;; This is the only way a package-desc object with a `dir' + ;; desc-kind can be created. Such packages can't be + ;; uploaded or installed from archives, they can only be + ;; installed from local buffers or directories. + (package-dir-info)) + ((derived-mode-p 'tar-mode) + (package-tar-file-info)) + (t + (package-buffer-info))))) ;; Download and install the dependencies. (let* ((requires (package-desc-reqs pkg-desc)) (transaction (package-compute-transaction nil requires))) @@ -1226,8 +1380,12 @@ Downloads and installs required packages as needed." The file can either be a tar file or an Emacs Lisp file." (interactive "fPackage file name: ") (with-temp-buffer - (insert-file-contents-literally file) - (when (string-match "\\.tar\\'" file) (tar-mode)) + (if (file-directory-p file) + (progn + (setq default-directory file) + (dired-mode)) + (insert-file-contents-literally file) + (when (string-match "\\.tar\\'" file) (tar-mode))) (package-install-from-buffer))) (defun package-delete (pkg-desc) @@ -1255,6 +1413,25 @@ The file can either be a tar file or an Emacs Lisp file." "Return the archive containing the package NAME." (cdr (assoc (package-desc-archive desc) package-archives))) +(defun package-archive-priority (archive) + "Return the priority of ARCHIVE. + +The archive priorities are specified in +`package-archive-priorities'. If not given there, the priority +defaults to 0." + (or (cdr (assoc archive package-archive-priorities)) + 0)) + +(defun package-desc-priority-version (pkg-desc) + "Return the version PKG-DESC with the archive priority prepended. + +This allows for easy comparison of package versions from +different archives if archive priorities are meant to be taken in +consideration." + (cons (package-archive-priority + (package-desc-archive pkg-desc)) + (package-desc-version pkg-desc))) + (defun package--download-one-archive (archive file) "Retrieve an archive file FILE from ARCHIVE, and cache it. ARCHIVE should be a cons cell of the form (NAME . LOCATION), @@ -1298,14 +1475,9 @@ similar to an entry in `package-alist'. Save the cached copy to (setq file (expand-file-name file)) (let ((context (epg-make-context 'OpenPGP)) (homedir (expand-file-name "gnupg" package-user-dir))) - ;; FIXME Use `with-file-modes' when merged to trunk. - (let ((umask (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes 448) - (make-directory homedir t)) - (set-default-file-modes umask))) - (epg-context-set-home-directory context homedir) + (with-file-modes 448 + (make-directory homedir t)) + (setf (epg-context-home-directory context) homedir) (message "Importing %s..." (file-name-nondirectory file)) (epg-import-keys-from-file context file) (message "Importing %s...done" (file-name-nondirectory file)))) @@ -1932,18 +2104,18 @@ If optional arg BUTTON is non-nil, describe its associated package." ;; ENTRY is (PKG-DESC [NAME VERSION STATUS DOC]) (let ((pkg-desc (car entry)) (status (aref (cadr entry) 2))) - (cond ((member status '("installed" "unsigned")) - (push pkg-desc installed)) - ((member status '("available" "new")) - (push (cons (package-desc-name pkg-desc) pkg-desc) - available))))) + (cond ((member status '("installed" "unsigned")) + (push pkg-desc installed)) + ((member status '("available" "new")) + (setq available (package--append-to-alist pkg-desc available)))))) ;; Loop through list of installed packages, finding upgrades. (dolist (pkg-desc installed) - (let ((avail-pkg (assq (package-desc-name pkg-desc) available))) - (and avail-pkg - (version-list-< (package-desc-version pkg-desc) - (package-desc-version (cdr avail-pkg))) - (push avail-pkg upgrades)))) + (let* ((name (package-desc-name pkg-desc)) + (avail-pkg (cadr (assq name available)))) + (and avail-pkg + (version-list-< (package-desc-priority-version pkg-desc) + (package-desc-priority-version avail-pkg)) + (push (cons name avail-pkg) upgrades)))) upgrades)) (defun package-menu-mark-upgrades () diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 7b845bf9adc..b495793bee0 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -68,6 +68,8 @@ (defconst pcase--dontcare-upats '(t _ pcase--dontcare)) +(defvar pcase--dontwarn-upats '(pcase--dontcare)) + (def-edebug-spec pcase-UPAT (&or symbolp @@ -100,26 +102,31 @@ UPatterns can take the following forms: SYMBOL matches anything and binds it to SYMBOL. (or UPAT...) matches if any of the patterns matches. (and UPAT...) matches if all the patterns match. + 'VAL matches if the object is `equal' to VAL `QPAT matches if the QPattern QPAT matches. - (pred PRED) matches if PRED applied to the object returns non-nil. + (pred FUN) matches if FUN applied to the object returns non-nil. (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. (let UPAT EXP) matches if EXP matches UPAT. + (app FUN UPAT) matches if FUN applied to the object matches UPAT. If a SYMBOL is used twice in the same pattern (i.e. the pattern is \"non-linear\"), then the second occurrence is turned into an `eq'uality test. QPatterns can take the following forms: - (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. - ,UPAT matches if the UPattern UPAT matches. - STRING matches if the object is `equal' to STRING. - ATOM matches if the object is `eq' to ATOM. -QPatterns for vectors are not implemented yet. - -PRED can take the form - FUNCTION in which case it gets called with one argument. - (FUN ARG1 .. ARGN) in which case it gets called with an N+1'th argument + (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. + [QPAT1 QPAT2..QPATn] matches a vector of length n and QPAT1..QPATn match + its 0..(n-1)th elements, respectively. + ,UPAT matches if the UPattern UPAT matches. + STRING matches if the object is `equal' to STRING. + ATOM matches if the object is `eq' to ATOM. + +FUN can take the form + SYMBOL or (lambda ARGS BODY) in which case it's called with one argument. + (F ARG1 .. ARGn) in which case F gets called with an n+1'th argument which is the value being matched. -A PRED of the form FUNCTION is equivalent to one of the form (FUNCTION). -PRED patterns can refer to variables bound earlier in the pattern. +So a FUN of the form SYMBOL is equivalent to one of the form (FUN). +FUN can refer to variables bound earlier in the pattern. +FUN is assumed to be pure, i.e. it can be dropped if its result is not used, +and two identical calls can be merged into one. E.g. you can match pairs where the cdr is larger than the car with a pattern like `(,a . ,(pred (< a))) or, with more checks: `(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))" @@ -147,6 +154,16 @@ like `(,a . ,(pred (< a))) or, with more checks: ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2) expansion)))) +;;;###autoload +(defmacro pcase-exhaustive (exp &rest cases) + "The exhaustive version of `pcase' (which see)." + (declare (indent 1) (debug pcase)) + (let* ((x (make-symbol "x")) + (pcase--dontwarn-upats (cons x pcase--dontwarn-upats))) + (pcase--expand + ;; FIXME: Could we add the FILE:LINE data in the error message? + exp (append cases `((,x (error "No clause matching `%S'" ,x))))))) + (defun pcase--let* (bindings body) (cond ((null bindings) (macroexp-progn body)) @@ -265,7 +282,7 @@ of the form (UPAT EXP)." (main (pcase--u (mapcar (lambda (case) - `((match ,val . ,(car case)) + `(,(pcase--match val (pcase--macroexpand (car case))) ,(lambda (vars) (unless (memq case used-cases) ;; Keep track of the cases that are used. @@ -279,10 +296,50 @@ of the form (UPAT EXP)." vars)))) cases)))) (dolist (case cases) - (unless (or (memq case used-cases) (eq (car case) 'pcase--dontcare)) + (unless (or (memq case used-cases) + (memq (car case) pcase--dontwarn-upats)) (message "Redundant pcase pattern: %S" (car case)))) (macroexp-let* defs main)))) +(defun pcase--macroexpand (pat) + "Expands all macro-patterns in PAT." + (let ((head (car-safe pat))) + (cond + ((null head) + (if (pcase--self-quoting-p pat) `',pat pat)) + ((memq head '(pred guard quote)) pat) + ((memq head '(or and)) `(,head ,@(mapcar #'pcase--macroexpand (cdr pat)))) + ((eq head 'let) `(let ,(pcase--macroexpand (cadr pat)) ,@(cddr pat))) + ((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat)))) + (t + (let* ((expander (get head 'pcase-macroexpander)) + (npat (if expander (apply expander (cdr pat))))) + (if (null npat) + (error (if expander + "Unexpandable %s pattern: %S" + "Unknown %s pattern: %S") + head pat) + (pcase--macroexpand npat))))))) + +;;;###autoload +(defmacro pcase-defmacro (name args &rest body) + "Define a pcase UPattern macro." + (declare (indent 2) (debug (def-name sexp def-body)) (doc-string 3)) + `(put ',name 'pcase-macroexpander + (lambda ,args ,@body))) + +(defun pcase--match (val upat) + "Build a MATCH structure, hoisting all `or's and `and's outside." + (cond + ;; Hoist or/and patterns into or/and matches. + ((memq (car-safe upat) '(or and)) + `(,(car upat) + ,@(mapcar (lambda (upat) + (pcase--match val upat)) + (cdr upat)))) + (t + `(match ,val . ,upat)))) + (defun pcase-codegen (code vars) ;; Don't use let*, otherwise macroexp-let* may merge it with some surrounding ;; let* which might prevent the setcar/setcdr in pcase--expand's fancy @@ -306,11 +363,6 @@ of the form (UPAT EXP)." ((eq then :pcase--dontcare) (debug) else) ;Can/should this ever happen? (t (macroexp-if test then else)))) -(defun pcase--upat (qpattern) - (cond - ((eq (car-safe qpattern) '\,) (cadr qpattern)) - (t (list '\` qpattern)))) - ;; Note about MATCH: ;; When we have patterns like `(PAT1 . PAT2), after performing the `consp' ;; check, we want to turn all the similar patterns into ones of the form @@ -383,21 +435,12 @@ MATCH is the pattern that needs to be matched, of the form: (defun pcase--split-match (sym splitter match) (cond - ((eq (car match) 'match) + ((eq (car-safe match) 'match) (if (not (eq sym (cadr match))) (cons match match) - (let ((pat (cddr match))) - (cond - ;; Hoist `or' and `and' patterns to `or' and `and' matches. - ((memq (car-safe pat) '(or and)) - (pcase--split-match sym splitter - (cons (car pat) - (mapcar (lambda (alt) - `(match ,sym . ,alt)) - (cdr pat))))) - (t (let ((res (funcall splitter (cddr match)))) - (cons (or (car res) match) (or (cdr res) match)))))))) - ((memq (car match) '(or and)) + (let ((res (funcall splitter (cddr match)))) + (cons (or (car res) match) (or (cdr res) match))))) + ((memq (car-safe match) '(or and)) (let ((then-alts '()) (else-alts '()) (neutral-elem (if (eq 'or (car match)) @@ -417,6 +460,7 @@ MATCH is the pattern that needs to be matched, of the form: ((null else-alts) neutral-elem) ((null (cdr else-alts)) (car else-alts)) (t (cons (car match) (nreverse else-alts))))))) + ((memq match '(:pcase--succeed :pcase--fail)) (cons match match)) (t (error "Uknown MATCH %s" match)))) (defun pcase--split-rest (sym splitter rest) @@ -433,27 +477,13 @@ MATCH is the pattern that needs to be matched, of the form: (push (cons (cdr split) code&vars) else-rest)))) (cons (nreverse then-rest) (nreverse else-rest)))) -(defun pcase--split-consp (syma symd pat) - (cond - ;; A QPattern for a cons, can only go the `then' side. - ((and (eq (car-safe pat) '\`) (consp (cadr pat))) - (let ((qpat (cadr pat))) - (cons `(and (match ,syma . ,(pcase--upat (car qpat))) - (match ,symd . ,(pcase--upat (cdr qpat)))) - :pcase--fail))) - ;; A QPattern but not for a cons, can only go to the `else' side. - ((eq (car-safe pat) '\`) '(:pcase--fail . nil)) - ((and (eq (car-safe pat) 'pred) - (pcase--mutually-exclusive-p #'consp (cadr pat))) - '(:pcase--fail . nil)))) - (defun pcase--split-equal (elem pat) (cond ;; The same match will give the same result. - ((and (eq (car-safe pat) '\`) (equal (cadr pat) elem)) + ((and (eq (car-safe pat) 'quote) (equal (cadr pat) elem)) '(:pcase--succeed . :pcase--fail)) ;; A different match will fail if this one succeeds. - ((and (eq (car-safe pat) '\`) + ((and (eq (car-safe pat) 'quote) ;; (or (integerp (cadr pat)) (symbolp (cadr pat)) ;; (consp (cadr pat))) ) @@ -467,6 +497,7 @@ MATCH is the pattern that needs to be matched, of the form: '(:pcase--fail . nil)))))) (defun pcase--split-member (elems pat) + ;; FIXME: The new pred-based member code doesn't do these optimizations! ;; Based on pcase--split-equal. (cond ;; The same match (or a match of membership in a superset) will @@ -474,10 +505,10 @@ MATCH is the pattern that needs to be matched, of the form: ;; (??? ;; '(:pcase--succeed . nil)) ;; A match for one of the elements may succeed or fail. - ((and (eq (car-safe pat) '\`) (member (cadr pat) elems)) + ((and (eq (car-safe pat) 'quote) (member (cadr pat) elems)) nil) ;; A different match will fail if this one succeeds. - ((and (eq (car-safe pat) '\`) + ((and (eq (car-safe pat) 'quote) ;; (or (integerp (cadr pat)) (symbolp (cadr pat)) ;; (consp (cadr pat))) ) @@ -508,7 +539,7 @@ MATCH is the pattern that needs to be matched, of the form: ((and (eq 'pred (car upat)) (let ((otherpred (cond ((eq 'pred (car-safe pat)) (cadr pat)) - ((not (eq '\` (car-safe pat))) nil) + ((not (eq 'quote (car-safe pat))) nil) ((consp (cadr pat)) #'consp) ((vectorp (cadr pat)) #'vectorp) ((byte-code-function-p (cadr pat)) @@ -516,7 +547,7 @@ MATCH is the pattern that needs to be matched, of the form: (pcase--mutually-exclusive-p (cadr upat) otherpred))) '(:pcase--fail . nil)) ((and (eq 'pred (car upat)) - (eq '\` (car-safe pat)) + (eq 'quote (car-safe pat)) (symbolp (cadr upat)) (or (symbolp (cadr pat)) (stringp (cadr pat)) (numberp (cadr pat))) (get (cadr upat) 'side-effect-free) @@ -538,10 +569,71 @@ MATCH is the pattern that needs to be matched, of the form: (defun pcase--self-quoting-p (upat) (or (keywordp upat) (numberp upat) (stringp upat))) +(defun pcase--app-subst-match (match sym fun nsym) + (cond + ((eq (car-safe match) 'match) + (if (and (eq sym (cadr match)) + (eq 'app (car-safe (cddr match))) + (equal fun (nth 1 (cddr match)))) + (pcase--match nsym (nth 2 (cddr match))) + match)) + ((memq (car-safe match) '(or and)) + `(,(car match) + ,@(mapcar (lambda (match) + (pcase--app-subst-match match sym fun nsym)) + (cdr match)))) + ((memq match '(:pcase--succeed :pcase--fail)) match) + (t (error "Uknown MATCH %s" match)))) + +(defun pcase--app-subst-rest (rest sym fun nsym) + (mapcar (lambda (branch) + `(,(pcase--app-subst-match (car branch) sym fun nsym) + ,@(cdr branch))) + rest)) + (defsubst pcase--mark-used (sym) ;; Exceptionally, `sym' may be a constant expression rather than a symbol. (if (symbolp sym) (put sym 'pcase-used t))) +(defmacro pcase--flip (fun arg1 arg2) + "Helper function, used internally to avoid (funcall (lambda ...) ...)." + (declare (debug (sexp body))) + `(,fun ,arg2 ,arg1)) + +(defun pcase--funcall (fun arg vars) + "Build a function call to FUN with arg ARG." + (if (symbolp fun) + `(,fun ,arg) + (let* (;; `vs' is an upper bound on the vars we need. + (vs (pcase--fgrep (mapcar #'car vars) fun)) + (env (mapcar (lambda (var) + (list var (cdr (assq var vars)))) + vs)) + (call (progn + (when (memq arg vs) + ;; `arg' is shadowed by `env'. + (let ((newsym (make-symbol "x"))) + (push (list newsym arg) env) + (setq arg newsym))) + (if (functionp fun) + `(funcall #',fun ,arg) + `(,@fun ,arg))))) + (if (null vs) + call + ;; Let's not replace `vars' in `fun' since it's + ;; too difficult to do it right, instead just + ;; let-bind `vars' around `fun'. + `(let* ,env ,call))))) + +(defun pcase--eval (exp vars) + "Build an expression that will evaluate EXP." + (let* ((found (assq exp vars))) + (if found (cdr found) + (let* ((vs (pcase--fgrep (mapcar #'car vars) exp)) + (env (mapcar (lambda (v) (list v (cdr (assq v vars)))) + vs))) + (if env (macroexp-let* env exp) exp))))) + ;; It's very tempting to use `pcase' below, tho obviously, it'd create ;; bootstrapping problems. (defun pcase--u1 (matches code vars rest) @@ -563,22 +655,26 @@ Otherwise, it defers to REST which is a list of branches of the form ((eq 'or (caar matches)) (let* ((alts (cdar matches)) (var (if (eq (caar alts) 'match) (cadr (car alts)))) - (simples '()) (others '())) + (simples '()) (others '()) (memq-ok t)) (when var (dolist (alt alts) (if (and (eq (car alt) 'match) (eq var (cadr alt)) (let ((upat (cddr alt))) - (and (eq (car-safe upat) '\`) - (or (integerp (cadr upat)) (symbolp (cadr upat)) - (stringp (cadr upat)))))) - (push (cddr alt) simples) + (eq (car-safe upat) 'quote))) + (let ((val (cadr (cddr alt)))) + (unless (or (integerp val) (symbolp val)) + (setq memq-ok nil)) + (push (cadr (cddr alt)) simples)) (push alt others)))) (cond ((null alts) (error "Please avoid it") (pcase--u rest)) + ;; Yes, we can use `memq' (or `member')! ((> (length simples) 1) - ;; De-hoist the `or' MATCH into an `or' pattern that will be - ;; turned into a `memq' below. - (pcase--u1 (cons `(match ,var or . ,(nreverse simples)) (cdr matches)) + (pcase--u1 (cons `(match ,var + . (pred (pcase--flip + ,(if memq-ok #'memq #'member) + ',simples))) + (cdr matches)) code vars (if (null others) rest (cons (cons @@ -612,35 +708,11 @@ Otherwise, it defers to REST which is a list of branches of the form sym (lambda (pat) (pcase--split-pred vars upat pat)) rest)) (then-rest (car splitrest)) (else-rest (cdr splitrest))) - (pcase--if (if (and (eq (car upat) 'pred) (symbolp (cadr upat))) - `(,(cadr upat) ,sym) - (let* ((exp (cadr upat)) - ;; `vs' is an upper bound on the vars we need. - (vs (pcase--fgrep (mapcar #'car vars) exp)) - (env (mapcar (lambda (var) - (list var (cdr (assq var vars)))) - vs)) - (call (if (eq 'guard (car upat)) - exp - (when (memq sym vs) - ;; `sym' is shadowed by `env'. - (let ((newsym (make-symbol "x"))) - (push (list newsym sym) env) - (setq sym newsym))) - (if (functionp exp) - `(funcall #',exp ,sym) - `(,@exp ,sym))))) - (if (null vs) - call - ;; Let's not replace `vars' in `exp' since it's - ;; too difficult to do it right, instead just - ;; let-bind `vars' around `exp'. - `(let* ,env ,call)))) + (pcase--if (if (eq (car upat) 'pred) + (pcase--funcall (cadr upat) sym vars) + (pcase--eval (cadr upat) vars)) (pcase--u1 matches code vars then-rest) (pcase--u else-rest)))) - ((pcase--self-quoting-p upat) - (pcase--mark-used sym) - (pcase--q1 sym upat matches code vars rest)) ((symbolp upat) (pcase--mark-used sym) (if (not (assq upat vars)) @@ -655,57 +727,41 @@ Otherwise, it defers to REST which is a list of branches of the form ;; (cons (cons (nth 1 upat) (nth 2 upat)) vars) rest) (macroexp-let2 macroexp-copyable-p sym - (let* ((exp (nth 2 upat)) - (found (assq exp vars))) - (if found (cdr found) - (let* ((vs (pcase--fgrep (mapcar #'car vars) exp)) - (env (mapcar (lambda (v) (list v (cdr (assq v vars)))) - vs))) - (if env (macroexp-let* env exp) exp)))) - (pcase--u1 (cons `(match ,sym . ,(nth 1 upat)) matches) + (pcase--eval (nth 2 upat) vars) + (pcase--u1 (cons (pcase--match sym (nth 1 upat)) matches) code vars rest))) - ((eq (car-safe upat) '\`) + ((eq (car-safe upat) 'app) + ;; A upat of the form (app FUN UPAT) (pcase--mark-used sym) - (pcase--q1 sym (cadr upat) matches code vars rest)) - ((eq (car-safe upat) 'or) - (let ((all (> (length (cdr upat)) 1)) - (memq-fine t)) - (when all - (dolist (alt (cdr upat)) - (unless (if (pcase--self-quoting-p alt) - (progn - (unless (or (symbolp alt) (integerp alt)) - (setq memq-fine nil)) - t) - (and (eq (car-safe alt) '\`) - (or (symbolp (cadr alt)) (integerp (cadr alt)) - (setq memq-fine nil) - (stringp (cadr alt))))) - (setq all nil)))) - (if all - ;; Use memq for (or `a `b `c `d) rather than a big tree. - (let* ((elems (mapcar (lambda (x) (if (consp x) (cadr x) x)) - (cdr upat))) - (splitrest - (pcase--split-rest - sym (lambda (pat) (pcase--split-member elems pat)) rest)) - (then-rest (car splitrest)) - (else-rest (cdr splitrest))) - (pcase--mark-used sym) - (pcase--if `(,(if memq-fine #'memq #'member) ,sym ',elems) - (pcase--u1 matches code vars then-rest) - (pcase--u else-rest))) - (pcase--u1 (cons `(match ,sym ,@(cadr upat)) matches) code vars - (append (mapcar (lambda (upat) - `((and (match ,sym . ,upat) ,@matches) - ,code ,@vars)) - (cddr upat)) - rest))))) - ((eq (car-safe upat) 'and) - (pcase--u1 (append (mapcar (lambda (upat) `(match ,sym ,@upat)) - (cdr upat)) - matches) - code vars rest)) + (let* ((fun (nth 1 upat)) + (nsym (make-symbol "x")) + (body + ;; We don't change `matches' to reuse the newly computed value, + ;; because we assume there shouldn't be such redundancy in there. + (pcase--u1 (cons (pcase--match nsym (nth 2 upat)) matches) + code vars + (pcase--app-subst-rest rest sym fun nsym)))) + (if (not (get nsym 'pcase-used)) + body + (macroexp-let* + `((,nsym ,(pcase--funcall fun sym vars))) + body)))) + ((eq (car-safe upat) 'quote) + (pcase--mark-used sym) + (let* ((val (cadr upat)) + (splitrest (pcase--split-rest + sym (lambda (pat) (pcase--split-equal val pat)) rest)) + (then-rest (car splitrest)) + (else-rest (cdr splitrest))) + (pcase--if (cond + ((null val) `(null ,sym)) + ((or (integerp val) (symbolp val)) + (if (pcase--self-quoting-p val) + `(eq ,sym ,val) + `(eq ,sym ',val))) + (t `(equal ,sym ',val))) + (pcase--u1 matches code vars then-rest) + (pcase--u else-rest)))) ((eq (car-safe upat) 'not) ;; FIXME: The implementation below is naive and results in ;; inefficient code. @@ -727,57 +783,25 @@ Otherwise, it defers to REST which is a list of branches of the form (pcase--u rest)) vars (list `((and . ,matches) ,code . ,vars)))) - (t (error "Unknown upattern `%s'" upat))))) - (t (error "Incorrect MATCH %s" (car matches))))) + (t (error "Unknown internal pattern `%S'" upat))))) + (t (error "Incorrect MATCH %S" (car matches))))) -(defun pcase--q1 (sym qpat matches code vars rest) - "Return code that runs CODE if SYM matches QPAT and if MATCHES match. -Otherwise, it defers to REST which is a list of branches of the form -\(OTHER_MATCH OTHER-CODE . OTHER-VARS)." +(pcase-defmacro \` (qpat) (cond - ((eq (car-safe qpat) '\,) (error "Can't use `,UPATTERN")) - ((floatp qpat) (error "Floating point patterns not supported")) + ((eq (car-safe qpat) '\,) (cadr qpat)) ((vectorp qpat) - ;; FIXME. - (error "Vector QPatterns not implemented yet")) + `(and (pred vectorp) + (app length ,(length qpat)) + ,@(let ((upats nil)) + (dotimes (i (length qpat)) + (push `(app (pcase--flip aref ,i) ,(list '\` (aref qpat i))) + upats)) + (nreverse upats)))) ((consp qpat) - (let* ((syma (make-symbol "xcar")) - (symd (make-symbol "xcdr")) - (splitrest (pcase--split-rest - sym - (lambda (pat) (pcase--split-consp syma symd pat)) - rest)) - (then-rest (car splitrest)) - (else-rest (cdr splitrest)) - (then-body (pcase--u1 `((match ,syma . ,(pcase--upat (car qpat))) - (match ,symd . ,(pcase--upat (cdr qpat))) - ,@matches) - code vars then-rest))) - (pcase--if - `(consp ,sym) - ;; We want to be careful to only add bindings that are used. - ;; The byte-compiler could do that for us, but it would have to pay - ;; attention to the `consp' test in order to figure out that car/cdr - ;; can't signal errors and our byte-compiler is not that clever. - ;; FIXME: Some of those let bindings occur too early (they are used in - ;; `then-body', but only within some sub-branch). - (macroexp-let* - `(,@(if (get syma 'pcase-used) `((,syma (car ,sym)))) - ,@(if (get symd 'pcase-used) `((,symd (cdr ,sym))))) - then-body) - (pcase--u else-rest)))) - ((or (integerp qpat) (symbolp qpat) (stringp qpat)) - (let* ((splitrest (pcase--split-rest - sym (lambda (pat) (pcase--split-equal qpat pat)) rest)) - (then-rest (car splitrest)) - (else-rest (cdr splitrest))) - (pcase--if (cond - ((stringp qpat) `(equal ,sym ,qpat)) - ((null qpat) `(null ,sym)) - (t `(eq ,sym ',qpat))) - (pcase--u1 matches code vars then-rest) - (pcase--u else-rest)))) - (t (error "Unknown QPattern %s" qpat)))) + `(and (pred consp) + (app car ,(list '\` (car qpat))) + (app cdr ,(list '\` (cdr qpat))))) + ((or (stringp qpat) (integerp qpat) (symbolp qpat)) `',qpat))) (provide 'pcase) diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 180690c37bb..ac3cc74ca6a 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -137,7 +137,7 @@ Also add the value to the front of the list in the variable `values'." "Macroexpand EXPRESSION and pretty-print its value." (interactive (list (read--expression "Macroexpand: "))) - (pp-display-expression (macroexpand expression) "*Pp Macroexpand Output*")) + (pp-display-expression (macroexpand-1 expression) "*Pp Macroexpand Output*")) (defun pp-last-sexp () "Read sexp before point. Ignores leading comment characters." @@ -175,7 +175,7 @@ With argument, pretty-print output into current buffer. Ignores leading comment characters." (interactive "P") (if arg - (insert (pp-to-string (macroexpand (pp-last-sexp)))) + (insert (pp-to-string (macroexpand-1 (pp-last-sexp)))) (pp-macroexpand-expression (pp-last-sexp)))) ;;; Test cases for quote diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index 7bd7deaf97b..b0fb23dbcc9 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -205,9 +205,7 @@ Merges keywords to avoid backtracking in Emacs's regexp matcher." (regexp-opt-group suffixes t t) close-group)) - (let* ((sgnirts (mapcar (lambda (s) - (concat (nreverse (string-to-list s)))) - strings)) + (let* ((sgnirts (mapcar #'reverse strings)) (xiffus (try-completion "" sgnirts))) (if (> (length xiffus) 0) ;; common suffix: take it and recurse on the prefixes. @@ -218,8 +216,7 @@ Merges keywords to avoid backtracking in Emacs's regexp matcher." 'string-lessp))) (concat open-group (regexp-opt-group prefixes t t) - (regexp-quote - (concat (nreverse (string-to-list xiffus)))) + (regexp-quote (nreverse xiffus)) close-group)) ;; Otherwise, divide the list into those that start with a diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el new file mode 100644 index 00000000000..b28153b7f81 --- /dev/null +++ b/lisp/emacs-lisp/seq.el @@ -0,0 +1,273 @@ +;;; seq.el --- Sequence manipulation functions -*- lexical-binding: t -*- + +;; Copyright (C) 2014-2015 Free Software Foundation, Inc. + +;; Author: Nicolas Petton <petton.nicolas@gmail.com> +;; Keywords: sequences +;; Version: 1.0 + +;; Maintainer: emacs-devel@gnu.org + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Sequence-manipulation functions that complement basic functions +;; provided by subr.el. +;; +;; All functions are prefixed with "seq-". +;; +;; All provided functions work on lists, strings and vectors. +;; +;; Functions taking a predicate or a function iterating over the +;; sequence as argument take the function as their first argument and +;; the sequence as their second argument. All other functions take +;; the sequence as their first argument. +;; +;; All functions are tested in test/automated/seq-tests.el + +;;; Code: + +(defmacro seq-doseq (spec &rest body) + "Loop over a sequence. +Similar to `dolist' but can be applied lists, strings and vectors. + +Evaluate BODY with VAR bound to each element of SEQ, in turn. +Then evaluate RESULT to get return value, default nil. + +\(fn (VAR SEQ [RESULT]) BODY...)" + (declare (indent 1) (debug ((symbolp form &optional form) body))) + (let ((is-list (make-symbol "is-list")) + (seq (make-symbol "seq")) + (index (make-symbol "index"))) + `(let* ((,seq ,(cadr spec)) + (,is-list (listp ,seq)) + (,index (if ,is-list ,seq 0))) + (while (if ,is-list + (consp ,index) + (< ,index (seq-length ,seq))) + (let ((,(car spec) (if ,is-list + (car ,index) + (seq-elt ,seq ,index)))) + ,@body + (setq ,index (if ,is-list + (cdr ,index) + (+ ,index 1))))) + ,@(if (cddr spec) + `((setq ,(car spec) nil) ,@(cddr spec)))))) + +(defun seq-drop (seq n) + "Return a subsequence of SEQ without its first N elements. +The result is a sequence of the same type as SEQ. + +If N is a negative integer or zero, SEQ is returned." + (if (<= n 0) + seq + (if (listp seq) + (seq--drop-list seq n) + (let ((length (seq-length seq))) + (seq-subseq seq (min n length) length))))) + +(defun seq-take (seq n) + "Return a subsequence of SEQ with its first N elements. +The result is a sequence of the same type as SEQ. + +If N is a negative integer or zero, an empty sequence is +returned." + (if (listp seq) + (seq--take-list seq n) + (seq-subseq seq 0 (min (max n 0) (seq-length seq))))) + +(defun seq-drop-while (pred seq) + "Return a sequence, from the first element for which (PRED element) is nil, of SEQ. +The result is a sequence of the same type as SEQ." + (if (listp seq) + (seq--drop-while-list pred seq) + (seq-drop seq (seq--count-successive pred seq)))) + +(defun seq-take-while (pred seq) + "Return a sequence of the successive elements for which (PRED element) is non-nil in SEQ. +The result is a sequence of the same type as SEQ." + (if (listp seq) + (seq--take-while-list pred seq) + (seq-take seq (seq--count-successive pred seq)))) + +(defun seq-filter (pred seq) + "Return a list of all the elements for which (PRED element) is non-nil in SEQ." + (let ((exclude (make-symbol "exclude"))) + (delq exclude (seq-map (lambda (elt) + (if (funcall pred elt) + elt + exclude)) + seq)))) + +(defun seq-remove (pred seq) + "Return a list of all the elements for which (PRED element) is nil in SEQ." + (seq-filter (lambda (elt) (not (funcall pred elt))) + seq)) + +(defun seq-reduce (function seq initial-value) + "Reduce the function FUNCTION across SEQ, starting with INITIAL-VALUE. + +Return the result of calling FUNCTION with INITIAL-VALUE and the +first element of SEQ, then calling FUNCTION with that result and +the second element of SEQ, then with that result and the third +element of SEQ, etc. + +If SEQ is empty, return INITIAL-VALUE and FUNCTION is not called." + (if (seq-empty-p seq) + initial-value + (let ((acc initial-value)) + (seq-doseq (elt seq) + (setq acc (funcall function acc elt))) + acc))) + +(defun seq-some-p (pred seq) + "Return any element for which (PRED element) is non-nil in SEQ, nil otherwise." + (catch 'seq--break + (seq-doseq (elt seq) + (when (funcall pred elt) + (throw 'seq--break elt))) + nil)) + +(defun seq-every-p (pred seq) + "Return non-nil if (PRED element) is non-nil for all elements of the sequence SEQ." + (catch 'seq--break + (seq-doseq (elt seq) + (or (funcall pred elt) + (throw 'seq--break nil))) + t)) + +(defun seq-count (pred seq) + "Return the number of elements for which (PRED element) returns non-nil in seq." + (let ((count 0)) + (seq-doseq (elt seq) + (when (funcall pred elt) + (setq count (+ 1 count)))) + count)) + +(defun seq-empty-p (seq) + "Return non-nil if the sequence SEQ is empty, nil otherwise." + (if (listp seq) + (null seq) + (= 0 (seq-length seq)))) + +(defun seq-sort (pred seq) + "Return a sorted sequence comparing using PRED the elements of SEQ. +The result is a sequence of the same type as SEQ." + (if (listp seq) + (sort (seq-copy seq) pred) + (let ((result (seq-sort pred (append seq nil)))) + (cond ((stringp seq) (concat result)) + ((vectorp seq) (vconcat result)) + (t (error "Unsupported sequence: %s" seq)))))) + +(defun seq-contains-p (seq elt &optional testfn) + "Return the first element in SEQ that equals to ELT. +Equality is defined by TESTFN if non-nil or by `equal' if nil." + (seq-some-p (lambda (e) + (funcall (or testfn #'equal) elt e)) + seq)) + +(defun seq-uniq (seq &optional testfn) + "Return a list of the elements of SEQ with duplicates removed. +TESTFN is used to compare elements, or `equal' if TESTFN is nil." + (let ((result '())) + (seq-doseq (elt seq) + (unless (seq-contains-p result elt testfn) + (setq result (cons elt result)))) + (nreverse result))) + +(defun seq-subseq (seq start &optional end) + "Return the subsequence of SEQ from START to END. +If END is omitted, it defaults to the length of the sequence. +If START or END is negative, it counts from the end." + (cond ((or (stringp seq) (vectorp seq)) (substring seq start end)) + ((listp seq) + (let (len (errtext (format "Bad bounding indices: %s, %s" start end))) + (and end (< end 0) (setq end (+ end (setq len (seq-length seq))))) + (if (< start 0) (setq start (+ start (or len (setq len (seq-length seq)))))) + (when (> start 0) + (setq seq (nthcdr (1- start) seq)) + (or seq (error "%s" errtext)) + (setq seq (cdr seq))) + (if end + (let ((res nil)) + (while (and (>= (setq end (1- end)) start) seq) + (push (pop seq) res)) + (or (= (1+ end) start) (error "%s" errtext)) + (nreverse res)) + (seq-copy seq)))) + (t (error "Unsupported sequence: %s" seq)))) + +(defun seq-concatenate (type &rest seqs) + "Concatenate, into a sequence of type TYPE, the sequences SEQS. +TYPE must be one of following symbols: vector, string or list. + +\n(fn TYPE SEQUENCE...)" + (pcase type + (`vector (apply #'vconcat seqs)) + (`string (apply #'concat seqs)) + (`list (apply #'append (append seqs '(nil)))) + (t (error "Not a sequence type name: %s" type)))) + +(defun seq--drop-list (list n) + "Optimized version of `seq-drop' for lists." + (while (and list (> n 0)) + (setq list (cdr list) + n (1- n))) + list) + +(defun seq--take-list (list n) + "Optimized version of `seq-take' for lists." + (let ((result '())) + (while (and list (> n 0)) + (setq n (1- n)) + (push (pop list) result)) + (nreverse result))) + +(defun seq--drop-while-list (pred list) + "Optimized version of `seq-drop-while' for lists." + (while (and list (funcall pred (car list))) + (setq list (cdr list))) + list) + +(defun seq--take-while-list (pred list) + "Optimized version of `seq-take-while' for lists." + (let ((result '())) + (while (and list (funcall pred (car list))) + (push (pop list) result)) + (nreverse result))) + +(defun seq--count-successive (pred seq) + "Return the number of successive elements for which (PRED element) is non-nil in SEQ." + (let ((n 0) + (len (seq-length seq))) + (while (and (< n len) + (funcall pred (seq-elt seq n))) + (setq n (+ 1 n))) + n)) + +(defalias 'seq-copy #'copy-sequence) +(defalias 'seq-elt #'elt) +(defalias 'seq-reverse #'reverse) +(defalias 'seq-length #'length) +(defalias 'seq-do #'mapc) +(defalias 'seq-each #'seq-do) +(defalias 'seq-map #'mapcar) + +(provide 'seq) +;;; seq.el ends here diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 184912d9fc4..5b9dc6422a2 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -632,14 +632,14 @@ e.g. a LEFT-LEVEL of nil means this is a token that behaves somewhat like an open-paren, whereas a RIGHT-LEVEL of nil would correspond to something like a close-paren.") -(defvar smie-forward-token-function 'smie-default-forward-token +(defvar smie-forward-token-function #'smie-default-forward-token "Function to scan forward for the next token. Called with no argument should return a token and move to its end. If no token is found, return nil or the empty string. It can return nil when bumping into a parenthesis, which lets SMIE use syntax-tables to handle them in efficient C code.") -(defvar smie-backward-token-function 'smie-default-backward-token +(defvar smie-backward-token-function #'smie-default-backward-token "Function to scan backward the previous token. Same calling convention as `smie-forward-token-function' except it should move backward to the beginning of the previous token.") @@ -806,9 +806,9 @@ Possible return values: nil: we skipped over an identifier, matched parentheses, ..." (smie-next-sexp (indirect-function smie-backward-token-function) - (indirect-function 'backward-sexp) - (indirect-function 'smie-op-left) - (indirect-function 'smie-op-right) + (indirect-function #'backward-sexp) + (indirect-function #'smie-op-left) + (indirect-function #'smie-op-right) halfsexp)) (defun smie-forward-sexp (&optional halfsexp) @@ -827,9 +827,9 @@ Possible return values: nil: we skipped over an identifier, matched parentheses, ..." (smie-next-sexp (indirect-function smie-forward-token-function) - (indirect-function 'forward-sexp) - (indirect-function 'smie-op-right) - (indirect-function 'smie-op-left) + (indirect-function #'forward-sexp) + (indirect-function #'smie-op-right) + (indirect-function #'smie-op-left) halfsexp)) ;;; Miscellaneous commands using the precedence parser. @@ -1121,7 +1121,7 @@ OPENER is non-nil if TOKEN is an opener and nil if it's a closer." :type 'integer :group 'smie) -(defvar smie-rules-function 'ignore +(defvar smie-rules-function #'ignore "Function providing the indentation rules. It takes two arguments METHOD and ARG where the meaning of ARG and the expected return value depends on METHOD. @@ -2121,41 +2121,45 @@ position corresponding to each rule." otraces) ;; Finally, guess the indentation rules. - (let ((ssigs nil) - (rules nil)) - ;; Sort the sigs by frequency of occurrence. - (maphash (lambda (sig sig-data) (push (cons sig sig-data) ssigs)) sigs) - (setq ssigs (sort ssigs (lambda (sd1 sd2) (> (cadr sd1) (cadr sd2))))) - (while ssigs - (pcase-let ((`(,sig ,total ,off-alist ,cotraces) (pop ssigs))) - (cl-assert (= total (apply #'+ (mapcar #'cdr off-alist)))) - (let* ((sorted-off-alist - (sort off-alist (lambda (x y) (> (cdr x) (cdr y))))) - (offset (caar sorted-off-alist))) - (if (zerop offset) - ;; Nothing to do with this sig; indentation is - ;; correct already. - nil - (push (cons (+ offset (nth 2 sig)) sig) rules) - ;; Adjust the rest of the data. - (pcase-dolist ((and cotrace `(,count ,toffset . ,trace)) - cotraces) - (setf (nth 1 cotrace) (- toffset offset)) - (dolist (sig trace) - (let ((sig-data (cdr (assq sig ssigs)))) - (when sig-data - (let* ((ooff-data (assq toffset (nth 1 sig-data))) - (noffset (- toffset offset)) - (noff-data - (or (assq noffset (nth 1 sig-data)) - (let ((off-data (cons noffset 0))) - (push off-data (nth 1 sig-data)) - off-data)))) - (cl-assert (>= (cdr ooff-data) count)) - (cl-decf (cdr ooff-data) count) - (cl-incf (cdr noff-data) count)))))))))) - (message "Guessing...done") - rules)))) + (prog1 + (smie-config--guess-1 sigs) + (message "Guessing...done"))))) + +(defun smie-config--guess-1 (sigs) + (let ((ssigs nil) + (rules nil)) + ;; Sort the sigs by frequency of occurrence. + (maphash (lambda (sig sig-data) (push (cons sig sig-data) ssigs)) sigs) + (setq ssigs (sort ssigs (lambda (sd1 sd2) (> (cadr sd1) (cadr sd2))))) + (while ssigs + (pcase-let ((`(,sig ,total ,off-alist ,cotraces) (pop ssigs))) + (cl-assert (= total (apply #'+ (mapcar #'cdr off-alist)))) + (let* ((sorted-off-alist + (sort off-alist (lambda (x y) (> (cdr x) (cdr y))))) + (offset (caar sorted-off-alist))) + (if (zerop offset) + ;; Nothing to do with this sig; indentation is + ;; correct already. + nil + (push (cons (+ offset (nth 2 sig)) sig) rules) + ;; Adjust the rest of the data. + (pcase-dolist ((and cotrace `(,count ,toffset . ,trace)) + cotraces) + (setf (nth 1 cotrace) (- toffset offset)) + (dolist (sig trace) + (let ((sig-data (cdr (assq sig ssigs)))) + (when sig-data + (let* ((ooff-data (assq toffset (nth 1 sig-data))) + (noffset (- toffset offset)) + (noff-data + (or (assq noffset (nth 1 sig-data)) + (let ((off-data (cons noffset 0))) + (push off-data (nth 1 sig-data)) + off-data)))) + (cl-assert (>= (cdr ooff-data) count)) + (cl-decf (cdr ooff-data) count) + (cl-incf (cdr noff-data) count)))))))))) + rules)) (defun smie-config-guess () "Try and figure out this buffer's indentation settings. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index f5083c4df94..78a6dc98456 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -32,6 +32,113 @@ ;;; Code: +(require 'pcase) + + +(defmacro internal--thread-argument (first? &rest forms) + "Internal implementation for `thread-first' and `thread-last'. +When Argument FIRST? is non-nil argument is threaded first, else +last. FORMS are the expressions to be threaded." + (pcase forms + (`(,x (,f . ,args) . ,rest) + `(internal--thread-argument + ,first? ,(if first? `(,f ,x ,@args) `(,f ,@args ,x)) ,@rest)) + (`(,x ,f . ,rest) `(internal--thread-argument ,first? (,f ,x) ,@rest)) + (_ (car forms)))) + +(defmacro thread-first (&rest forms) + "Thread FORMS elements as the first argument of their successor. +Example: + (thread-first + 5 + (+ 20) + (/ 25) + - + (+ 40)) +Is equivalent to: + (+ (- (/ (+ 5 20) 25)) 40) +Note how the single `-' got converted into a list before +threading." + (declare (indent 1) + (debug (form &rest [&or symbolp (sexp &rest form)]))) + `(internal--thread-argument t ,@forms)) + +(defmacro thread-last (&rest forms) + "Thread FORMS elements as the last argument of their successor. +Example: + (thread-last + 5 + (+ 20) + (/ 25) + - + (+ 40)) +Is equivalent to: + (+ 40 (- (/ 25 (+ 20 5)))) +Note how the single `-' got converted into a list before +threading." + (declare (indent 1) (debug thread-first)) + `(internal--thread-argument nil ,@forms)) + +(defsubst internal--listify (elt) + "Wrap ELT in a list if it is not one." + (if (not (listp elt)) + (list elt) + elt)) + +(defsubst internal--check-binding (binding) + "Check BINDING is properly formed." + (when (> (length binding) 2) + (signal + 'error + (cons "`let' bindings can have only one value-form" binding))) + binding) + +(defsubst internal--build-binding-value-form (binding prev-var) + "Build the conditional value form for BINDING using PREV-VAR." + `(,(car binding) (and ,prev-var ,(cadr binding)))) + +(defun internal--build-binding (binding prev-var) + "Check and build a single BINDING with PREV-VAR." + (thread-first + binding + internal--listify + internal--check-binding + (internal--build-binding-value-form prev-var))) + +(defun internal--build-bindings (bindings) + "Check and build conditional value forms for BINDINGS." + (let ((prev-var t)) + (mapcar (lambda (binding) + (let ((binding (internal--build-binding binding prev-var))) + (setq prev-var (car binding)) + binding)) + bindings))) + +(defmacro if-let (bindings then &rest else) + "Process BINDINGS and if all values are non-nil eval THEN, else ELSE. +Argument BINDINGS is a list of tuples whose car is a symbol to be +bound and (optionally) used in THEN, and its cadr is a sexp to be +evalled to set symbol's value. In the special case you only want +to bind a single value, BINDINGS can just be a plain tuple." + (declare (indent 2) (debug ((&rest (symbolp form)) form body))) + (when (and (<= (length bindings) 2) + (not (listp (car bindings)))) + ;; Adjust the single binding case + (setq bindings (list bindings))) + `(let* ,(internal--build-bindings bindings) + (if ,(car (internal--listify (car (last bindings)))) + ,then + ,@else))) + +(defmacro when-let (bindings &rest body) + "Process BINDINGS and if all values are non-nil eval BODY. +Argument BINDINGS is a list of tuples whose car is a symbol to be +bound and (optionally) used in BODY, and its cadr is a sexp to be +evalled to set symbol's value. In the special case you only want +to bind a single value, BINDINGS can just be a plain tuple." + (declare (indent 1) (debug if-let)) + (list 'if-let bindings (macroexp-progn body))) + (defsubst hash-table-keys (hash-table) "Return a list of keys in HASH-TABLE." (let ((keys '())) @@ -52,9 +159,7 @@ "Join all STRINGS using SEPARATOR." (mapconcat 'identity strings separator)) -(defsubst string-reverse (str) - "Reverse the string STR." - (apply 'string (nreverse (string-to-list str)))) +(define-obsolete-function-alias 'string-reverse 'reverse "25.1") (defsubst string-trim-left (string) "Remove leading whitespace from STRING." diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 933567db993..15a0914cb17 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -323,7 +323,8 @@ to the entry with the same ID element as the current line." (if saved-pt (progn (goto-char saved-pt) (move-to-column saved-col) - (recenter)) + (when (eq (window-buffer) (current-buffer)) + (recenter))) (goto-char (point-min))))) (defun tabulated-list-print-entry (id cols) diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 6875b76a99c..9ae11b71e5e 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -125,9 +125,7 @@ of SECS seconds since the epoch. SECS may be a fraction." "Advance TIME by SECS seconds and optionally USECS microseconds and PSECS picoseconds. SECS may be either an integer or a floating point number." - (let ((delta (if (floatp secs) - (seconds-to-time secs) - (list (floor secs 65536) (mod secs 65536))))) + (let ((delta secs)) (if (or usecs psecs) (setq delta (time-add delta (list 0 0 (or usecs 0) (or psecs 0))))) (time-add time delta))) @@ -307,8 +305,8 @@ This function is called, by name, directly by the C code." ;; perhaps because Emacs was suspended for a long time, ;; limit how many times things get repeated. (if (and (numberp timer-max-repeats) - (< 0 (timer-until timer (current-time)))) - (let ((repeats (/ (timer-until timer (current-time)) + (< 0 (timer-until timer nil))) + (let ((repeats (/ (timer-until timer nil) (timer--repeat-delay timer)))) (if (> repeats timer-max-repeats) (timer-inc-time timer (* (timer--repeat-delay timer) @@ -374,13 +372,13 @@ This function returns a timer object which you can use in `cancel-timer'." ;; Handle numbers as relative times in seconds. (if (numberp time) - (setq time (timer-relative-time (current-time) time))) + (setq time (timer-relative-time nil time))) ;; Handle relative times like "2 hours 35 minutes" (if (stringp time) (let ((secs (timer-duration time))) (if secs - (setq time (timer-relative-time (current-time) secs))))) + (setq time (timer-relative-time nil secs))))) ;; Handle "11:23pm" and the like. Interpret it as meaning today ;; which admittedly is rather stupid if we have passed that time @@ -486,7 +484,7 @@ The value is a list that the debugger can pass to `with-timeout-unsuspend' when it exits, to make these timers start counting again." (mapcar (lambda (timer) (cancel-timer timer) - (list timer (time-subtract (timer--time timer) (current-time)))) + (list timer (time-subtract (timer--time timer) nil))) with-timeout-timers)) (defun with-timeout-unsuspend (timer-spec-list) @@ -495,7 +493,7 @@ The argument should be a value previously returned by `with-timeout-suspend'." (dolist (elt timer-spec-list) (let ((timer (car elt)) (delay (cadr elt))) - (timer-set-time timer (time-add (current-time) delay)) + (timer-set-time timer (time-add nil delay)) (timer-activate timer)))) (defun y-or-n-p-with-timeout (prompt seconds default-value) diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 58c2d224890..c6d7b5018cd 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -1104,19 +1104,6 @@ If ARG is the atom `-', scroll upward by nearly full screen." (cancel-timer cua--prefix-override-timer)) (setq cua--prefix-override-timer nil)) - (cond - ;; Only symbol commands can have necessary properties - ((not (symbolp this-command)) - nil) - - ((not (eq (get this-command 'CUA) 'move)) - nil) - - ;; Set mark if user explicitly said to do so - (cua--rectangle ;FIXME: ?? - (unless (region-active-p) - (push-mark-command nil nil)))) - ;; Detect extension of rectangles by mouse or other movement (setq cua--buffer-and-point-before-command (if cua--rectangle (cons (current-buffer) (point))))) @@ -1316,33 +1303,6 @@ If ARG is the atom `-', scroll upward by nearly full screen." ) -;; Setup standard movement commands to be recognized by CUA. - -(dolist (cmd - '(forward-char backward-char - right-char left-char - right-word left-word - next-line previous-line - forward-word backward-word - end-of-line beginning-of-line - end-of-visual-line beginning-of-visual-line - move-end-of-line move-beginning-of-line - end-of-buffer beginning-of-buffer - scroll-up scroll-down - scroll-up-command scroll-down-command - up-list down-list backward-up-list - end-of-defun beginning-of-defun - forward-sexp backward-sexp - forward-list backward-list - forward-sentence backward-sentence - forward-paragraph backward-paragraph - ;; CC mode motion commands - c-forward-conditional c-backward-conditional - c-down-conditional c-up-conditional - c-down-conditional-with-else c-up-conditional-with-else - c-beginning-of-statement c-end-of-statement)) - (put cmd 'CUA 'move)) - ;; State prior to enabling cua-mode ;; Value is a list with the following elements: ;; delete-selection-mode diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el index 9863f104d03..2c9e5799ac1 100644 --- a/lisp/emulation/edt.el +++ b/lisp/emulation/edt.el @@ -2034,7 +2034,8 @@ created." ;; Make highlighting of selected text work properly for EDT commands. (if (featurep 'emacs) (progn - (setq edt-orig-transient-mark-mode transient-mark-mode) + (setq edt-orig-transient-mark-mode + (default-value 'transient-mark-mode)) (add-hook 'activate-mark-hook (function (lambda () @@ -2069,7 +2070,7 @@ created." (edt-reset) (force-mode-line-update t) (if (featurep 'emacs) - (setq transient-mark-mode edt-orig-transient-mark-mode)) + (setq-default transient-mark-mode edt-orig-transient-mark-mode)) (message "Original key bindings restored; EDT Emulation disabled")) (defun edt-default-menu-bar-update-buffers () diff --git a/lisp/epa-file.el b/lisp/epa-file.el index 3b95a837dc6..db8613aec97 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -105,9 +105,9 @@ encryption is used." (insert (if enable-multibyte-characters (string-to-multibyte string) string)) - (decode-coding-inserted-region - (point-min) (point-max) - (substring file 0 (string-match epa-file-name-regexp file)) + (decode-coding-inserted-region + (point-min) (point-max) + (substring file 0 (string-match epa-file-name-regexp file)) visit beg end replace)) (insert (epa-file--decode-coding-string string (or coding-system-for-read 'undecided))))) @@ -144,6 +144,7 @@ encryption is used." context (cons #'epa-progress-callback-function (format "Decrypting %s" file))) + (setf (epg-context-pinentry-mode context) epa-pinentry-mode) (unwind-protect (progn (if replace @@ -153,15 +154,24 @@ encryption is used." (error (if (setq entry (assoc file epa-file-passphrase-alist)) (setcdr entry nil)) - ;; Hack to prevent find-file from opening empty buffer - ;; when decryption failed (bug#6568). See the place - ;; where `find-file-not-found-functions' are called in - ;; `find-file-noselect-1'. + ;; If the decryption program can't be found, + ;; signal that as a non-file error + ;; so that find-file-noselect-1 won't handle it. + ;; Borrowed from jka-compr.el. + (if (and (eq (car error) 'file-error) + (equal (cadr error) "Searching for program")) + (error "Decryption program `%s' not found" + (nth 3 error))) (when (file-exists-p local-file) + ;; Hack to prevent find-file from opening empty buffer + ;; when decryption failed (bug#6568). See the place + ;; where `find-file-not-found-functions' are called in + ;; `find-file-noselect-1'. (setq-local epa-file-error error) (add-hook 'find-file-not-found-functions 'epa-file--find-file-not-found-function - nil t)) + nil t) + (epa-display-error context)) (signal 'file-error (cons "Opening input file" (cdr error))))) (set-buffer buf) ;In case timer/filter changed/killed it (bug#16029)! @@ -221,7 +231,8 @@ encryption is used." context (cons #'epa-progress-callback-function (format "Encrypting %s" file))) - (epg-context-set-armor context epa-armor) + (setf (epg-context-armor context) epa-armor) + (setf (epg-context-pinentry-mode context) epa-pinentry-mode) (condition-case error (setq string (epg-encrypt-string @@ -255,6 +266,7 @@ If no one is selected, symmetric encryption will be performed. " (if epa-file-encrypt-to (epg-list-keys context recipients))))) (error + (epa-display-error context) (if (setq entry (assoc file epa-file-passphrase-alist)) (setcdr entry nil)) (signal 'file-error (cons "Opening output file" (cdr error))))) diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el index 92980974afa..5a39c28d747 100644 --- a/lisp/epa-mail.el +++ b/lisp/epa-mail.el @@ -70,27 +70,24 @@ USAGE would be `sign' or `encrypt'." ;;;###autoload (defun epa-mail-decrypt () "Decrypt OpenPGP armors in the current buffer. -The buffer is expected to contain a mail message. - -Don't use this command in Lisp programs!" +The buffer is expected to contain a mail message." + (declare (interactive-only t)) (interactive) (epa-decrypt-armor-in-region (point-min) (point-max))) ;;;###autoload (defun epa-mail-verify () "Verify OpenPGP cleartext signed messages in the current buffer. -The buffer is expected to contain a mail message. - -Don't use this command in Lisp programs!" +The buffer is expected to contain a mail message." + (declare (interactive-only t)) (interactive) (epa-verify-cleartext-in-region (point-min) (point-max))) ;;;###autoload (defun epa-mail-sign (start end signers mode) "Sign the current buffer. -The buffer is expected to contain a mail message. - -Don't use this command in Lisp programs!" +The buffer is expected to contain a mail message." + (declare (interactive-only t)) (interactive (save-excursion (goto-char (point-min)) @@ -234,9 +231,8 @@ If no one is selected, symmetric encryption will be performed. " ;;;###autoload (defun epa-mail-import-keys () "Import keys in the OpenPGP armor format in the current buffer. -The buffer is expected to contain a mail message. - -Don't use this command in Lisp programs!" +The buffer is expected to contain a mail message." + (declare (interactive-only t)) (interactive) (epa-import-armor-in-region (point-min) (point-max))) diff --git a/lisp/epa.el b/lisp/epa.el index eb8681a667d..d3fec73ecf4 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -44,6 +44,25 @@ :type 'integer :group 'epa) +(defcustom epa-pinentry-mode nil + "The pinentry mode. + +GnuPG 2.1 or later has an option to control the behavior of +Pinentry invocation. Possible modes are: `ask', `cancel', +`error', and `loopback'. See the GnuPG manual for the meanings. + +In epa commands, a particularly useful mode is `loopback', which +redirects all Pinentry queries to the caller, so Emacs can query +passphrase through the minibuffer, instead of external Pinentry +program." + :type '(choice (const nil) + (const ask) + (const cancel) + (const error) + (const loopback)) + :group 'epa + :version "25.1") + (defgroup epa-faces nil "Faces for epa-mode." :version "23.1" @@ -166,6 +185,7 @@ You should bind this variable with `let', but do not set it globally.") (defvar epa-key nil) (defvar epa-list-keys-arguments nil) (defvar epa-info-buffer nil) +(defvar epa-error-buffer nil) (defvar epa-last-coding-system-specified nil) (defvar epa-key-list-mode-map @@ -578,6 +598,34 @@ If SECRET is non-nil, list secret keys instead of public keys." (shrink-window (- (window-height) epa-info-window-height))))) (message "%s" info))) +(defun epa-display-error (context) + (unless (equal (epg-context-error-output context) "") + (let ((buffer (get-buffer-create "*Error*"))) + (save-selected-window + (unless (and epa-error-buffer (buffer-live-p epa-error-buffer)) + (setq epa-error-buffer (generate-new-buffer "*Error*"))) + (if (get-buffer-window epa-error-buffer) + (delete-window (get-buffer-window epa-error-buffer))) + (with-current-buffer buffer + (let ((inhibit-read-only t) + buffer-read-only) + (erase-buffer) + (insert (format + (pcase (epg-context-operation context) + (`decrypt "Error while decrypting with \"%s\":") + (`verify "Error while verifying with \"%s\":") + (`sign "Error while signing with \"%s\":") + (`encrypt "Error while encrypting with \"%s\":") + (`import-keys "Error while importing keys with \"%s\":") + (`export-keys "Error while exporting keys with \"%s\":") + (_ "Error while executing \"%s\":\n\n")) + epg-gpg-program) + "\n\n" + (epg-context-error-output context))) + (epa-info-mode) + (goto-char (point-min))) + (display-buffer buffer))))) + (defun epa-display-verify-result (verify-result) (declare (obsolete epa-display-info "23.1")) (epa-display-info (epg-verify-result-to-string verify-result))) @@ -593,14 +641,14 @@ If SECRET is non-nil, list secret keys instead of public keys." (eq (epg-context-operation context) 'encrypt)) (read-passwd (if (eq key-id 'PIN) - "Passphrase for PIN: " + "Passphrase for PIN: " (let ((entry (assoc key-id epg-user-id-alist))) (if entry (format "Passphrase for %s %s: " key-id (cdr entry)) (format "Passphrase for %s: " key-id))))))) (defun epa-progress-callback-function (_context what _char current total - handback) + handback) (let ((prompt (or handback (format "Processing %s: " what)))) ;; According to gnupg/doc/DETAIL: a "total" of 0 indicates that @@ -641,7 +689,11 @@ If you do not specify PLAIN-FILE, this functions prompts for the value to use." (format "Decrypting %s..." (file-name-nondirectory decrypt-file)))) (message "Decrypting %s..." (file-name-nondirectory decrypt-file)) - (epg-decrypt-file context decrypt-file plain-file) + (condition-case error + (epg-decrypt-file context decrypt-file plain-file) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) (message "Decrypting %s...wrote %s" (file-name-nondirectory decrypt-file) (file-name-nondirectory plain-file)) (if (epg-context-result-for context 'verify) @@ -662,7 +714,11 @@ If you do not specify PLAIN-FILE, this functions prompts for the value to use." (format "Verifying %s..." (file-name-nondirectory file)))) (message "Verifying %s..." (file-name-nondirectory file)) - (epg-verify-file context file plain) + (condition-case error + (epg-verify-file context file plain) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) (message "Verifying %s...done" (file-name-nondirectory file)) (if (epg-context-result-for context 'verify) (epa-display-info (epg-verify-result-to-string @@ -717,9 +773,9 @@ If no one is selected, default secret key is used. " ".p7s" ".p7m")))) (context (epg-make-context epa-protocol))) - (epg-context-set-armor context epa-armor) - (epg-context-set-textmode context epa-textmode) - (epg-context-set-signers context signers) + (setf (epg-context-armor context) epa-armor) + (setf (epg-context-textmode context) epa-textmode) + (setf (epg-context-signers context) signers) (epg-context-set-passphrase-callback context #'epa-passphrase-callback-function) (epg-context-set-progress-callback context @@ -727,8 +783,13 @@ If no one is selected, default secret key is used. " #'epa-progress-callback-function (format "Signing %s..." (file-name-nondirectory file)))) + (setf (epg-context-pinentry-mode context) epa-pinentry-mode) (message "Signing %s..." (file-name-nondirectory file)) - (epg-sign-file context file signature mode) + (condition-case error + (epg-sign-file context file signature mode) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) (message "Signing %s...wrote %s" (file-name-nondirectory file) (file-name-nondirectory signature)))) @@ -744,8 +805,8 @@ If no one is selected, symmetric encryption will be performed. "))) (if epa-armor ".asc" ".gpg") ".p7m"))) (context (epg-make-context epa-protocol))) - (epg-context-set-armor context epa-armor) - (epg-context-set-textmode context epa-textmode) + (setf (epg-context-armor context) epa-armor) + (setf (epg-context-textmode context) epa-textmode) (epg-context-set-passphrase-callback context #'epa-passphrase-callback-function) (epg-context-set-progress-callback context @@ -753,8 +814,13 @@ If no one is selected, symmetric encryption will be performed. "))) #'epa-progress-callback-function (format "Encrypting %s..." (file-name-nondirectory file)))) + (setf (epg-context-pinentry-mode context) epa-pinentry-mode) (message "Encrypting %s..." (file-name-nondirectory file)) - (epg-encrypt-file context file recipients cipher) + (condition-case error + (epg-encrypt-file context file recipients cipher) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) (message "Encrypting %s...wrote %s" (file-name-nondirectory file) (file-name-nondirectory cipher)))) @@ -791,8 +857,13 @@ For example: (cons #'epa-progress-callback-function "Decrypting...")) + (setf (epg-context-pinentry-mode context) epa-pinentry-mode) (message "Decrypting...") - (setq plain (epg-decrypt-string context (buffer-substring start end))) + (condition-case error + (setq plain (epg-decrypt-string context (buffer-substring start end))) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) (message "Decrypting...done") (setq plain (epa--decode-coding-string plain @@ -810,8 +881,8 @@ For example: (insert plain)) (with-output-to-temp-buffer "*Temp*" (set-buffer standard-output) - (insert plain) - (epa-info-mode)))) + (insert plain) + (epa-info-mode)))) (if (epg-context-result-for context 'verify) (epa-display-info (epg-verify-result-to-string (epg-context-result-for context 'verify))))))) @@ -834,6 +905,7 @@ For example: Don't use this command in Lisp programs! See the reason described in the `epa-decrypt-region' documentation." + (declare (interactive-only t)) (interactive "r") (save-excursion (save-restriction @@ -873,20 +945,25 @@ For example: (decode-coding-string (epg-verify-string context (buffer-substring start end)) 'utf-8))" + (declare (interactive-only t)) (interactive "r") (let ((context (epg-make-context epa-protocol)) plain) - (epg-context-set-progress-callback context - (cons - #'epa-progress-callback-function - "Verifying...")) + (setf (epg-context-progress-callback context) + (cons + #'epa-progress-callback-function + "Verifying...")) (message "Verifying...") - (setq plain (epg-verify-string - context - (epa--encode-coding-string - (buffer-substring start end) - (or coding-system-for-write - (get-text-property start 'epa-coding-system-used))))) + (condition-case error + (setq plain (epg-verify-string + context + (epa--encode-coding-string + (buffer-substring start end) + (or coding-system-for-write + (get-text-property start 'epa-coding-system-used))))) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) (message "Verifying...done") (setq plain (epa--decode-coding-string plain @@ -914,6 +991,7 @@ between START and END. Don't use this command in Lisp programs! See the reason described in the `epa-verify-region' documentation." + (declare (interactive-only t)) (interactive "r") (save-excursion (save-restriction @@ -924,11 +1002,11 @@ See the reason described in the `epa-verify-region' documentation." nil t) (setq cleartext-start (match-beginning 0)) (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$" - nil t) + nil t) (error "Invalid cleartext signed message")) (setq cleartext-end (re-search-forward - "^-----END PGP SIGNATURE-----$" - nil t)) + "^-----END PGP SIGNATURE-----$" + nil t)) (unless cleartext-end (error "No cleartext tail")) (epa-verify-region cleartext-start cleartext-end)))))) @@ -956,6 +1034,7 @@ For example: (epg-sign-string context (encode-coding-string (buffer-substring start end) 'utf-8)))" + (declare (interactive-only t)) (interactive (let ((verbose current-prefix-arg)) (setq epa-last-coding-system-specified @@ -974,23 +1053,28 @@ If no one is selected, default secret key is used. " (save-excursion (let ((context (epg-make-context epa-protocol)) signature) - ;;(epg-context-set-armor context epa-armor) - (epg-context-set-armor context t) - ;;(epg-context-set-textmode context epa-textmode) - (epg-context-set-textmode context t) - (epg-context-set-signers context signers) + ;;(setf (epg-context-armor context) epa-armor) + (setf (epg-context-armor context) t) + ;;(setf (epg-context-textmode context) epa-textmode) + (setf (epg-context-textmode context) t) + (setf (epg-context-signers context) signers) (epg-context-set-passphrase-callback context #'epa-passphrase-callback-function) (epg-context-set-progress-callback context (cons #'epa-progress-callback-function "Signing...")) + (setf (epg-context-pinentry-mode context) epa-pinentry-mode) (message "Signing...") - (setq signature (epg-sign-string context - (epa--encode-coding-string - (buffer-substring start end) - epa-last-coding-system-specified) - mode)) + (condition-case error + (setq signature (epg-sign-string context + (epa--encode-coding-string + (buffer-substring start end) + epa-last-coding-system-specified) + mode)) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) (message "Signing...done") (delete-region start end) (goto-char start) @@ -1037,6 +1121,7 @@ For example: context (encode-coding-string (buffer-substring start end) 'utf-8) nil))" + (declare (interactive-only t)) (interactive (let ((verbose current-prefix-arg) (context (epg-make-context epa-protocol)) @@ -1056,25 +1141,30 @@ If no one is selected, symmetric encryption will be performed. ") (save-excursion (let ((context (epg-make-context epa-protocol)) cipher) - ;;(epg-context-set-armor context epa-armor) - (epg-context-set-armor context t) - ;;(epg-context-set-textmode context epa-textmode) - (epg-context-set-textmode context t) + ;;(setf (epg-context-armor context) epa-armor) + (setf (epg-context-armor context) t) + ;;(setf (epg-context-textmode context) epa-textmode) + (setf (epg-context-textmode context) t) (if sign - (epg-context-set-signers context signers)) + (setf (epg-context-signers context) signers)) (epg-context-set-passphrase-callback context #'epa-passphrase-callback-function) (epg-context-set-progress-callback context (cons #'epa-progress-callback-function "Encrypting...")) + (setf (epg-context-pinentry-mode context) epa-pinentry-mode) (message "Encrypting...") - (setq cipher (epg-encrypt-string context - (epa--encode-coding-string - (buffer-substring start end) - epa-last-coding-system-specified) - recipients - sign)) + (condition-case error + (setq cipher (epg-encrypt-string context + (epa--encode-coding-string + (buffer-substring start end) + epa-last-coding-system-specified) + recipients + sign)) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) (message "Encrypting...done") (delete-region start end) (goto-char start) @@ -1100,7 +1190,11 @@ If no one is selected, symmetric encryption will be performed. ") (eq (nth 1 epa-list-keys-arguments) t)))) (let ((context (epg-make-context epa-protocol))) (message "Deleting...") - (epg-delete-keys context keys allow-secret) + (condition-case error + (epg-delete-keys context keys allow-secret) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) (message "Deleting...done") (apply #'epa--list-keys epa-list-keys-arguments))) @@ -1116,6 +1210,7 @@ If no one is selected, symmetric encryption will be performed. ") (epg-import-keys-from-file context file) (message "Importing %s...done" (file-name-nondirectory file))) (error + (epa-display-error context) (message "Importing %s...failed" (file-name-nondirectory file)))) (if (epg-context-result-for context 'import) (epa-display-info (epg-import-result-to-string @@ -1135,6 +1230,7 @@ If no one is selected, symmetric encryption will be performed. ") (epg-import-keys-from-string context (buffer-substring start end)) (message "Importing...done")) (error + (epa-display-error context) (message "Importing...failed"))) (if (epg-context-result-for context 'import) (epa-display-info (epg-import-result-to-string @@ -1183,9 +1279,13 @@ between START and END." (file-name-directory default-name) default-name))))) (let ((context (epg-make-context epa-protocol))) - (epg-context-set-armor context epa-armor) + (setf (epg-context-armor context) epa-armor) (message "Exporting to %s..." (file-name-nondirectory file)) - (epg-export-keys-to-file context keys file) + (condition-case error + (epg-export-keys-to-file context keys file) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) (message "Exporting to %s...done" (file-name-nondirectory file)))) ;;;###autoload @@ -1193,18 +1293,23 @@ between START and END." "Insert selected KEYS after the point." (interactive (list (epa-select-keys (epg-make-context epa-protocol) - "Select keys to export. + "Select keys to export. If no one is selected, default public key is exported. "))) (let ((context (epg-make-context epa-protocol))) - ;;(epg-context-set-armor context epa-armor) - (epg-context-set-armor context t) - (insert (epg-export-keys-to-string context keys)))) + ;;(setf (epg-context-armor context) epa-armor) + (setf (epg-context-armor context) t) + (condition-case error + (insert (epg-export-keys-to-string context keys)) + (error + (epa-display-error context) + (signal (car error) (cdr error)))))) ;; (defun epa-sign-keys (keys &optional local) ;; "Sign selected KEYS. ;; If a prefix-arg is specified, the signature is marked as non exportable. ;; Don't use this command in Lisp programs!" +;; (declare (interactive-only t)) ;; (interactive ;; (let ((keys (epa--marked-keys))) ;; (unless keys @@ -1212,11 +1317,12 @@ If no one is selected, default public key is exported. "))) ;; (list keys current-prefix-arg))) ;; (let ((context (epg-make-context epa-protocol))) ;; (epg-context-set-passphrase-callback context -;; #'epa-passphrase-callback-function) +;; #'epa-passphrase-callback-function) ;; (epg-context-set-progress-callback context -;; (cons -;; #'epa-progress-callback-function -;; "Signing keys...")) +;; (cons +;; #'epa-progress-callback-function +;; "Signing keys...")) +;; (setf (epg-context-pinentry-mode context) epa-pinentry-mode) ;; (message "Signing keys...") ;; (epg-sign-keys context keys local) ;; (message "Signing keys...done"))) diff --git a/lisp/epg.el b/lisp/epg.el index 594e41423a8..f66545306da 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -23,6 +23,7 @@ ;;; Code: (require 'epg-config) +(eval-when-compile (require 'cl-lib)) (defvar epg-user-id nil "GnuPG ID of your default identity.") @@ -39,6 +40,7 @@ (defvar epg-debug-buffer nil) (defvar epg-agent-file nil) (defvar epg-agent-mtime nil) +(defvar epg-error-output nil) ;; from gnupg/include/cipher.h (defconst epg-cipher-algorithm-alist @@ -164,210 +166,75 @@ (define-error 'epg-error "GPG error") -(defun epg-make-data-from-file (file) - "Make a data object from FILE." - (cons 'epg-data (vector file nil))) - -(defun epg-make-data-from-string (string) - "Make a data object from STRING." - (cons 'epg-data (vector nil string))) - -(defun epg-data-file (data) - "Return the file of DATA." - (unless (eq (car-safe data) 'epg-data) - (signal 'wrong-type-argument (list 'epg-data-p data))) - (aref (cdr data) 0)) - -(defun epg-data-string (data) - "Return the string of DATA." - (unless (eq (car-safe data) 'epg-data) - (signal 'wrong-type-argument (list 'epg-data-p data))) - (aref (cdr data) 1)) - +(cl-defstruct (epg-data + (:constructor nil) + (:constructor epg-make-data-from-file (file)) + (:constructor epg-make-data-from-string (string)) + (:copier nil) + (:predicate nil)) + (file nil :read-only t) + (string nil :read-only t)) + +(defmacro epg--gv-nreverse (place) + (gv-letplace (getter setter) place + (funcall setter `(nreverse ,getter)))) + +(cl-defstruct (epg-context + (:constructor nil) + (:constructor epg-context--make + (protocol &optional armor textmode include-certs + cipher-algorithm digest-algorithm + compress-algorithm + &aux + (program + (pcase protocol + (`OpenPGP epg-gpg-program) + (`CMS epg-gpgsm-program) + (_ (signal 'epg-error + (list "unknown protocol" protocol))))))) + (:copier nil) + (:predicate nil)) + protocol + program + (home-directory epg-gpg-home-directory) + armor + textmode + include-certs + cipher-algorithm + digest-algorithm + compress-algorithm + (passphrase-callback (list #'epg-passphrase-callback-function)) + progress-callback + edit-callback + signers + sig-notations + process + output-file + result + operation + pinentry-mode + (error-output "")) + +;; This is not an alias, just so we can mark it as autoloaded. ;;;###autoload (defun epg-make-context (&optional protocol armor textmode include-certs cipher-algorithm digest-algorithm compress-algorithm) "Return a context object." - (unless protocol - (setq protocol 'OpenPGP)) - (unless (memq protocol '(OpenPGP CMS)) - (signal 'epg-error (list "unknown protocol" protocol))) - (cons 'epg-context - (vector protocol - (if (eq protocol 'OpenPGP) - epg-gpg-program - epg-gpgsm-program) - epg-gpg-home-directory - armor textmode include-certs - cipher-algorithm digest-algorithm compress-algorithm - (list #'epg-passphrase-callback-function) - nil - nil nil nil nil nil nil nil))) - -(defun epg-context-protocol (context) - "Return the protocol used within CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 0)) - -(defun epg-context-program (context) - "Return the gpg or gpgsm executable used within CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 1)) - -(defun epg-context-home-directory (context) - "Return the GnuPG home directory used in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 2)) - -(defun epg-context-armor (context) - "Return t if the output should be ASCII armored in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 3)) - -(defun epg-context-textmode (context) - "Return t if canonical text mode should be used in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 4)) - -(defun epg-context-include-certs (context) - "Return how many certificates should be included in an S/MIME signed message." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 5)) - -(defun epg-context-cipher-algorithm (context) - "Return the cipher algorithm in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 6)) - -(defun epg-context-digest-algorithm (context) - "Return the digest algorithm in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 7)) - -(defun epg-context-compress-algorithm (context) - "Return the compress algorithm in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 8)) - -(defun epg-context-passphrase-callback (context) - "Return the function used to query passphrase." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 9)) - -(defun epg-context-progress-callback (context) - "Return the function which handles progress update." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 10)) - -(defun epg-context-signers (context) - "Return the list of key-id for signing." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 11)) - -(defun epg-context-sig-notations (context) - "Return the list of notations for signing." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 12)) - -(defun epg-context-process (context) - "Return the process object of `epg-gpg-program'. -This function is for internal use only." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 13)) - -(defun epg-context-output-file (context) - "Return the output file of `epg-gpg-program'. -This function is for internal use only." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 14)) - -(defun epg-context-result (context) - "Return the result of the previous cryptographic operation." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 15)) - -(defun epg-context-operation (context) - "Return the name of the current cryptographic operation." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 16)) - -(defun epg-context-pinentry-mode (context) - "Return the mode of pinentry invocation." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 17)) - -(defun epg-context-set-protocol (context protocol) - "Set the protocol used within CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 0 protocol)) - -(defun epg-context-set-program (context protocol) - "Set the gpg or gpgsm executable used within CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 1 protocol)) - -(defun epg-context-set-home-directory (context directory) - "Set the GnuPG home directory." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 2 directory)) + (epg-context--make (or protocol 'OpenPGP) + armor textmode include-certs + cipher-algorithm digest-algorithm + compress-algorithm)) (defun epg-context-set-armor (context armor) "Specify if the output should be ASCII armored in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 3 armor)) + (declare (obsolete setf "25.1")) + (setf (epg-context-armor context) armor)) (defun epg-context-set-textmode (context textmode) "Specify if canonical text mode should be used in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 4 textmode)) - -(defun epg-context-set-include-certs (context include-certs) - "Set how many certificates should be included in an S/MIME signed message." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 5 include-certs)) - -(defun epg-context-set-cipher-algorithm (context cipher-algorithm) - "Set the cipher algorithm in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 6 cipher-algorithm)) - -(defun epg-context-set-digest-algorithm (context digest-algorithm) - "Set the digest algorithm in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 7 digest-algorithm)) - -(defun epg-context-set-compress-algorithm (context compress-algorithm) - "Set the compress algorithm in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 8 compress-algorithm)) + (declare (obsolete setf "25.1")) + (setf (epg-context-textmode context) textmode)) (defun epg-context-set-passphrase-callback (context passphrase-callback) @@ -384,11 +251,11 @@ on the external program called `gpg-agent' for passphrase query. If you really want to intercept passphrase query, consider installing GnuPG 1.x _along with_ GnuPG 2.x, which does passphrase query by itself and Emacs can intercept them." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 9 (if (consp passphrase-callback) - passphrase-callback - (list passphrase-callback)))) + ;; (declare (obsolete setf "25.1")) + (setf (epg-context-passphrase-callback context) + (if (functionp passphrase-callback) + (list passphrase-callback) + passphrase-callback))) (defun epg-context-set-progress-callback (context progress-callback) @@ -401,607 +268,119 @@ The function gets six arguments: the context, the operation description, the character to display a progress unit, the current amount done, the total amount to be done, and the callback data (if any)." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 10 (if (consp progress-callback) - progress-callback - (list progress-callback)))) + (setf (epg-context-progress-callback context) + (if (functionp progress-callback) + (list progress-callback) + progress-callback))) (defun epg-context-set-signers (context signers) "Set the list of key-id for signing." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 11 signers)) - -(defun epg-context-set-sig-notations (context notations) - "Set the list of notations for signing." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 12 notations)) - -(defun epg-context-set-process (context process) - "Set the process object of `epg-gpg-program'. -This function is for internal use only." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 13 process)) - -(defun epg-context-set-output-file (context output-file) - "Set the output file of `epg-gpg-program'. -This function is for internal use only." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 14 output-file)) - -(defun epg-context-set-result (context result) - "Set the result of the previous cryptographic operation." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 15 result)) - -(defun epg-context-set-operation (context operation) - "Set the name of the current cryptographic operation." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 16 operation)) - -(defun epg-context-set-pinentry-mode (context mode) - "Set the mode of pinentry invocation." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (unless (memq mode '(nil ask cancel error loopback)) - (signal 'epg-error (list "Unknown pinentry mode" mode))) - (aset (cdr context) 17 mode)) - -(defun epg-make-signature (status &optional key-id) - "Return a signature object." - (cons 'epg-signature (vector status key-id nil nil nil nil nil nil nil nil - nil))) - -(defun epg-signature-status (signature) - "Return the status code of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 0)) - -(defun epg-signature-key-id (signature) - "Return the key-id of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 1)) - -(defun epg-signature-validity (signature) - "Return the validity of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 2)) - -(defun epg-signature-fingerprint (signature) - "Return the fingerprint of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 3)) - -(defun epg-signature-creation-time (signature) - "Return the creation time of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 4)) - -(defun epg-signature-expiration-time (signature) - "Return the expiration time of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 5)) - -(defun epg-signature-pubkey-algorithm (signature) - "Return the public key algorithm of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 6)) - -(defun epg-signature-digest-algorithm (signature) - "Return the digest algorithm of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 7)) - -(defun epg-signature-class (signature) - "Return the class of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 8)) - -(defun epg-signature-version (signature) - "Return the version of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 9)) - -(defun epg-sig-notations (signature) - "Return the list of notations of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 10)) - -(defun epg-signature-set-status (signature status) - "Set the status code of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 0 status)) - -(defun epg-signature-set-key-id (signature key-id) - "Set the key-id of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 1 key-id)) - -(defun epg-signature-set-validity (signature validity) - "Set the validity of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 2 validity)) - -(defun epg-signature-set-fingerprint (signature fingerprint) - "Set the fingerprint of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 3 fingerprint)) - -(defun epg-signature-set-creation-time (signature creation-time) - "Set the creation time of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 4 creation-time)) - -(defun epg-signature-set-expiration-time (signature expiration-time) - "Set the expiration time of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 5 expiration-time)) - -(defun epg-signature-set-pubkey-algorithm (signature pubkey-algorithm) - "Set the public key algorithm of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 6 pubkey-algorithm)) - -(defun epg-signature-set-digest-algorithm (signature digest-algorithm) - "Set the digest algorithm of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 7 digest-algorithm)) - -(defun epg-signature-set-class (signature class) - "Set the class of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 8 class)) - -(defun epg-signature-set-version (signature version) - "Set the version of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 9 version)) - -(defun epg-signature-set-notations (signature notations) - "Set the list of notations of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 10 notations)) - -(defun epg-make-new-signature (type pubkey-algorithm digest-algorithm - class creation-time fingerprint) - "Return a new signature object." - (cons 'epg-new-signature (vector type pubkey-algorithm digest-algorithm - class creation-time fingerprint))) - -(defun epg-new-signature-type (new-signature) - "Return the type of NEW-SIGNATURE." - (unless (eq (car-safe new-signature) 'epg-new-signature) - (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) - (aref (cdr new-signature) 0)) - -(defun epg-new-signature-pubkey-algorithm (new-signature) - "Return the public key algorithm of NEW-SIGNATURE." - (unless (eq (car-safe new-signature) 'epg-new-signature) - (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) - (aref (cdr new-signature) 1)) - -(defun epg-new-signature-digest-algorithm (new-signature) - "Return the digest algorithm of NEW-SIGNATURE." - (unless (eq (car-safe new-signature) 'epg-new-signature) - (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) - (aref (cdr new-signature) 2)) - -(defun epg-new-signature-class (new-signature) - "Return the class of NEW-SIGNATURE." - (unless (eq (car-safe new-signature) 'epg-new-signature) - (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) - (aref (cdr new-signature) 3)) - -(defun epg-new-signature-creation-time (new-signature) - "Return the creation time of NEW-SIGNATURE." - (unless (eq (car-safe new-signature) 'epg-new-signature) - (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) - (aref (cdr new-signature) 4)) - -(defun epg-new-signature-fingerprint (new-signature) - "Return the fingerprint of NEW-SIGNATURE." - (unless (eq (car-safe new-signature) 'epg-new-signature) - (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) - (aref (cdr new-signature) 5)) - -(defun epg-make-key (owner-trust) - "Return a key object." - (cons 'epg-key (vector owner-trust nil nil))) - -(defun epg-key-owner-trust (key) - "Return the owner trust of KEY." - (unless (eq (car-safe key) 'epg-key) - (signal 'wrong-type-argument (list 'epg-key-p key))) - (aref (cdr key) 0)) - -(defun epg-key-sub-key-list (key) - "Return the sub key list of KEY." - (unless (eq (car-safe key) 'epg-key) - (signal 'wrong-type-argument (list 'epg-key-p key))) - (aref (cdr key) 1)) - -(defun epg-key-user-id-list (key) - "Return the user ID list of KEY." - (unless (eq (car-safe key) 'epg-key) - (signal 'wrong-type-argument (list 'epg-key-p key))) - (aref (cdr key) 2)) - -(defun epg-key-set-sub-key-list (key sub-key-list) - "Set the sub key list of KEY." - (unless (eq (car-safe key) 'epg-key) - (signal 'wrong-type-argument (list 'epg-key-p key))) - (aset (cdr key) 1 sub-key-list)) - -(defun epg-key-set-user-id-list (key user-id-list) - "Set the user ID list of KEY." - (unless (eq (car-safe key) 'epg-key) - (signal 'wrong-type-argument (list 'epg-key-p key))) - (aset (cdr key) 2 user-id-list)) - -(defun epg-make-sub-key (validity capability secret-p algorithm length id - creation-time expiration-time) - "Return a sub key object." - (cons 'epg-sub-key - (vector validity capability secret-p algorithm length id creation-time - expiration-time nil))) - -(defun epg-sub-key-validity (sub-key) - "Return the validity of SUB-KEY." - (unless (eq (car-safe sub-key) 'epg-sub-key) - (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) - (aref (cdr sub-key) 0)) - -(defun epg-sub-key-capability (sub-key) - "Return the capability of SUB-KEY." - (unless (eq (car-safe sub-key) 'epg-sub-key) - (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) - (aref (cdr sub-key) 1)) - -(defun epg-sub-key-secret-p (sub-key) - "Return non-nil if SUB-KEY is a secret key." - (unless (eq (car-safe sub-key) 'epg-sub-key) - (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) - (aref (cdr sub-key) 2)) - -(defun epg-sub-key-algorithm (sub-key) - "Return the algorithm of SUB-KEY." - (unless (eq (car-safe sub-key) 'epg-sub-key) - (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) - (aref (cdr sub-key) 3)) - -(defun epg-sub-key-length (sub-key) - "Return the length of SUB-KEY." - (unless (eq (car-safe sub-key) 'epg-sub-key) - (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) - (aref (cdr sub-key) 4)) - -(defun epg-sub-key-id (sub-key) - "Return the ID of SUB-KEY." - (unless (eq (car-safe sub-key) 'epg-sub-key) - (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) - (aref (cdr sub-key) 5)) - -(defun epg-sub-key-creation-time (sub-key) - "Return the creation time of SUB-KEY." - (unless (eq (car-safe sub-key) 'epg-sub-key) - (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) - (aref (cdr sub-key) 6)) - -(defun epg-sub-key-expiration-time (sub-key) - "Return the expiration time of SUB-KEY." - (unless (eq (car-safe sub-key) 'epg-sub-key) - (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) - (aref (cdr sub-key) 7)) - -(defun epg-sub-key-fingerprint (sub-key) - "Return the fingerprint of SUB-KEY." - (unless (eq (car-safe sub-key) 'epg-sub-key) - (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) - (aref (cdr sub-key) 8)) - -(defun epg-sub-key-set-fingerprint (sub-key fingerprint) - "Set the fingerprint of SUB-KEY. -This function is for internal use only." - (unless (eq (car-safe sub-key) 'epg-sub-key) - (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) - (aset (cdr sub-key) 8 fingerprint)) - -(defun epg-make-user-id (validity string) - "Return a user ID object." - (cons 'epg-user-id (vector validity string nil))) - -(defun epg-user-id-validity (user-id) - "Return the validity of USER-ID." - (unless (eq (car-safe user-id) 'epg-user-id) - (signal 'wrong-type-argument (list 'epg-user-id-p user-id))) - (aref (cdr user-id) 0)) - -(defun epg-user-id-string (user-id) - "Return the name of USER-ID." - (unless (eq (car-safe user-id) 'epg-user-id) - (signal 'wrong-type-argument (list 'epg-user-id-p user-id))) - (aref (cdr user-id) 1)) - -(defun epg-user-id-signature-list (user-id) - "Return the signature list of USER-ID." - (unless (eq (car-safe user-id) 'epg-user-id) - (signal 'wrong-type-argument (list 'epg-user-id-p user-id))) - (aref (cdr user-id) 2)) - -(defun epg-user-id-set-signature-list (user-id signature-list) - "Set the signature list of USER-ID." - (unless (eq (car-safe user-id) 'epg-user-id) - (signal 'wrong-type-argument (list 'epg-user-id-p user-id))) - (aset (cdr user-id) 2 signature-list)) - -(defun epg-make-key-signature (validity pubkey-algorithm key-id creation-time - expiration-time user-id class - exportable-p) - "Return a key signature object." - (cons 'epg-key-signature - (vector validity pubkey-algorithm key-id creation-time expiration-time - user-id class exportable-p))) - -(defun epg-key-signature-validity (key-signature) - "Return the validity of KEY-SIGNATURE." - (unless (eq (car-safe key-signature) 'epg-key-signature) - (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) - (aref (cdr key-signature) 0)) - -(defun epg-key-signature-pubkey-algorithm (key-signature) - "Return the public key algorithm of KEY-SIGNATURE." - (unless (eq (car-safe key-signature) 'epg-key-signature) - (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) - (aref (cdr key-signature) 1)) - -(defun epg-key-signature-key-id (key-signature) - "Return the key-id of KEY-SIGNATURE." - (unless (eq (car-safe key-signature) 'epg-key-signature) - (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) - (aref (cdr key-signature) 2)) - -(defun epg-key-signature-creation-time (key-signature) - "Return the creation time of KEY-SIGNATURE." - (unless (eq (car-safe key-signature) 'epg-key-signature) - (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) - (aref (cdr key-signature) 3)) - -(defun epg-key-signature-expiration-time (key-signature) - "Return the expiration time of KEY-SIGNATURE." - (unless (eq (car-safe key-signature) 'epg-key-signature) - (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) - (aref (cdr key-signature) 4)) - -(defun epg-key-signature-user-id (key-signature) - "Return the user-id of KEY-SIGNATURE." - (unless (eq (car-safe key-signature) 'epg-key-signature) - (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) - (aref (cdr key-signature) 5)) - -(defun epg-key-signature-class (key-signature) - "Return the class of KEY-SIGNATURE." - (unless (eq (car-safe key-signature) 'epg-key-signature) - (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) - (aref (cdr key-signature) 6)) - -(defun epg-key-signature-exportable-p (key-signature) - "Return t if KEY-SIGNATURE is exportable." - (unless (eq (car-safe key-signature) 'epg-key-signature) - (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) - (aref (cdr key-signature) 7)) - -(defun epg-make-sig-notation (name value &optional human-readable - critical) - "Return a notation object." - (cons 'epg-sig-notation (vector name value human-readable critical))) - -(defun epg-sig-notation-name (sig-notation) - "Return the name of SIG-NOTATION." - (unless (eq (car-safe sig-notation) 'epg-sig-notation) - (signal 'wrong-type-argument (list 'epg-sig-notation-p - sig-notation))) - (aref (cdr sig-notation) 0)) - -(defun epg-sig-notation-value (sig-notation) - "Return the value of SIG-NOTATION." - (unless (eq (car-safe sig-notation) 'epg-sig-notation) - (signal 'wrong-type-argument (list 'epg-sig-notation-p - sig-notation))) - (aref (cdr sig-notation) 1)) - -(defun epg-sig-notation-human-readable (sig-notation) - "Return the human-readable of SIG-NOTATION." - (unless (eq (car-safe sig-notation) 'epg-sig-notation) - (signal 'wrong-type-argument (list 'epg-sig-notation-p - sig-notation))) - (aref (cdr sig-notation) 2)) - -(defun epg-sig-notation-critical (sig-notation) - "Return the critical of SIG-NOTATION." - (unless (eq (car-safe sig-notation) 'epg-sig-notation) - (signal 'wrong-type-argument (list 'epg-sig-notation-p - sig-notation))) - (aref (cdr sig-notation) 3)) - -(defun epg-sig-notation-set-value (sig-notation value) - "Set the value of SIG-NOTATION." - (unless (eq (car-safe sig-notation) 'epg-sig-notation) - (signal 'wrong-type-argument (list 'epg-sig-notation-p - sig-notation))) - (aset (cdr sig-notation) 1 value)) - -(defun epg-make-import-status (fingerprint &optional reason new user-id - signature sub-key secret) - "Return an import status object." - (cons 'epg-import-status (vector fingerprint reason new user-id signature - sub-key secret))) - -(defun epg-import-status-fingerprint (import-status) - "Return the fingerprint of the key that was considered." - (unless (eq (car-safe import-status) 'epg-import-status) - (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) - (aref (cdr import-status) 0)) - -(defun epg-import-status-reason (import-status) - "Return the reason code for import failure." - (unless (eq (car-safe import-status) 'epg-import-status) - (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) - (aref (cdr import-status) 1)) - -(defun epg-import-status-new (import-status) - "Return t if the imported key was new." - (unless (eq (car-safe import-status) 'epg-import-status) - (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) - (aref (cdr import-status) 2)) - -(defun epg-import-status-user-id (import-status) - "Return t if the imported key contained new user IDs." - (unless (eq (car-safe import-status) 'epg-import-status) - (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) - (aref (cdr import-status) 3)) - -(defun epg-import-status-signature (import-status) - "Return t if the imported key contained new signatures." - (unless (eq (car-safe import-status) 'epg-import-status) - (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) - (aref (cdr import-status) 4)) - -(defun epg-import-status-sub-key (import-status) - "Return t if the imported key contained new sub keys." - (unless (eq (car-safe import-status) 'epg-import-status) - (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) - (aref (cdr import-status) 5)) - -(defun epg-import-status-secret (import-status) - "Return t if the imported key contained a secret key." - (unless (eq (car-safe import-status) 'epg-import-status) - (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) - (aref (cdr import-status) 6)) - -(defun epg-make-import-result (considered no-user-id imported imported-rsa - unchanged new-user-ids new-sub-keys - new-signatures new-revocations - secret-read secret-imported - secret-unchanged not-imported - imports) - "Return an import result object." - (cons 'epg-import-result (vector considered no-user-id imported imported-rsa - unchanged new-user-ids new-sub-keys - new-signatures new-revocations secret-read - secret-imported secret-unchanged - not-imported imports))) - -(defun epg-import-result-considered (import-result) - "Return the total number of considered keys." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 0)) - -(defun epg-import-result-no-user-id (import-result) - "Return the number of keys without user ID." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 1)) - -(defun epg-import-result-imported (import-result) - "Return the number of imported keys." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 2)) - -(defun epg-import-result-imported-rsa (import-result) - "Return the number of imported RSA keys." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 3)) - -(defun epg-import-result-unchanged (import-result) - "Return the number of unchanged keys." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 4)) - -(defun epg-import-result-new-user-ids (import-result) - "Return the number of new user IDs." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 5)) - -(defun epg-import-result-new-sub-keys (import-result) - "Return the number of new sub keys." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 6)) - -(defun epg-import-result-new-signatures (import-result) - "Return the number of new signatures." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 7)) - -(defun epg-import-result-new-revocations (import-result) - "Return the number of new revocations." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 8)) - -(defun epg-import-result-secret-read (import-result) - "Return the total number of secret keys read." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 9)) - -(defun epg-import-result-secret-imported (import-result) - "Return the number of imported secret keys." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 10)) - -(defun epg-import-result-secret-unchanged (import-result) - "Return the number of unchanged secret keys." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 11)) - -(defun epg-import-result-not-imported (import-result) - "Return the number of keys not imported." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 12)) - -(defun epg-import-result-imports (import-result) - "Return the list of `epg-import-status' objects." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 13)) + (declare (obsolete setf "25.1")) + (setf (epg-context-signers context) signers)) + +(cl-defstruct (epg-signature + (:constructor nil) + (:constructor epg-make-signature + (status &optional key-id)) + (:copier nil) + (:predicate nil)) + status + key-id + validity + fingerprint + creation-time + expiration-time + pubkey-algorithm + digest-algorithm + class + version + notations) + +(cl-defstruct (epg-new-signature + (:constructor nil) + (:constructor epg-make-new-signature + (type pubkey-algorithm digest-algorithm + class creation-time fingerprint)) + (:copier nil) + (:predicate nil)) + (type nil :read-only t) + (pubkey-algorithm nil :read-only t) + (digest-algorithm nil :read-only t) + (class nil :read-only t) + (creation-time nil :read-only t) + (fingerprint nil :read-only t)) + +(cl-defstruct (epg-key + (:constructor nil) + (:constructor epg-make-key (owner-trust)) + (:copier nil) + (:predicate nil)) + (owner-trust nil :read-only t) + sub-key-list user-id-list) + +(cl-defstruct (epg-sub-key + (:constructor nil) + (:constructor epg-make-sub-key + (validity capability secret-p algorithm length id + creation-time expiration-time)) + (:copier nil) + (:predicate nil)) + validity capability secret-p algorithm length id + creation-time expiration-time fingerprint) + +(cl-defstruct (epg-user-id + (:constructor nil) + (:constructor epg-make-user-id (validity string)) + (:copier nil) + (:predicate nil)) + validity string signature-list) + +(cl-defstruct (epg-key-signature + (:constructor nil) + (:constructor epg-make-key-signature + (validity pubkey-algorithm key-id creation-time + expiration-time user-id class + exportable-p)) + (:copier nil) + (:predicate nil)) + validity pubkey-algorithm key-id creation-time + expiration-time user-id class + exportable-p) + +(cl-defstruct (epg-sig-notation + (:constructor nil) + (:constructor epg-make-sig-notation + (name value &optional human-readable critical)) + (:copier nil) + (:predicate nil)) + name value human-readable critical) + +(cl-defstruct (epg-import-status + (:constructor nil) + (:constructor epg-make-import-status + (fingerprint + &optional reason new user-id signature sub-key secret)) + (:copier nil) + (:predicate nil)) + fingerprint reason new user-id signature sub-key secret) + +(cl-defstruct (epg-import-result + (:constructor nil) + (:constructor epg-make-import-result + (considered no-user-id imported imported-rsa + unchanged new-user-ids new-sub-keys + new-signatures new-revocations + secret-read secret-imported + secret-unchanged not-imported + imports)) + (:copier nil) + (:predicate nil)) + considered no-user-id imported imported-rsa + unchanged new-user-ids new-sub-keys + new-signatures new-revocations + secret-read secret-imported + secret-unchanged not-imported + imports) (defun epg-context-result-for (context name) "Return the result of CONTEXT associated with NAME." @@ -1013,7 +392,7 @@ This function is for internal use only." (entry (assq name result))) (if entry (setcdr entry value) - (epg-context-set-result context (cons (cons name value) result))))) + (setf (epg-context-result context) (cons (cons name value) result))))) (defun epg-signature-to-string (signature) "Convert SIGNATURE to a human readable string." @@ -1206,7 +585,6 @@ This function is for internal use only." (coding-system-for-read 'binary) process-connection-type (process-environment process-environment) - (orig-mode (default-file-modes)) (buffer (generate-new-buffer " *epg*")) process terminal-name @@ -1264,17 +642,14 @@ This function is for internal use only." (make-local-variable 'epg-agent-file) (setq epg-agent-file agent-file) (make-local-variable 'epg-agent-mtime) - (setq epg-agent-mtime agent-mtime)) - (unwind-protect - (progn - (set-default-file-modes 448) - (setq process - (apply #'start-process "epg" buffer - (epg-context-program context) - args))) - (set-default-file-modes orig-mode)) + (setq epg-agent-mtime agent-mtime) + (make-local-variable 'epg-error-output) + (setq epg-error-output nil)) + (with-file-modes 448 + (setq process (apply #'start-process "epg" buffer + (epg-context-program context) args))) (set-process-filter process #'epg--process-filter) - (epg-context-set-process context process))) + (setf (epg-context-process context) process))) (defun epg--process-filter (process input) (if epg-debug @@ -1294,16 +669,35 @@ This function is for internal use only." (beginning-of-line) (while (looking-at ".*\n") ;the input line finished (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\) ?\\(.*\\)") - (let* ((status (match-string 1)) - (string (match-string 2)) - (symbol (intern-soft (concat "epg--status-" - status)))) + (let ((status (match-string 1)) + (string (match-string 2)) + symbol) (if (member status epg-pending-status-list) (setq epg-pending-status-list nil)) - (if (and symbol - (fboundp symbol)) - (funcall symbol epg-context string)) - (setq epg-last-status (cons status string)))) + ;; When editing a key, delegate all interaction + ;; to edit-callback. + (if (eq (epg-context-operation epg-context) 'edit-key) + (funcall (car (epg-context-edit-callback + epg-context)) + epg-context + status + string + (cdr (epg-context-edit-callback + epg-context))) + ;; Otherwise call epg--status-STATUS function. + (setq symbol (intern-soft (concat "epg--status-" + status))) + (if (and symbol + (fboundp symbol)) + (funcall symbol epg-context string))) + (setq epg-last-status (cons status string))) + ;; Record other lines sent to stderr. This assumes + ;; that the process-filter receives output only from + ;; stderr and the FD specified with --status-fd. + (setq epg-error-output + (cons (buffer-substring (point) + (line-end-position)) + epg-error-output))) (forward-line) (setq epg-read-point (point))))))))) @@ -1345,14 +739,18 @@ This function is for internal use only." (redraw-frame)) (epg-context-set-result-for context 'error - (nreverse (epg-context-result-for context 'error)))) + (nreverse (epg-context-result-for context 'error))) + (with-current-buffer (process-buffer (epg-context-process context)) + (setf (epg-context-error-output context) + (mapconcat #'identity (nreverse epg-error-output) "\n")))) (defun epg-reset (context) "Reset the CONTEXT." (if (and (epg-context-process context) (buffer-live-p (process-buffer (epg-context-process context)))) (kill-buffer (process-buffer (epg-context-process context)))) - (epg-context-set-process context nil)) + (setf (epg-context-process context) nil) + (setf (epg-context-edit-callback context) nil)) (defun epg-delete-output-file (context) "Delete the output file of CONTEXT." @@ -1546,7 +944,7 @@ This function is for internal use only." (if (and signature (eq (epg-signature-status signature) 'error) (equal (epg-signature-key-id signature) string)) - (epg-signature-set-status signature 'no-pubkey))) + (setf (epg-signature-status signature) 'no-pubkey))) (epg-context-set-result-for context 'error (cons (cons 'no-pubkey string) @@ -1573,21 +971,16 @@ This function is for internal use only." 'verify (cons signature (epg-context-result-for context 'verify))) - (epg-signature-set-key-id - signature - (match-string 1 string)) - (epg-signature-set-pubkey-algorithm - signature - (string-to-number (match-string 2 string))) - (epg-signature-set-digest-algorithm - signature - (string-to-number (match-string 3 string))) - (epg-signature-set-class - signature - (string-to-number (match-string 4 string) 16)) - (epg-signature-set-creation-time - signature - (epg--time-from-seconds (match-string 5 string)))))) + (setf (epg-signature-key-id signature) + (match-string 1 string)) + (setf (epg-signature-pubkey-algorithm signature) + (string-to-number (match-string 2 string))) + (setf (epg-signature-digest-algorithm signature) + (string-to-number (match-string 3 string))) + (setf (epg-signature-class signature) + (string-to-number (match-string 4 string) 16)) + (setf (epg-signature-creation-time signature) + (epg--time-from-seconds (match-string 5 string)))))) (defun epg--status-VALIDSIG (context string) (let ((signature (car (epg-context-result-for context 'verify)))) @@ -1597,81 +990,70 @@ This function is for internal use only." \\([0-9]+\\) [^ ]+ \\([0-9]+\\) \\([0-9]+\\) \\([0-9A-Fa-f][0-9A-Fa-f]\\) \ \\(.*\\)" string)) - (epg-signature-set-fingerprint - signature - (match-string 1 string)) - (epg-signature-set-creation-time - signature - (epg--time-from-seconds (match-string 2 string))) + (setf (epg-signature-fingerprint signature) + (match-string 1 string)) + (setf (epg-signature-creation-time signature) + (epg--time-from-seconds (match-string 2 string))) (unless (equal (match-string 3 string) "0") - (epg-signature-set-expiration-time - signature - (epg--time-from-seconds (match-string 3 string)))) - (epg-signature-set-version - signature - (string-to-number (match-string 4 string))) - (epg-signature-set-pubkey-algorithm - signature - (string-to-number (match-string 5 string))) - (epg-signature-set-digest-algorithm - signature - (string-to-number (match-string 6 string))) - (epg-signature-set-class - signature - (string-to-number (match-string 7 string) 16))))) + (setf (epg-signature-expiration-time signature) + (epg--time-from-seconds (match-string 3 string)))) + (setf (epg-signature-version signature) + (string-to-number (match-string 4 string))) + (setf (epg-signature-pubkey-algorithm signature) + (string-to-number (match-string 5 string))) + (setf (epg-signature-digest-algorithm signature) + (string-to-number (match-string 6 string))) + (setf (epg-signature-class signature) + (string-to-number (match-string 7 string) 16))))) (defun epg--status-TRUST_UNDEFINED (context _string) (let ((signature (car (epg-context-result-for context 'verify)))) (if (and signature (eq (epg-signature-status signature) 'good)) - (epg-signature-set-validity signature 'undefined)))) + (setf (epg-signature-validity signature) 'undefined)))) (defun epg--status-TRUST_NEVER (context _string) (let ((signature (car (epg-context-result-for context 'verify)))) (if (and signature (eq (epg-signature-status signature) 'good)) - (epg-signature-set-validity signature 'never)))) + (setf (epg-signature-validity signature) 'never)))) (defun epg--status-TRUST_MARGINAL (context _string) (let ((signature (car (epg-context-result-for context 'verify)))) (if (and signature (eq (epg-signature-status signature) 'marginal)) - (epg-signature-set-validity signature 'marginal)))) + (setf (epg-signature-validity signature) 'marginal)))) (defun epg--status-TRUST_FULLY (context _string) (let ((signature (car (epg-context-result-for context 'verify)))) (if (and signature (eq (epg-signature-status signature) 'good)) - (epg-signature-set-validity signature 'full)))) + (setf (epg-signature-validity signature) 'full)))) (defun epg--status-TRUST_ULTIMATE (context _string) (let ((signature (car (epg-context-result-for context 'verify)))) (if (and signature (eq (epg-signature-status signature) 'good)) - (epg-signature-set-validity signature 'ultimate)))) + (setf (epg-signature-validity signature) 'ultimate)))) (defun epg--status-NOTATION_NAME (context string) (let ((signature (car (epg-context-result-for context 'verify)))) (if signature - (epg-signature-set-notations - signature - (cons (epg-make-sig-notation string nil t nil) - (epg-sig-notations signature)))))) + (push (epg-make-sig-notation string nil t nil) + (epg-signature-notations signature))))) (defun epg--status-NOTATION_DATA (context string) (let ((signature (car (epg-context-result-for context 'verify))) notation) (if (and signature - (setq notation (car (epg-sig-notations signature)))) - (epg-sig-notation-set-value notation string)))) + (setq notation (car (epg-signature-notations signature)))) + (setf (epg-sig-notation-value notation) string)))) (defun epg--status-POLICY_URL (context string) (let ((signature (car (epg-context-result-for context 'verify)))) (if signature - (epg-signature-set-notations - signature - (cons (epg-make-sig-notation nil string t nil) - (epg-sig-notations signature)))))) + (push (epg-make-sig-notation nil string t nil) + (epg-signature-notations signature))))) (defun epg--status-PROGRESS (context string) (if (and (epg-context-progress-callback context) @@ -1951,15 +1333,11 @@ NAME is either a string or a list of strings." (cdr (assq (string-to-char (aref (car lines) 8)) epg-key-validity-alist)))) keys)) - (epg-key-set-sub-key-list - (car keys) - (cons (epg--make-sub-key-1 (car lines)) - (epg-key-sub-key-list (car keys))))) + (push (epg--make-sub-key-1 (car lines)) + (epg-key-sub-key-list (car keys)))) ((member (aref (car lines) 0) '("sub" "ssb")) - (epg-key-set-sub-key-list - (car keys) - (cons (epg--make-sub-key-1 (car lines)) - (epg-key-sub-key-list (car keys))))) + (push (epg--make-sub-key-1 (car lines)) + (epg-key-sub-key-list (car keys)))) ((equal (aref (car lines) 0) "uid") ;; Decode the UID name as a backslash escaped UTF-8 string, ;; generated by GnuPG/GpgSM. @@ -1974,52 +1352,42 @@ NAME is either a string or a list of strings." 'utf-8)) (error (setq string (aref (car lines) 9)))) - (epg-key-set-user-id-list - (car keys) - (cons (epg-make-user-id - (if (aref (car lines) 1) - (cdr (assq (string-to-char (aref (car lines) 1)) - epg-key-validity-alist))) - (if cert - (condition-case nil - (epg-dn-from-string string) - (error string)) - string)) - (epg-key-user-id-list (car keys))))) + (push (epg-make-user-id + (if (aref (car lines) 1) + (cdr (assq (string-to-char (aref (car lines) 1)) + epg-key-validity-alist))) + (if cert + (condition-case nil + (epg-dn-from-string string) + (error string)) + string)) + (epg-key-user-id-list (car keys)))) ((equal (aref (car lines) 0) "fpr") - (epg-sub-key-set-fingerprint (car (epg-key-sub-key-list (car keys))) - (aref (car lines) 9))) + (setf (epg-sub-key-fingerprint (car (epg-key-sub-key-list (car keys)))) + (aref (car lines) 9))) ((equal (aref (car lines) 0) "sig") - (epg-user-id-set-signature-list - (car (epg-key-user-id-list (car keys))) - (cons - (epg-make-key-signature - (if (aref (car lines) 1) - (cdr (assq (string-to-char (aref (car lines) 1)) - epg-key-validity-alist))) - (string-to-number (aref (car lines) 3)) - (aref (car lines) 4) - (epg--time-from-seconds (aref (car lines) 5)) - (epg--time-from-seconds (aref (car lines) 6)) - (aref (car lines) 9) - (string-to-number (aref (car lines) 10) 16) - (eq (aref (aref (car lines) 10) 2) ?x)) - (epg-user-id-signature-list - (car (epg-key-user-id-list (car keys)))))))) + (push + (epg-make-key-signature + (if (aref (car lines) 1) + (cdr (assq (string-to-char (aref (car lines) 1)) + epg-key-validity-alist))) + (string-to-number (aref (car lines) 3)) + (aref (car lines) 4) + (epg--time-from-seconds (aref (car lines) 5)) + (epg--time-from-seconds (aref (car lines) 6)) + (aref (car lines) 9) + (string-to-number (aref (car lines) 10) 16) + (eq (aref (aref (car lines) 10) 2) ?x)) + (epg-user-id-signature-list + (car (epg-key-user-id-list (car keys))))))) (setq lines (cdr lines))) (setq keys (nreverse keys) pointer keys) (while pointer - (epg-key-set-sub-key-list - (car pointer) - (nreverse (epg-key-sub-key-list (car pointer)))) - (setq pointer-1 (epg-key-set-user-id-list - (car pointer) - (nreverse (epg-key-user-id-list (car pointer))))) + (epg--gv-nreverse (epg-key-sub-key-list (car pointer))) + (setq pointer-1 (epg--gv-nreverse (epg-key-user-id-list (car pointer)))) (while pointer-1 - (epg-user-id-set-signature-list - (car pointer-1) - (nreverse (epg-user-id-signature-list (car pointer-1)))) + (epg--gv-nreverse (epg-user-id-signature-list (car pointer-1))) (setq pointer-1 (cdr pointer-1))) (setq pointer (cdr pointer))) keys)) @@ -2121,8 +1489,8 @@ If you are unsure, use synchronous version of this function `epg-decrypt-file' or `epg-decrypt-string' instead." (unless (epg-data-file cipher) (error "Not a file")) - (epg-context-set-operation context 'decrypt) - (epg-context-set-result context nil) + (setf (epg-context-operation context) 'decrypt) + (setf (epg-context-result context) nil) (epg--start context (list "--decrypt" "--" (epg-data-file cipher))) ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed. (unless (eq (epg-context-protocol context) 'CMS) @@ -2142,10 +1510,8 @@ If you are unsure, use synchronous version of this function If PLAIN is nil, it returns the result as a string." (unwind-protect (progn - (if plain - (epg-context-set-output-file context plain) - (epg-context-set-output-file context - (epg--make-temp-file "epg-output"))) + (setf (epg-context-output-file context) + (or plain (epg--make-temp-file "epg-output"))) (epg-start-decrypt context (epg-make-data-from-file cipher)) (epg-wait-for-completion context) (epg--check-error-for-decrypt context) @@ -2162,8 +1528,8 @@ If PLAIN is nil, it returns the result as a string." (unwind-protect (progn (write-region cipher nil input-file nil 'quiet) - (epg-context-set-output-file context - (epg--make-temp-file "epg-output")) + (setf (epg-context-output-file context) + (epg--make-temp-file "epg-output")) (epg-start-decrypt context (epg-make-data-from-file input-file)) (epg-wait-for-completion context) (epg--check-error-for-decrypt context) @@ -2185,8 +1551,8 @@ If you use this function, you will need to wait for the completion of `epg-reset' to clear a temporary output file. If you are unsure, use synchronous version of this function `epg-verify-file' or `epg-verify-string' instead." - (epg-context-set-operation context 'verify) - (epg-context-set-result context nil) + (setf (epg-context-operation context) 'verify) + (setf (epg-context-result context) nil) (if signed-text ;; Detached signature. (if (epg-data-file signed-text) @@ -2233,10 +1599,8 @@ To check the verification results, use `epg-context-result-for' as follows: which will return a list of `epg-signature' object." (unwind-protect (progn - (if plain - (epg-context-set-output-file context plain) - (epg-context-set-output-file context - (epg--make-temp-file "epg-output"))) + (setf (epg-context-output-file context) + (or plain (epg--make-temp-file "epg-output"))) (if signed-text (epg-start-verify context (epg-make-data-from-file signature) @@ -2272,8 +1636,8 @@ which will return a list of `epg-signature' object." input-file) (unwind-protect (progn - (epg-context-set-output-file context - (epg--make-temp-file "epg-output")) + (setf (epg-context-output-file context) + (epg--make-temp-file "epg-output")) (if signed-text (progn (setq input-file (epg--make-temp-file "epg-signature")) @@ -2303,8 +1667,8 @@ If you use this function, you will need to wait for the completion of `epg-reset' to clear a temporary output file. If you are unsure, use synchronous version of this function `epg-sign-file' or `epg-sign-string' instead." - (epg-context-set-operation context 'sign) - (epg-context-set-result context nil) + (setf (epg-context-operation context) 'sign) + (setf (epg-context-result context) nil) (unless (memq mode '(t detached nil normal)) ;i.e. cleartext (epg-context-set-armor context nil) (epg-context-set-textmode context nil)) @@ -2343,10 +1707,8 @@ If it is nil or 'normal, it makes a normal signature. Otherwise, it makes a cleartext signature." (unwind-protect (progn - (if signature - (epg-context-set-output-file context signature) - (epg-context-set-output-file context - (epg--make-temp-file "epg-output"))) + (setf (epg-context-output-file context) + (or signature (epg--make-temp-file "epg-output"))) (epg-start-sign context (epg-make-data-from-file plain) mode) (epg-wait-for-completion context) (unless (epg-context-result-for context 'sign) @@ -2375,8 +1737,8 @@ Otherwise, it makes a cleartext signature." (coding-system-for-write 'binary)) (unwind-protect (progn - (epg-context-set-output-file context - (epg--make-temp-file "epg-output")) + (setf (epg-context-output-file context) + (epg--make-temp-file "epg-output")) (if input-file (write-region plain nil input-file nil 'quiet)) (epg-start-sign context @@ -2407,8 +1769,8 @@ If you use this function, you will need to wait for the completion of `epg-reset' to clear a temporary output file. If you are unsure, use synchronous version of this function `epg-encrypt-file' or `epg-encrypt-string' instead." - (epg-context-set-operation context 'encrypt) - (epg-context-set-result context nil) + (setf (epg-context-operation context) 'encrypt) + (setf (epg-context-result context) nil) (epg--start context (append (if always-trust '("--always-trust")) (if recipients '("--encrypt") '("--symmetric")) @@ -2452,10 +1814,8 @@ If CIPHER is nil, it returns the result as a string. If RECIPIENTS is nil, it performs symmetric encryption." (unwind-protect (progn - (if cipher - (epg-context-set-output-file context cipher) - (epg-context-set-output-file context - (epg--make-temp-file "epg-output"))) + (setf (epg-context-output-file context) + (or cipher (epg--make-temp-file "epg-output"))) (epg-start-encrypt context (epg-make-data-from-file plain) recipients sign always-trust) (epg-wait-for-completion context) @@ -2489,8 +1849,8 @@ If RECIPIENTS is nil, it performs symmetric encryption." (coding-system-for-write 'binary)) (unwind-protect (progn - (epg-context-set-output-file context - (epg--make-temp-file "epg-output")) + (setf (epg-context-output-file context) + (epg--make-temp-file "epg-output")) (if input-file (write-region plain nil input-file nil 'quiet)) (epg-start-encrypt context @@ -2521,8 +1881,8 @@ If you use this function, you will need to wait for the completion of `epg-reset' to clear a temporary output file. If you are unsure, use synchronous version of this function `epg-export-keys-to-file' or `epg-export-keys-to-string' instead." - (epg-context-set-operation context 'export-keys) - (epg-context-set-result context nil) + (setf (epg-context-operation context) 'export-keys) + (setf (epg-context-result context) nil) (epg--start context (cons "--export" (mapcar (lambda (key) @@ -2534,10 +1894,8 @@ If you are unsure, use synchronous version of this function "Extract public KEYS." (unwind-protect (progn - (if file - (epg-context-set-output-file context file) - (epg-context-set-output-file context - (epg--make-temp-file "epg-output"))) + (setf (epg-context-output-file context) + (or file (epg--make-temp-file "epg-output"))) (epg-start-export-keys context keys) (epg-wait-for-completion context) (let ((errors (epg-context-result-for context 'error))) @@ -2564,8 +1922,8 @@ If you use this function, you will need to wait for the completion of `epg-reset' to clear a temporary output file. If you are unsure, use synchronous version of this function `epg-import-keys-from-file' or `epg-import-keys-from-string' instead." - (epg-context-set-operation context 'import-keys) - (epg-context-set-result context nil) + (setf (epg-context-operation context) 'import-keys) + (setf (epg-context-result context) nil) (epg--start context (if (epg-data-file keys) (list "--import" "--" (epg-data-file keys)) (list "--import"))) @@ -2605,8 +1963,8 @@ If you use this function, you will need to wait for the completion of `epg-reset' to clear a temporary output file. If you are unsure, use synchronous version of this function `epg-receive-keys' instead." - (epg-context-set-operation context 'receive-keys) - (epg-context-set-result context nil) + (setf (epg-context-operation context) 'receive-keys) + (setf (epg-context-result context) nil) (epg--start context (cons "--recv-keys" key-id-list))) (defun epg-receive-keys (context keys) @@ -2633,8 +1991,8 @@ If you use this function, you will need to wait for the completion of `epg-reset' to clear a temporary output file. If you are unsure, use synchronous version of this function `epg-delete-keys' instead." - (epg-context-set-operation context 'delete-keys) - (epg-context-set-result context nil) + (setf (epg-context-operation context) 'delete-keys) + (setf (epg-context-result context) nil) (epg--start context (cons (if allow-secret "--delete-secret-key" "--delete-key") @@ -2666,8 +2024,8 @@ If you use this function, you will need to wait for the completion of If you are unsure, use synchronous version of this function `epg-sign-keys' instead." (declare (obsolete nil "23.1")) - (epg-context-set-operation context 'sign-keys) - (epg-context-set-result context nil) + (setf (epg-context-operation context) 'sign-keys) + (setf (epg-context-result context) nil) (epg--start context (cons (if local "--lsign-key" "--sign-key") @@ -2700,8 +2058,8 @@ If you use this function, you will need to wait for the completion of `epg-reset' to clear a temporary output file. If you are unsure, use synchronous version of this function `epg-generate-key-from-file' or `epg-generate-key-from-string' instead." - (epg-context-set-operation context 'generate-key) - (epg-context-set-result context nil) + (setf (epg-context-operation context) 'generate-key) + (setf (epg-context-result context) nil) (if (epg-data-file parameters) (epg--start context (list "--batch" "--genkey" "--" (epg-data-file parameters))) @@ -2740,6 +2098,38 @@ PARAMETERS is a string which tells how to create the key." (epg-errors-to-string errors)))))) (epg-reset context))) +(defun epg-start-edit-key (context key edit-callback handback) + "Initiate an edit operation on KEY. + +EDIT-CALLBACK is called from process filter and takes 3 +arguments: the context, a status, an argument string, and the +handback argument. + +If you use this function, you will need to wait for the completion of +`epg-gpg-program' by using `epg-wait-for-completion' and call +`epg-reset' to clear a temporary output file. +If you are unsure, use synchronous version of this function +`epg-edit-key' instead." + (setf (epg-context-operation context) 'edit-key) + (setf (epg-context-result context) nil) + (setf (epg-context-edit-callback context) (cons edit-callback handback)) + (epg--start context (list "--edit-key" + (epg-sub-key-id + (car (epg-key-sub-key-list key)))))) + +(defun epg-edit-key (context key edit-callback handback) + "Edit KEY in the keyring." + (unwind-protect + (progn + (epg-start-edit-key context key edit-callback handback) + (epg-wait-for-completion context) + (let ((errors (epg-context-result-for context 'error))) + (if errors + (signal 'epg-error + (list "Edit key failed" + (epg-errors-to-string errors)))))) + (epg-reset context))) + (defun epg--decode-percent-escape (string) (let ((index 0)) (while (string-match "%\\(\\(%\\)\\|\\([0-9A-Fa-f][0-9A-Fa-f]\\)\\)" diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index 8e0c31a7dec..ba5d57e4d2e 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -3,35 +3,62 @@ * erc-backend.el (define-erc-response-handler): Give hook-name default value of nil and add-to-list (bug#19363) +2015-01-22 Paul Eggert <eggert@cs.ucla.edu> + + Don't downcase system diagnostics' first letters + * erc-dcc.el (erc-dcc-server): Ignore case while comparing diagnostics. + +2014-11-23 Michael Albinus <michael.albinus@gmx.de> + + * erc-desktop-notifications.el (erc-notifications-bus): + New customer option. Supports cases when Emacs hasn't been + invoked in the same environment where the notifications shall go to. + (erc-notifications-notify): Use it. + 2014-11-10 Kelvin White <kwhite@gnu.org> * erc-stamp.el (erc-timestamp-intangible): Change version tag to 24.5. -2014-11-09 Ivan Shmakov <ivan@siamics.net> +2014-11-05 Stefan Monnier <monnier@iro.umontreal.ca> + + * erc.el (erc-send-input): Bind `str' dynamically (bug#18936). + +2014-10-29 Paul Eggert <eggert@cs.ucla.edu> + + Simplify use of current-time and friends. + * erc-backend.el (TOPIC): Omit unnecessary call to current-time. + * erc.el (erc-emacs-time-to-erc-time): Simplify by using float-time. + (erc-current-time): Simplify by using erc-emacs-time-to-erc-time. + +2014-10-20 Glenn Morris <rgm@gnu.org> + + * Merge in all changes up to 24.4 release. + +2014-10-15 Ivan Shmakov <ivan@siamics.net> * erc-track.el (erc-modified-channels-display): Update mode line more frequently (bug#18510). -2014-11-09 Kelvin White <kwhite@gnu.org> +2014-10-10 Kelvin White <kwhite@gnu.org> * erc.el (erc-initialize-log-marker): Only initialize erc-last-saved-position if not already a marker. -2014-11-09 Stefan Monnier <monnier@iro.umontreal.ca> +2014-10-04 Stefan Monnier <monnier@iro.umontreal.ca> * erc.el (erc-channel-receive-names): Silence compiler warning. (erc-format-@nick, erc-update-modes): Idem. -2014-11-09 Kelvin White <kwhite@gnu.org> +2014-10-03 Kelvin White <kwhite@gnu.org> * erc.el (erc-rename-buffers): Use defcustom instead of defvar for buffer renaming configuration option. -2014-11-09 Paul Eggert <eggert@cs.ucla.edu> +2014-10-02 Paul Eggert <eggert@cs.ucla.edu> * erc.el (erc-nick-at-point): Fix format-string typo (Bug#17755). -2014-11-09 Kelvin White <kwhite@gnu.org> +2014-10-02 Kelvin White <kwhite@gnu.org> * erc.el (erc-rename-buffer-p): When set to t buffers will be renamed to the current irc network. @@ -40,7 +67,7 @@ * erc-ring.el (erc-input-ring-setup): Fixes Bug #18599 -2014-11-09 Stefan Monnier <monnier@iro.umontreal.ca> +2014-09-30 Stefan Monnier <monnier@iro.umontreal.ca> * erc-track.el (erc-modified-channels-display): Update all mode lines if needed (bug#18510). Remove call to erc-modified-channels-object @@ -48,11 +75,11 @@ (erc-modified-channels-update): Don't force-mode-line-update here any more. -2014-11-09 Kelvin White <kwhite@gnu.org> +2014-09-26 Kelvin White <kwhite@gnu.org> * erc.el (erc-format-nick): Fix code regression - Bug #18551 -2014-11-09 Kelvin White <kwhite@gnu.org> +2014-09-25 Kelvin White <kwhite@gnu.org> * erc.el: Follow Emacs version instead of tracking it seperately. (erc-quit/part-reason-default) : Clean up quit/part message @@ -62,27 +89,27 @@ (erc-cmd-SV, erc-ctcp-query-VERSION, erc-version, erc-version-string): Change version string. -2014-11-09 Kelvin White <kwhite@gnu.org> +2014-08-13 Kelvin White <kwhite@gnu.org> * erc.el (erc-send-input): Disable display commands in current buffer (erc-format-target-and/or-network): Fix cases when buffer name is set -2014-11-09 Stefan Monnier <monnier@iro.umontreal.ca> +2014-08-12 Stefan Monnier <monnier@iro.umontreal.ca> * erc-stamp.el (erc-timestamp-intangible): Disable by default because `intangible' is evil. -2014-11-09 Kelvin White <kwhite@gnu.org> +2014-08-07 Kelvin White <kwhite@gnu.org> * erc.el (erc-channel-receive-names): Fix variable names (erc-format-target-and/or-network): Rename server-buffers to network name if possible -2014-11-09 Stefan Monnier <monnier@iro.umontreal.ca> +2014-07-08 Stefan Monnier <monnier@iro.umontreal.ca> * erc.el (erc-channel-receive-names): Reduce redundancy. -2014-11-09 Kelvin White <kwhite@gnu.org> +2014-06-19 Kelvin White <kwhite@gnu.org> * erc-backend.el: Handle user modes in relevant server responses * erc.el: Better user mode support. @@ -96,20 +123,10 @@ (erc-channel-receive-names): Update channel users. (erc-nick-at-point): Return correct user info. -2014-11-04 Stefan Monnier <monnier@iro.umontreal.ca> - - * erc.el (erc-send-input): Bind `str' dynamically (bug#18936). - -2014-10-20 Glenn Morris <rgm@gnu.org> - - * Version 24.4 released. - -2014-09-24 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-04 Stefan Monnier <monnier@iro.umontreal.ca> - * erc-track.el (erc-modified-channels-display): Update all mode lines - if needed (bug#18510). Remove call to erc-modified-channels-object - where we ignored the return value. - (erc-modified-channels-update): Don't force-mode-line-update here any more. + * erc.el (erc-invite-only-mode, erc-toggle-channel-mode): Simplify. + (erc-load-script): Tighten a regexp. 2014-02-25 Julien Danjou <julien@danjou.info> @@ -458,9 +475,9 @@ 2011-11-28 Mike Kazantsev <mk.fraggod@gmail.com> (tiny change) - * erc-dcc.el (erc-dcc-ctcp-query-send-regexp): Updated regexp to + * erc-dcc.el (erc-dcc-ctcp-query-send-regexp): Update regexp to match quoted filenames with spaces inside. - (erc-dcc-handle-ctcp-send): Updated regexp match group numbers, + (erc-dcc-handle-ctcp-send): Update regexp match group numbers, added processing of escaped quotes and backslashes if filename itself was in quotes. diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 9d52c3b7c09..182f1e05921 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -379,7 +379,7 @@ created subprocess, or nil." (set-process-filter-multibyte process nil))))) (file-error (unless (and (string= "Cannot bind server socket" (nth 1 err)) - (string= "address already in use" (nth 2 err))) + (string= "address already in use" (downcase (nth 2 err)))) (signal (car err) (cdr err))) (setq port (1+ port)) (unless (< port upper) @@ -1264,4 +1264,3 @@ other client." ;; Local Variables: ;; indent-tabs-mode: nil ;; End: - diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el index a19e93cd3bf..f987597325b 100644 --- a/lisp/erc/erc-desktop-notifications.el +++ b/lisp/erc/erc-desktop-notifications.el @@ -46,6 +46,12 @@ :group 'erc-notifications :type '(choice (const :tag "No icon" nil) file)) +(defcustom erc-notifications-bus :session + "D-Bus bus to use for notification." + :version "25.1" + :group 'erc-notifications + :type '(choice (const :tag "Session bus" :session) string)) + (defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors (defun erc-notifications-notify (nick msg) @@ -53,7 +59,8 @@ This will replace the last notification sent with this function." (dbus-ignore-errors (setq erc-notifications-last-notification - (notifications-notify :title (xml-escape-string nick) + (notifications-notify :bus erc-notifications-bus + :title (xml-escape-string nick) :body (xml-escape-string msg) :replaces-id erc-notifications-last-notification :app-icon erc-notifications-icon)))) diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index bd437763df4..76751e51dfd 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -490,7 +490,7 @@ whose cdr is the list of file attributes." " " (format-time-string (concat eshell-ls-date-format " " - (if (= (nth 5 (decode-time (current-time))) + (if (= (nth 5 (decode-time)) (nth 5 (decode-time (nth (cond ((eq sort-method 'by-atime) 4) diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el index bf5198d9c00..ed6cfb55177 100644 --- a/lisp/eshell/em-smart.el +++ b/lisp/eshell/em-smart.el @@ -188,7 +188,8 @@ The options are `begin', `after' or `end'." (add-hook 'eshell-post-command-hook (function (lambda () - (setq eshell-smart-command-done t))) t t) + (setq eshell-smart-command-done t))) + t t) (unless (eq eshell-review-quick-commands t) (add-hook 'eshell-post-command-hook @@ -200,8 +201,7 @@ The options are `begin', `after' or `end'." (unless eshell-currently-handling-window (let ((inhibit-point-motion-hooks t) (eshell-currently-handling-window t)) - (save-selected-window - (select-window wind) + (with-selected-window wind (eshell-smart-redisplay))))) (defun eshell-refresh-windows (&optional frame) @@ -212,12 +212,12 @@ The options are `begin', `after' or `end'." (lambda (wind) (with-current-buffer (window-buffer wind) (if eshell-mode - (let (window-scroll-functions) + (let (window-scroll-functions) ;;FIXME: Why? (eshell-smart-scroll-window wind (window-start)) (setq affected t)))))) 0 frame) (if affected - (let (window-scroll-functions) + (let (window-scroll-functions) ;;FIXME: Why? (eshell-redisplay))))) (defun eshell-smart-display-setup () diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index e7c25b28cb0..0b25b31eff9 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el @@ -296,6 +296,11 @@ line of the form #!<interp>." (let ((fullname (if (file-name-directory file) file (eshell-search-path file))) (suffixes eshell-binary-suffixes)) + (if (and fullname + (not (file-remote-p fullname)) + (file-remote-p default-directory)) + (setq fullname (expand-file-name + (concat "./" fullname) default-directory))) (if (and fullname (not (or eshell-force-execution (file-executable-p fullname)))) (while suffixes diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 3eb4c64a1d3..7dfc39f3202 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -118,8 +118,6 @@ from executing while Emacs is redisplaying." :type 'integer :group 'eshell-io) -(defvar x-select-enable-clipboard) ; term/common-win - (defcustom eshell-virtual-targets '(("/dev/eshell" eshell-interactive-print nil) ("/dev/kill" (lambda (mode) @@ -128,7 +126,7 @@ from executing while Emacs is redisplaying." 'eshell-kill-append) t) ("/dev/clip" (lambda (mode) (if (eq mode 'overwrite) - (let ((x-select-enable-clipboard t)) + (let ((gui-select-enable-clipboard t)) (kill-new ""))) 'eshell-clipboard-append) t)) "Map virtual devices name to Emacs Lisp functions. @@ -328,7 +326,7 @@ last execution result should not be changed." (defun eshell-clipboard-append (string) "Call `kill-append' with STRING, if it is indeed a string." (if (stringp string) - (let ((x-select-enable-clipboard t)) + (let ((gui-select-enable-clipboard t)) (kill-append string nil)))) (defun eshell-get-target (target &optional mode) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 59a4889f9e1..697f97e0460 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -539,20 +539,17 @@ Unless optional argument INPLACE is non-nil, return a new string." (defmacro eshell-with-file-modes (modes &rest forms) "Evaluate, with file-modes set to MODES, the given FORMS." - `(let ((modes (default-file-modes))) - (set-default-file-modes ,modes) - (unwind-protect - (progn ,@forms) - (set-default-file-modes modes)))) + (declare (obsolete with-file-modes "25.1")) + `(with-file-modes ,modes ,@forms)) (defmacro eshell-with-private-file-modes (&rest forms) "Evaluate FORMS with private file modes set." - `(eshell-with-file-modes ,eshell-private-file-modes ,@forms)) + `(with-file-modes ,eshell-private-file-modes ,@forms)) (defsubst eshell-make-private-directory (dir &optional parents) "Make DIR with file-modes set to `eshell-private-directory-modes'." - (eshell-with-file-modes eshell-private-directory-modes - (make-directory dir parents))) + (with-file-modes eshell-private-directory-modes + (make-directory dir parents))) (defsubst eshell-substring (string sublen) "Return the beginning of STRING, up to SUBLEN bytes." @@ -656,7 +653,7 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable. (match-string 6)))) (if (nth 0 moment) (setcar (nthcdr 5 moment) - (nth 5 (decode-time (current-time)))) + (nth 5 (decode-time))) (setcar (nthcdr 0 moment) 0) (setcar (nthcdr 1 moment) 0) (setcar (nthcdr 2 moment) 0)) diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index ea6d2c3d116..553955155ef 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -170,56 +170,7 @@ ;; @ 4nt ;; @ csh -;;;_* Speeding up load time -;; -;; If you find that Eshell loads too slowly, there is something you -;; can do to speed it up. -;; -;; Create a file, named /tmp/elc, containing this filelist: -;; -;; esh-util.elc -;; eshell.elc -;; esh-module.elc -;; esh-var.elc -;; esh-proc.elc -;; esh-arg.elc -;; esh-io.elc -;; esh-ext.elc -;; esh-cmd.elc -;; esh-mode.elc -;; esh-opt.elc -;; em-alias.elc -;; em-banner.elc -;; em-basic.elc -;; em-cmpl.elc -;; em-dirs.elc -;; em-pred.elc -;; em-glob.elc -;; em-hist.elc -;; em-ls.elc -;; em-prompt.elc -;; em-rebind.elc -;; em-script.elc -;; em-smart.elc -;; em-term.elc -;; em-unix.elc -;; em-xtra.elc -;; -;; The order is very important. Remove from the filelist any features -;; you don't use. These all begin with "em-". If you don't use -;; Eshell's key rebinding module, you can remove "em-rebind.elc" from -;; the filelist. The modules you are currently using are listed in -;; `eshell-modules-list'. -;; -;; Now, concatenating all of the above mentioned .elc files, in that -;; order, to another file. Here is how to do this on UNIX: -;; -;; cat `cat /tmp/elc` > tmp.elc ; mv tmp.elc eshell.elc -;; -;; Now your eshell.elc file contains all of the .elc files that make -;; up Eshell, in the right load order. When you next load Eshell, it -;; will only have to read in this one file, which will greatly speed -;; things up. +;;; Code: (eval-when-compile (require 'cl-lib)) diff --git a/lisp/faces.el b/lisp/faces.el index 5176bedf13a..22bf2626722 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -35,6 +35,26 @@ the terminal-initialization file to be loaded." (string :tag "Name of directory with term files")) :group 'terminals) +(defcustom term-file-aliases + '(("apollo" . "vt100") + ("vt102" . "vt100") + ("vt125" . "vt100") + ("vt201" . "vt200") + ("vt220" . "vt200") + ("vt240" . "vt200") + ("vt300" . "vt200") + ("vt320" . "vt200") + ("vt400" . "vt200") + ("vt420" . "vt200") + ) + "Alist of terminal type aliases. +Entries are of the form (TYPE . ALIAS), where both elements are strings. +This means to treat a terminal of type TYPE as if it were of type ALIAS." + :type '(alist :key-type (string :tag "Terminal") + :value-type (string :tag "Alias")) + :group 'terminals + :version "25.1") + (declare-function xw-defined-colors "term/common-win" (&optional frame)) (defvar help-xref-stack-item) @@ -129,15 +149,11 @@ REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc." "Return a list of all defined faces." (mapcar #'car face-new-frame-defaults)) -(defun make-face (face &optional no-init-from-resources) +(defun make-face (face) "Define a new face with name FACE, a symbol. Do not call this directly from Lisp code; use `defface' instead. -If FACE is already known as a face, leave it unmodified. Return FACE. - -NO-INIT-FROM-RESOURCES has been deprecated and is no longer used -and will go away. Handling of conditional X resources application -has been pushed down to make-x-resource-internal itself." +If FACE is already known as a face, leave it unmodified. Return FACE." (interactive (list (read-from-minibuffer "Make face: " nil nil t 'face-name-history))) (unless (facep face) @@ -151,11 +167,6 @@ has been pushed down to make-x-resource-internal itself." (make-face-x-resource-internal face)) face) -;; Handling of whether to apply X resources or not, has been pushed down -;; to make-face-x-resource-internal itself, thus the optional arg is no -;; longer evaluated at all and going away. -(set-advertised-calling-convention 'make-face '(face) "24.4") - (defun make-empty-face (face) "Define a new, empty face with name FACE. Do not call this directly from Lisp code; use `defface' instead." @@ -2056,17 +2067,16 @@ Calculate the face definitions using the face specs, custom theme settings, X resources, and `face-new-frame-defaults'. Finally, apply any relevant face attributes found amongst the frame parameters in PARAMETERS." - (let ((window-system-p (memq (window-system frame) '(x w32)))) - ;; The `reverse' is so that `default' goes first. - (dolist (face (nreverse (face-list))) - (condition-case () - (progn - ;; Initialize faces from face spec and custom theme. - (face-spec-recalc face frame) - ;; Apply attributes specified by face-new-frame-defaults - (internal-merge-in-global-face face frame)) - ;; Don't let invalid specs prevent frame creation. - (error nil)))) + ;; The `reverse' is so that `default' goes first. + (dolist (face (nreverse (face-list))) + (condition-case () + (progn + ;; Initialize faces from face spec and custom theme. + (face-spec-recalc face frame) + ;; Apply attributes specified by face-new-frame-defaults + (internal-merge-in-global-face face frame)) + ;; Don't let invalid specs prevent frame creation. + (error nil))) ;; Apply attributes specified by frame parameters. (let ((face-params '((foreground-color default :foreground) @@ -2082,7 +2092,8 @@ frame parameters in PARAMETERS." (value (cdr (assq param-name parameters)))) (if value (set-face-attribute (nth 1 param) frame - (nth 2 param) value)))))) + (nth 2 param) value)))) + (frame-can-run-window-configuration-change-hook frame t))) (defun tty-handle-reverse-video (frame parameters) "Handle the reverse-video frame parameter for terminal frames." @@ -2148,11 +2159,16 @@ This can be used to fine tune the `input-decode-map', for example.") The optional TYPE parameter may be used to override the autodetected terminal type to a different value. +This consults `term-file-aliases' to map terminal types to their aliases. + If optional argument RUN-HOOK is non-nil, then as a final step, this runs the hook `tty-setup-hook'. If you set `term-file-prefix' to nil, this function does nothing." (setq type (or type (tty-type frame))) + (let ((alias (tty-find-type + (lambda (typ) (assoc typ term-file-aliases)) type))) + (if alias (setq type (cdr (assoc alias term-file-aliases))))) ;; Load library for our terminal type. ;; User init file can set term-file-prefix to nil to prevent this. (with-selected-frame frame diff --git a/lisp/ffap.el b/lisp/ffap.el index eef4f139f08..350a6bdac20 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -163,6 +163,12 @@ schemes (e.g. \"ftp\"); in that case, only convert those URLs." :group 'ffap :version "24.3") +(defcustom ffap-lax-url nil + "If non-nil, allow lax URL matching." + :type 'boolean + :group 'ffap + :version "25.1") + (defcustom ffap-ftp-default-user "anonymous" "User name in FTP file names generated by `ffap-host-to-path'. Note this name may be omitted if it equals the default @@ -470,7 +476,7 @@ Returned values: ;; (file-error "connection failed" "address already in use" ;; "ftp.uu.net" "ffap-machine-p") ((equal mesg "connection failed") - (if (equal (nth 2 error) "permission denied") + (if (string= (downcase (nth 2 error)) "permission denied") nil ; host does not exist ;; Other errors mean the host exists: (nth 2 error))) @@ -1096,7 +1102,7 @@ Assumes the buffer has not changed." (w3-view-this-url t)) (let ((thing-at-point-beginning-of-url-regexp ffap-url-regexp) (thing-at-point-default-mail-uri-scheme ffap-foo-at-bar-prefix)) - (thing-at-point-url-at-point t + (thing-at-point-url-at-point ffap-lax-url (if (use-region-p) (cons (region-beginning) (region-end)))))))) @@ -1253,7 +1259,8 @@ which may actually result in an URL rather than a filename." (not (ffap-file-exists-string dir)) (not (equal dir (setq dir (file-name-directory (directory-file-name dir))))))) - (ffap-file-exists-string dir))) + (and (not (string= dir "/")) + (ffap-file-exists-string dir)))) ) (set-match-data data)))) @@ -1432,7 +1439,7 @@ and the functions `ffap-file-at-point' and `ffap-url-at-point'." (expand-file-name filename))) ;; User does not want to find a non-existent file: ((signal 'file-error (list "Opening file buffer" - "no such file or directory" + "No such file or directory" filename))))))) ;; Shortcut: allow {M-x ffap} rather than {M-x find-file-at-point}. diff --git a/lisp/files.el b/lisp/files.el index 088924427ee..40a42897419 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -559,14 +559,6 @@ A value of nil means ignore them; anything else means query." (other :tag "Query" other)) :group 'find-file) -;; Avoid losing in versions where CLASH_DETECTION is disabled. -(or (fboundp 'lock-buffer) - (defalias 'lock-buffer 'ignore)) -(or (fboundp 'unlock-buffer) - (defalias 'unlock-buffer 'ignore)) -(or (fboundp 'file-locked-p) - (defalias 'file-locked-p 'ignore)) - (defcustom view-read-only nil "Non-nil means buffers visiting files read-only do so in view mode. In fact, this means that all read-only buffers normally have @@ -737,6 +729,39 @@ The path separator is colon in GNU and GNU-like systems." (lambda (f) (and (file-directory-p f) 'dir-ok))) (error "No such directory found via CDPATH environment variable")))) +(defsubst directory-name-p (name) + "Return non-nil if NAME ends with a slash character." + (and (> (length name) 0) + (char-equal (aref name (1- (length name))) ?/))) + +(defun directory-files-recursively (dir match &optional include-directories) + "Return all files under DIR that have file names matching MATCH (a regexp). +This function works recursively. Files are returned in \"depth first\" +and alphabetical order. +If INCLUDE-DIRECTORIES, also include directories that have matching names." + (let ((result nil) + (files nil) + ;; When DIR is "/", remote file names like "/method:" could + ;; also be offered. We shall suppress them. + (tramp-mode (and tramp-mode (file-remote-p dir)))) + (dolist (file (sort (file-name-all-completions "" dir) + 'string<)) + (unless (member file '("./" "../")) + (if (directory-name-p file) + (let* ((leaf (substring file 0 (1- (length file)))) + (full-file (expand-file-name leaf dir))) + ;; Don't follow symlinks to other directories. + (unless (file-symlink-p full-file) + (setq result + (nconc result (directory-files-recursively + full-file match include-directories)))) + (when (and include-directories + (string-match match leaf)) + (setq result (nconc result (list full-file))))) + (when (string-match match file) + (push (expand-file-name file dir) files))))) + (nconc result (nreverse files)))) + (defun load-file (file) "Load the Lisp file named FILE." ;; This is a case where .elc makes a lot of sense. @@ -891,7 +916,7 @@ which we're looking." ;; ;; Represent /home/luser/foo as ~/foo so that we don't try to look for ;; `name' in /home or in /. - (setq file (abbreviate-file-name file)) + (setq file (abbreviate-file-name (expand-file-name file))) (let ((root nil) ;; `user' is not initialized outside the loop because ;; `file' may not exist, so we may have to walk up part of the @@ -949,14 +974,10 @@ directory if it does not exist." (if (file-directory-p user-emacs-directory) (or (file-accessible-directory-p user-emacs-directory) (setq errtype "access")) - (let ((umask (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes ?\700) - (condition-case nil - (make-directory user-emacs-directory) - (error (setq errtype "create")))) - (set-default-file-modes umask)))) + (with-file-modes ?\700 + (condition-case nil + (make-directory user-emacs-directory) + (error (setq errtype "create"))))) (when (and errtype user-emacs-directory-warning (not (get 'user-emacs-directory-warning 'this-session))) @@ -1281,36 +1302,31 @@ You can then use `write-region' to write new data into the file. If DIR-FLAG is non-nil, create a new empty directory instead of a file. If SUFFIX is non-nil, add that at the end of the file name." - (let ((umask (default-file-modes)) - file) - (unwind-protect - (progn - ;; Create temp files with strict access rights. It's easy to - ;; loosen them later, whereas it's impossible to close the - ;; time-window of loose permissions otherwise. - (set-default-file-modes ?\700) - (while (condition-case () - (progn - (setq file - (make-temp-name - (if (zerop (length prefix)) - (file-name-as-directory - temporary-file-directory) - (expand-file-name prefix - temporary-file-directory)))) - (if suffix - (setq file (concat file suffix))) - (if dir-flag - (make-directory file) - (write-region "" nil file nil 'silent nil 'excl)) - nil) - (file-already-exists t)) - ;; the file was somehow created by someone else between - ;; `make-temp-name' and `write-region', let's try again. - nil) - file) - ;; Reset the umask. - (set-default-file-modes umask)))) + ;; Create temp files with strict access rights. It's easy to + ;; loosen them later, whereas it's impossible to close the + ;; time-window of loose permissions otherwise. + (with-file-modes ?\700 + (let (file) + (while (condition-case () + (progn + (setq file + (make-temp-name + (if (zerop (length prefix)) + (file-name-as-directory + temporary-file-directory) + (expand-file-name prefix + temporary-file-directory)))) + (if suffix + (setq file (concat file suffix))) + (if dir-flag + (make-directory file) + (write-region "" nil file nil 'silent nil 'excl)) + nil) + (file-already-exists t)) + ;; the file was somehow created by someone else between + ;; `make-temp-name' and `write-region', let's try again. + nil) + file))) (defun recode-file-name (file coding new-coding &optional ok-if-already-exists) "Change the encoding of FILE's name from CODING to NEW-CODING. @@ -1392,6 +1408,9 @@ return value, which may be passed as the REQUIRE-MATCH arg to (defmacro minibuffer-with-setup-hook (fun &rest body) "Temporarily add FUN to `minibuffer-setup-hook' while executing BODY. +FUN can also be (:append FUN1), in which case FUN1 is appended to +`minibuffer-setup-hook'. + BODY should use the minibuffer at most once. Recursive uses of the minibuffer are unaffected (FUN is not called additional times). @@ -1399,19 +1418,24 @@ called additional times). This macro actually adds an auxiliary function that calls FUN, rather than FUN itself, to `minibuffer-setup-hook'." (declare (indent 1) (debug t)) - (let ((hook (make-symbol "setup-hook"))) - `(let (,hook) + (let ((hook (make-symbol "setup-hook")) + (funsym (make-symbol "fun")) + (append nil)) + (when (eq (car-safe fun) :append) + (setq append '(t) fun (cadr fun))) + `(let ((,funsym ,fun) + ,hook) (setq ,hook - (lambda () - ;; Clear out this hook so it does not interfere - ;; with any recursive minibuffer usage. - (remove-hook 'minibuffer-setup-hook ,hook) - (funcall ,fun))) + (lambda () + ;; Clear out this hook so it does not interfere + ;; with any recursive minibuffer usage. + (remove-hook 'minibuffer-setup-hook ,hook) + (funcall ,funsym))) (unwind-protect - (progn - (add-hook 'minibuffer-setup-hook ,hook) - ,@body) - (remove-hook 'minibuffer-setup-hook ,hook))))) + (progn + (add-hook 'minibuffer-setup-hook ,hook ,@append) + ,@body) + (remove-hook 'minibuffer-setup-hook ,hook))))) (defun find-file-read-args (prompt mustmatch) (list (read-file-name prompt nil default-directory mustmatch) @@ -1465,8 +1489,9 @@ expand wildcards (if any) and visit multiple files." (if (listp value) (progn (setq value (nreverse value)) - (cons (switch-to-buffer-other-window (car value)) - (mapcar 'switch-to-buffer (cdr value)))) + (switch-to-buffer-other-window (car value)) + (mapc 'switch-to-buffer (cdr value)) + value) (switch-to-buffer-other-window value)))) (defun find-file-other-frame (filename &optional wildcards) @@ -1488,8 +1513,9 @@ expand wildcards (if any) and visit multiple files." (if (listp value) (progn (setq value (nreverse value)) - (cons (switch-to-buffer-other-frame (car value)) - (mapcar 'switch-to-buffer (cdr value)))) + (switch-to-buffer-other-frame (car value)) + (mapc 'switch-to-buffer (cdr value)) + value) (switch-to-buffer-other-frame value)))) (defun find-file-existing (filename) @@ -1801,6 +1827,15 @@ When nil, never request confirmation." :version "22.1" :type '(choice integer (const :tag "Never request confirmation" nil))) +(defcustom out-of-memory-warning-percentage nil + "Warn if file size exceeds this percentage of available free memory. +When nil, never issue warning. Beware: This probably doesn't do what you +think it does, because \"free\" is pretty hard to define in practice." + :group 'files + :group 'find-file + :version "25.1" + :type '(choice integer (const :tag "Never issue warning" nil))) + (defun abort-if-file-too-large (size op-type filename) "If file SIZE larger than `large-file-warning-threshold', allow user to abort. OP-TYPE specifies the file operation being performed (for message to user)." @@ -1811,6 +1846,25 @@ OP-TYPE specifies the file operation being performed (for message to user)." (file-size-human-readable size) op-type)))) (error "Aborted"))) +(defun warn-maybe-out-of-memory (size) + "Warn if an attempt to open file of SIZE bytes may run out of memory." + (when (and (numberp size) (not (zerop size)) + (integerp out-of-memory-warning-percentage)) + (let ((meminfo (memory-info))) + (when (consp meminfo) + (let ((total-free-memory (float (+ (nth 1 meminfo) (nth 3 meminfo))))) + (when (> (/ size 1024) + (/ (* total-free-memory out-of-memory-warning-percentage) + 100.0)) + (warn + "You are trying to open a file whose size (%s) +exceeds the %S%% of currently available free memory (%s). +If that fails, try to open it with `find-file-literally' +\(but note that some characters might be displayed incorrectly)." + (file-size-human-readable size) + out-of-memory-warning-percentage + (file-size-human-readable (* total-free-memory 1024))))))))) + (defun find-file-noselect (filename &optional nowarn rawfile wildcards) "Read file FILENAME into a buffer and return the buffer. If a buffer exists visiting FILENAME, return that one, but @@ -1863,7 +1917,8 @@ the various files." (setq buf other)))) ;; Check to see if the file looks uncommonly large. (when (not (or buf nowarn)) - (abort-if-file-too-large (nth 7 attributes) "open" filename)) + (abort-if-file-too-large (nth 7 attributes) "open" filename) + (warn-maybe-out-of-memory (nth 7 attributes))) (if buf ;; We are using an existing buffer. (let (nonexistent) @@ -2073,7 +2128,7 @@ This function ensures that none of these modifications will take place." (defun insert-file-1 (filename insert-func) (if (file-directory-p filename) - (signal 'file-error (list "Opening input file" "file is a directory" + (signal 'file-error (list "Opening input file" "Is a directory" filename))) ;; Check whether the file is uncommonly large (abort-if-file-too-large (nth 7 (file-attributes filename)) "insert" filename) @@ -2091,9 +2146,9 @@ This function ensures that none of these modifications will take place." This function is meant for the user to run interactively. Don't call it from programs! Use `insert-file-contents-literally' instead. \(Its calling sequence is different; see its documentation)." + (declare (interactive-only insert-file-contents-literally)) (interactive "*fInsert file literally: ") (insert-file-1 filename #'insert-file-contents-literally)) -(put 'insert-file-literally 'interactive-only 'insert-file-contents-literally) (defvar find-file-literally nil "Non-nil if this buffer was made by `find-file-literally' or equivalent. @@ -2337,7 +2392,7 @@ since only a single case-insensitive search through the alist is made." ("[cC]hange[lL]og[-.][0-9]+\\'" . change-log-mode) ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) ("\\.scm\\.[0-9]*\\'" . scheme-mode) - ("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode) + ("\\.[ckz]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode) ("\\.bash\\'" . sh-mode) ("\\(/\\|\\`\\)\\.\\(bash_\\(profile\\|history\\|log\\(in\\|out\\)\\)\\|z?log\\(in\\|out\\)\\)\\'" . sh-mode) ("\\(/\\|\\`\\)\\.\\(shrc\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode) @@ -2393,17 +2448,16 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode) ("\\.dbk\\'" . xml-mode) ("\\.dtd\\'" . sgml-mode) ("\\.ds\\(ss\\)?l\\'" . dsssl-mode) - ("\\.js\\'" . javascript-mode) + ("\\.jsm?\\'" . javascript-mode) ("\\.json\\'" . javascript-mode) ("\\.[ds]?vh?\\'" . verilog-mode) ("\\.by\\'" . bovine-grammar-mode) ("\\.wy\\'" . wisent-grammar-mode) ;; .emacs or .gnus or .viper following a directory delimiter in - ;; Unix, MSDOG or VMS syntax. - ("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode) + ;; Unix or MS-DOS syntax. + ("[:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode) ("\\`\\..*emacs\\'" . emacs-lisp-mode) - ;; _emacs following a directory delimiter - ;; in MsDos syntax + ;; _emacs following a directory delimiter in MS-DOS syntax ("[:/]_emacs\\'" . emacs-lisp-mode) ("/crontab\\.X*[0-9]+\\'" . shell-script-mode) ("\\.ml\\'" . lisp-mode) @@ -2426,7 +2480,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode) ("\\.\\(asn\\|mib\\|smi\\)\\'" . snmp-mode) ("\\.\\(as\\|mi\\|sm\\)2\\'" . snmpv2-mode) ("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode) - ("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MSDOG + ("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MS-DOS ("\\.[eE]?[pP][sS]\\'" . ps-mode) ("\\.\\(?:PDF\\|DVI\\|OD[FGPST]\\|DOCX?\\|XLSX?\\|PPTX?\\|pdf\\|djvu\\|dvi\\|od[fgpst]\\|docx?\\|xlsx?\\|pptx?\\)\\'" . doc-view-mode-maybe) ("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode) @@ -2457,7 +2511,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode) ("/\\.\\(?:enigma\\|gltron\\|gtk\\|hxplayer\\|net\\|neverball\\|qt/.+\\|realplayer\\|scummvm\\|sversion\\|sylpheed/.+\\|xmp\\)rc\\'" . conf-mode) ("/\\.\\(?:gdbtkinit\\|grip\\|orbital/.+txt\\|rhosts\\|tuxracer/options\\)\\'" . conf-mode) ("/\\.?X\\(?:default\\|resource\\|re\\)s\\>" . conf-xdefaults-mode) - ("/X11.+app-defaults/" . conf-xdefaults-mode) + ("/X11.+app-defaults/\\|\\.ad\\'" . conf-xdefaults-mode) ("/X11.+locale/.+/Compose\\'" . conf-colon-mode) ;; this contains everything twice, with space and with colon :-( ("/X11.+locale/compose\\.dir\\'" . conf-javaprop-mode) @@ -2520,6 +2574,7 @@ and `magic-mode-alist', which determines modes based on file contents.") ("[acjkwz]sh" . sh-mode) ("r?bash2?" . sh-mode) ("dash" . sh-mode) + ("mksh" . sh-mode) ("\\(dt\\|pd\\|w\\)ksh" . sh-mode) ("es" . sh-mode) ("i?tcsh" . sh-mode) @@ -3547,7 +3602,9 @@ Returns the new list." "Collect entries from CLASS-VARIABLES into VARIABLES. ROOT is the root directory of the project. Return the new variables list." - (let* ((file-name (buffer-file-name)) + (let* ((file-name (or (buffer-file-name) + ;; Handle non-file buffers, too. + (expand-file-name default-directory))) (sub-file-name (if file-name ;; FIXME: Why not use file-relative-name? (substring file-name (length root))))) @@ -3629,10 +3686,7 @@ VARIABLES list of the class. The list is processed in order. * If the element is of the form (DIRECTORY . LIST), and DIRECTORY is an initial substring of the file's directory, then LIST is applied by recursively following these rules." - (let ((elt (assq class dir-locals-class-alist))) - (if elt - (setcdr elt variables) - (push (cons class variables) dir-locals-class-alist)))) + (setf (alist-get class dir-locals-class-alist) variables)) (defconst dir-locals-file ".dir-locals.el" "File that contains directory-local variables. @@ -3675,10 +3729,9 @@ of no valid cache entry." ;;; (setq locals-file nil)) ;; Find the best cached value in `dir-locals-directory-cache'. (dolist (elt dir-locals-directory-cache) - (when (and (eq t (compare-strings file nil (length (car elt)) - (car elt) nil nil - (memq system-type - '(windows-nt cygwin ms-dos)))) + (when (and (string-prefix-p (car elt) file + (memq system-type + '(windows-nt cygwin ms-dos))) (> (length (car elt)) (length (car dir-elt)))) (setq dir-elt elt))) (if (and dir-elt @@ -4081,31 +4134,26 @@ BACKUPNAME is the backup file name, which is the old file renamed." (file-error nil)))))) (defun backup-buffer-copy (from-name to-name modes extended-attributes) - (let ((umask (default-file-modes))) - (unwind-protect - (progn - ;; Create temp files with strict access rights. It's easy to - ;; loosen them later, whereas it's impossible to close the - ;; time-window of loose permissions otherwise. - (set-default-file-modes ?\700) - (when (condition-case nil - ;; Try to overwrite old backup first. - (copy-file from-name to-name t t t) - (error t)) - (while (condition-case nil - (progn - (when (file-exists-p to-name) - (delete-file to-name)) - (copy-file from-name to-name nil t t) - nil) - (file-already-exists t)) - ;; The file was somehow created by someone else between - ;; `delete-file' and `copy-file', so let's try again. - ;; rms says "I think there is also a possible race - ;; condition for making backup files" (emacs-devel 20070821). - nil))) - ;; Reset the umask. - (set-default-file-modes umask))) + ;; Create temp files with strict access rights. It's easy to + ;; loosen them later, whereas it's impossible to close the + ;; time-window of loose permissions otherwise. + (with-file-modes ?\700 + (when (condition-case nil + ;; Try to overwrite old backup first. + (copy-file from-name to-name t t t) + (error t)) + (while (condition-case nil + (progn + (when (file-exists-p to-name) + (delete-file to-name)) + (copy-file from-name to-name nil t t) + nil) + (file-already-exists t)) + ;; The file was somehow created by someone else between + ;; `delete-file' and `copy-file', so let's try again. + ;; rms says "I think there is also a possible race + ;; condition for making backup files" (emacs-devel 20070821). + nil))) ;; If set-file-extended-attributes fails, fall back on set-file-modes. (unless (and extended-attributes (with-demoted-errors @@ -4528,18 +4576,14 @@ on a DOS/Windows machine, it returns FILENAME in expanded form." (let ((ancestor ".") (filename-dir (file-name-as-directory filename))) (while (not - (or - (eq t (compare-strings filename-dir nil (length directory) - directory nil nil fold-case)) - (eq t (compare-strings filename nil (length directory) - directory nil nil fold-case)))) + (or (string-prefix-p directory filename-dir fold-case) + (string-prefix-p directory filename fold-case))) (setq directory (file-name-directory (substring directory 0 -1)) ancestor (if (equal ancestor ".") ".." (concat "../" ancestor)))) ;; Now ancestor is empty, or .., or ../.., etc. - (if (eq t (compare-strings filename nil (length directory) - directory nil nil fold-case)) + (if (string-prefix-p directory filename fold-case) ;; We matched within FILENAME's directory part. ;; Add the rest of FILENAME onto ANCESTOR. (let ((rest (substring filename (length directory)))) @@ -4595,7 +4639,7 @@ See the subroutine `basic-save-buffer' for more information." ;; then Rmail-mbox never displays it due to buffer swapping. If ;; the test is ever re-introduced, be sure to handle saving of ;; Rmail files. - (if (and modp (buffer-file-name)) + (if (and modp (buffer-file-name) (not noninteractive)) (message "Saving file %s..." (buffer-file-name))) (basic-save-buffer) (and modp (memq arg '(4 64)) (setq buffer-backed-up nil)))) @@ -4737,7 +4781,7 @@ Before and after saving the buffer, this function runs ;; Support VC `implicit' locking. (vc-after-save) (run-hooks 'after-save-hook)) - (message "(No changes need to be saved)")))) + (or noninteractive (message "(No changes need to be saved)"))))) ;; This does the "real job" of writing a buffer into its visited file ;; and making a backup file. This is what is normally done @@ -4997,6 +5041,7 @@ With prefix ARG, mark buffer as modified, so \\[save-buffer] will save. It is not a good idea to use this function in Lisp programs, because it prints a message in the minibuffer. Instead, use `set-buffer-modified-p'." + (declare (interactive-only set-buffer-modified-p)) (interactive "P") (message (if arg "Modification-flag set" "Modification-flag cleared")) @@ -5017,9 +5062,9 @@ Set mark after the inserted text. This function is meant for the user to run interactively. Don't call it from programs! Use `insert-file-contents' instead. \(Its calling sequence is different; see its documentation)." + (declare (interactive-only insert-file-contents)) (interactive "*fInsert file: ") (insert-file-1 filename #'insert-file-contents)) -(put 'insert-file 'interactive-only 'insert-file-contents) (defun append-to-file (start end filename) "Append the contents of the region to the end of file FILENAME. @@ -5988,10 +6033,9 @@ default directory. However, if FULL is non-nil, they are absolute." (file-expand-wildcards (directory-file-name dirpart))) (list dirpart))) contents) - (while dirs - (when (or (null (car dirs)) ; Possible if DIRPART is not wild. - (and (file-directory-p (directory-file-name (car dirs))) - (file-readable-p (car dirs)))) + (dolist (dir dirs) + (when (or (null dir) ; Possible if DIRPART is not wild. + (file-accessible-directory-p dir)) (let ((this-dir-contents ;; Filter out "." and ".." (delq nil @@ -5999,16 +6043,15 @@ default directory. However, if FULL is non-nil, they are absolute." (unless (string-match "\\`\\.\\.?\\'" (file-name-nondirectory name)) name)) - (directory-files (or (car dirs) ".") full + (directory-files (or dir ".") full (wildcard-to-regexp nondir)))))) (setq contents (nconc - (if (and (car dirs) (not full)) - (mapcar (function (lambda (name) (concat (car dirs) name))) + (if (and dir (not full)) + (mapcar #'(lambda (name) (concat dir name)) this-dir-contents) this-dir-contents) - contents)))) - (setq dirs (cdr dirs))) + contents))))) contents))) ;; Let Tramp know that `file-expand-wildcards' does not need an advice. @@ -6866,15 +6909,11 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, trash-info-dir filename)) ;; Ensure that the trash directory exists; otherwise, create it. - (let ((saved-default-file-modes (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes #o700) - (unless (file-exists-p trash-files-dir) - (make-directory trash-files-dir t)) - (unless (file-exists-p trash-info-dir) - (make-directory trash-info-dir t))) - (set-default-file-modes saved-default-file-modes))) + (with-file-modes #o700 + (unless (file-exists-p trash-files-dir) + (make-directory trash-files-dir t)) + (unless (file-exists-p trash-info-dir) + (make-directory trash-info-dir t))) ;; Try to move to trash with .trashinfo undo information (save-excursion diff --git a/lisp/find-cmd.el b/lisp/find-cmd.el index 042a3840452..7230761f657 100644 --- a/lisp/find-cmd.el +++ b/lisp/find-cmd.el @@ -39,6 +39,8 @@ ;;; Code: +(require 'grep) + (defconst find-constituents '((and . find-and) (not . find-not) @@ -145,13 +147,15 @@ For example: `default-directory' is used as the initial search path. The result is a string that should be ready for the command line." - (concat - "find " (shell-quote-argument (expand-file-name default-directory)) " " - (cond - ((cdr subfinds) - (mapconcat 'find-to-string subfinds "")) - (t - (find-to-string (car subfinds)))))) + ;; FIXME: Provide a version that returns a list of strings (ready to pass to + ;; call-process). + (concat find-program " " + (shell-quote-argument (expand-file-name default-directory)) " " + (cond + ((cdr subfinds) + (mapconcat #'find-to-string subfinds "")) + (t + (find-to-string (car subfinds)))))) (defun find-and (form) "And FORMs together, so: @@ -161,7 +165,7 @@ will produce: (if (< (length form) 2) (find-to-string (car form)) (concat "\\( " - (mapconcat 'find-to-string form "-and ") + (mapconcat #'find-to-string form "-and ") "\\) "))) (defun find-or (form) @@ -172,7 +176,7 @@ will produce: (if (< (length form) 2) (find-to-string (car form)) (concat "\\( " - (mapconcat 'find-to-string form "-or ") + (mapconcat #'find-to-string form "-or ") "\\) "))) (defun find-not (form) @@ -183,7 +187,7 @@ will produce: If you wanted the FORMs -and(ed) together instead then this would suffice: \(not \(and \(mtime \"+1\"\) \(name \"something\"\)\)\)" - (concat "-not " (find-or (mapcar 'find-to-string form)))) + (concat "-not " (find-or (mapcar #'find-to-string form)))) (defun find-prune (form) "-or together FORMs postfix '-prune' and then -or that with a @@ -194,7 +198,7 @@ will produce (unwrapped): -prune -or -true \\\) -and -name '*.pm' \\\)" (find-or (list - (concat (find-or (mapcar 'find-to-string form)) (find-generic "prune")) + (concat (find-or (mapcar #'find-to-string form)) (find-generic "prune")) (find-generic "true")))) (defun find-generic (option &optional oper argcount args dont-quote) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index e19130f0a8a..6ec6c9f1196 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -601,14 +601,14 @@ This is normally set via `font-lock-defaults'.") Currently, valid mode names are `fast-lock-mode', `jit-lock-mode' and `lazy-lock-mode'. This is normally set via `font-lock-defaults'.") -(defvar font-lock-multiline nil +(defvar-local font-lock-multiline nil "Whether font-lock should cater to multiline keywords. If nil, don't try to handle multiline patterns. If t, always handle multiline patterns. If `undecided', don't try to handle multiline patterns until you see one. Major/minor modes can set this variable if they know which option applies.") -(defvar font-lock-fontified nil) ; Whether we have fontified the buffer. +(defvar-local font-lock-fontified nil) ; Whether we have fontified the buffer. ;; Font Lock mode. @@ -626,6 +626,8 @@ Major/minor modes can set this variable if they know which option applies.") ;; Shut up the byte compiler. (defvar font-lock-face-attributes)) ; Obsolete but respected if set. +(defvar-local font-lock-set-defaults nil) ; Whether we have set up defaults. + (defun font-lock-specified-p (mode) "Return non-nil if the current buffer is ready for fontification. The MODE argument, if non-nil, means Font Lock mode is about to @@ -634,7 +636,6 @@ be enabled." (and (boundp 'font-lock-keywords) font-lock-keywords) (and mode - (boundp 'font-lock-set-defaults) font-lock-set-defaults font-lock-major-mode (not (eq font-lock-major-mode major-mode))))) @@ -921,6 +922,14 @@ The value of this variable is used when Font Lock mode is turned on." ;; Prepare for jit-lock (remove-hook 'after-change-functions 'font-lock-after-change-function t) + (set (make-local-variable 'font-lock-flush-function) + 'jit-lock-refontify) + (set (make-local-variable 'font-lock-ensure-function) + 'jit-lock-fontify-now) + ;; Prevent font-lock-fontify-buffer from fontifying eagerly the whole + ;; buffer. This is important for things like CWarn mode which + ;; adds/removes a few keywords and does a refontify (which takes ages on + ;; large files). (set (make-local-variable 'font-lock-fontify-buffer-function) 'jit-lock-refontify) ;; Don't fontify eagerly (and don't abort if the buffer is large). @@ -1025,12 +1034,23 @@ This function should preserve the match-data. The region it returns may start or end in the middle of a line.") (make-variable-buffer-local 'font-lock-extend-after-change-region-function) -(defun font-lock-fontify-buffer () +(defun font-lock-fontify-buffer (&optional interactively) "Fontify the current buffer the way the function `font-lock-mode' would." - (interactive) + (declare + ;; When called from Lisp, this function is a big mess. The caller usually + ;; expects one of the following behaviors: + ;; - refresh the highlighting (because the font-lock-keywords have been + ;; changed). + ;; - apply font-lock highlighting even if font-lock-mode is not enabled. + ;; - reset the highlighting rules because font-lock-defaults + ;; has been changed (and then rehighlight everything). + ;; Of course, this function doesn't do all of the above in all situations + ;; (e.g. depending on whether jit-lock is in use) and it can't guess what + ;; the caller wants. + (interactive-only "use `font-lock-ensure' or `font-lock-flush' instead.")) + (interactive "p") (font-lock-set-defaults) - (let ((font-lock-verbose (or font-lock-verbose - (called-interactively-p 'interactive)))) + (let ((font-lock-verbose (or font-lock-verbose interactively))) (funcall font-lock-fontify-buffer-function))) (defun font-lock-unfontify-buffer () @@ -1049,6 +1069,31 @@ This works by calling `font-lock-unfontify-region-function'." (save-buffer-state (funcall font-lock-unfontify-region-function beg end))) +(defvar font-lock-flush-function #'font-lock-after-change-function + "Function to use to mark a region for refontification. +Called with two arguments BEG and END.") + +(defun font-lock-flush (&optional beg end) + "Declare the region BEG...END's fontification as out-of-date. +If the region is not specified, it defaults to the whole buffer." + (and font-lock-mode + font-lock-fontified + (funcall font-lock-flush-function + (or beg (point-min)) (or end (point-max))))) + +(defvar font-lock-ensure-function + (lambda (_beg _end) + (unless font-lock-fontified (font-lock-default-fontify-buffer))) + "Function to make sure a region has been fontified. +Called with two arguments BEG and END.") + +(defun font-lock-ensure (&optional beg end) + "Make sure the region BEG...END has been fontified. +If the region is not specified, it defaults to the whole buffer." + (font-lock-set-defaults) + (funcall font-lock-ensure-function + (or beg (point-min)) (or end (point-max)))) + (defun font-lock-default-fontify-buffer () "Fontify the whole buffer using `font-lock-fontify-region-function'." (let ((verbose (if (numberp font-lock-verbose) @@ -1059,7 +1104,7 @@ This works by calling `font-lock-unfontify-region-function'." (format "Fontifying %s..." (buffer-name))) ;; Make sure we fontify etc. in the whole buffer. (save-restriction - (widen) + (unless font-lock-dont-widen (widen)) (condition-case nil (save-excursion (save-match-data @@ -1201,7 +1246,7 @@ This function is the default `font-lock-unfontify-region-function'." '(face font-lock-multiline))))) ;; Called when any modification is made to buffer text. -(defun font-lock-after-change-function (beg end old-len) +(defun font-lock-after-change-function (beg end &optional old-len) (save-excursion (let ((inhibit-point-motion-hooks t) (inhibit-quit t) @@ -1714,7 +1759,7 @@ If SYNTACTIC-KEYWORDS is non-nil, it means these keywords are used for keywords (setq keywords (cons t (cons keywords - (mapcar 'font-lock-compile-keyword keywords)))) + (mapcar #'font-lock-compile-keyword keywords)))) (if (and (not syntactic-keywords) (let ((beg-function (or font-lock-beginning-of-syntax-function @@ -1738,7 +1783,7 @@ If SYNTACTIC-KEYWORDS is non-nil, it means these keywords are used for keywords)) (defun font-lock-compile-keyword (keyword) - (cond ((nlistp keyword) ; MATCHER + (cond ((or (functionp keyword) (nlistp keyword)) ; MATCHER (list keyword '(0 font-lock-keyword-face))) ((eq (car keyword) 'eval) ; (eval . FORM) (font-lock-compile-keyword (eval (cdr keyword)))) @@ -1786,8 +1831,6 @@ A LEVEL of nil is equal to a LEVEL of 0, a LEVEL of t is equal to (t (car keywords)))) -(defvar font-lock-set-defaults nil) ; Whether we have set up defaults. - (defun font-lock-refresh-defaults () "Restart fontification in current buffer after recomputing from defaults. Recompute fontification variables using `font-lock-defaults' and @@ -1815,9 +1858,7 @@ Sets various variables using `font-lock-defaults' and (unless (and font-lock-set-defaults (eq font-lock-major-mode major-mode)) (setq font-lock-major-mode major-mode) - (set (make-local-variable 'font-lock-set-defaults) t) - (make-local-variable 'font-lock-fontified) - (make-local-variable 'font-lock-multiline) + (setq font-lock-set-defaults t) (let* ((defaults font-lock-defaults) (keywords (font-lock-choose-keywords (nth 0 defaults) @@ -1825,7 +1866,6 @@ Sets various variables using `font-lock-defaults' and (local (cdr (assq major-mode font-lock-keywords-alist))) (removed-keywords (cdr-safe (assq major-mode font-lock-removed-keywords-alist)))) - (set (make-local-variable 'font-lock-defaults) defaults) ;; Syntactic fontification? (if (nth 1 defaults) (set (make-local-variable 'font-lock-keywords-only) t) @@ -1868,7 +1908,8 @@ Sets various variables using `font-lock-defaults' and ;; Now compile the keywords. (unless (eq (car font-lock-keywords) t) (setq font-lock-keywords - (font-lock-compile-keywords font-lock-keywords)))))) + (font-lock-compile-keywords font-lock-keywords)))) + (font-lock-flush))) ;;; Color etc. support. diff --git a/lisp/frame.el b/lisp/frame.el index c77df558da8..1d5bbf2317e 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1,4 +1,4 @@ -;;; frame.el --- multi-frame management independent of window systems +;;; frame.el --- multi-frame management independent of window systems -*- lexical-binding:t -*- ;; Copyright (C) 1993-1994, 1996-1997, 2000-2015 Free Software ;; Foundation, Inc. @@ -27,21 +27,39 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) -(defvar frame-creation-function-alist - (list (cons nil - (if (fboundp 'tty-create-frame-with-faces) - 'tty-create-frame-with-faces - (lambda (_parameters) - (error "Can't create multiple frames without a window system"))))) - "Alist of window-system dependent functions to call to create a new frame. +;; Dispatch tables for GUI methods. + +(defun gui-method--name (base) + (intern (format "%s-alist" base))) + +(defmacro gui-method (name &optional type) + (macroexp-let2 nil type (or type `window-system) + `(alist-get ,type ,(gui-method--name name) + (lambda (&rest _args) + (error "No method %S for %S frame" ',name ,type))))) + +(defmacro gui-method-define (name type fun) + `(setf (gui-method ,name ',type) ,fun)) + +(defmacro gui-method-declare (name &optional tty-fun doc) + (declare (doc-string 3) (indent 2)) + `(defvar ,(gui-method--name name) + ,(if tty-fun `(list (cons nil ,tty-fun))) ,doc)) + +(defmacro gui-call (name &rest args) + `(funcall (gui-method ,name) ,@args)) + +(gui-method-declare frame-creation-function + #'tty-create-frame-with-faces + "Method for window-system dependent functions to create a new frame. The window system startup file should add its frame creation -function to this list, which should take an alist of parameters +function to this method, which should take an alist of parameters as its argument.") (defvar window-system-default-frame-alist nil "Window-system dependent default frame parameters. The value should be an alist of elements (WINDOW-SYSTEM . ALIST), -where WINDOW-SYSTEM is a window system symbol (see `window-system') +where WINDOW-SYSTEM is a window system symbol (as returned by `framep') and ALIST is a frame parameter alist like `default-frame-alist'. Then, for frames on WINDOW-SYSTEM, any parameters specified in ALIST supersede the corresponding parameters specified in @@ -149,12 +167,6 @@ This function runs the hook `focus-out-hook'." ;; 3) Once the init file is done, we apply any newly set parameters ;; in initial-frame-alist to the frame. -;; These are now called explicitly at the proper times, -;; since that is easier to understand. -;; Actually using hooks within Emacs is bad for future maintenance. --rms. -;; (add-hook 'before-init-hook 'frame-initialize) -;; (add-hook 'window-setup-hook 'frame-notice-user-settings) - ;; If we create the initial frame, this is it. (defvar frame-initial-frame nil) @@ -181,10 +193,6 @@ This function runs the hook `focus-out-hook'." (progn (setq frame-initial-frame-alist (append initial-frame-alist default-frame-alist nil)) - (or (assq 'horizontal-scroll-bars frame-initial-frame-alist) - (setq frame-initial-frame-alist - (cons '(horizontal-scroll-bars . t) - frame-initial-frame-alist))) (setq frame-initial-frame-alist (cons (cons 'window-system initial-window-system) frame-initial-frame-alist)) @@ -263,59 +271,45 @@ there (in decreasing order of priority)." ;; If the initial frame is still around, apply initial-frame-alist ;; and default-frame-alist to it. (when (frame-live-p frame-initial-frame) - ;; When tool-bar has been switched off, correct the frame size ;; by the lines added in x-create-frame for the tool-bar and ;; switch `tool-bar-mode' off. (when (display-graphic-p) - (let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist) - (assq 'tool-bar-lines window-system-frame-alist) - (assq 'tool-bar-lines default-frame-alist)))) - (when (and tool-bar-originally-present - (or (null tool-bar-lines) - (null (cdr tool-bar-lines)) - (eq 0 (cdr tool-bar-lines)))) - (let* ((char-height (frame-char-height frame-initial-frame)) - (image-height tool-bar-images-pixel-height) - (margin (cond ((and (consp tool-bar-button-margin) - (integerp (cdr tool-bar-button-margin)) - (> tool-bar-button-margin 0)) - (cdr tool-bar-button-margin)) - ((and (integerp tool-bar-button-margin) - (> tool-bar-button-margin 0)) - tool-bar-button-margin) - (t 0))) - (relief (if (and (integerp tool-bar-button-relief) - (> tool-bar-button-relief 0)) - tool-bar-button-relief 3)) - (lines (/ (+ image-height - (* 2 margin) - (* 2 relief) - (1- char-height)) - char-height)) - (height (frame-parameter frame-initial-frame 'height)) - (newparms (list (cons 'height (- height lines)))) - (initial-top (cdr (assq 'top - frame-initial-geometry-arguments))) + (let* ((init-lines + (assq 'tool-bar-lines initial-frame-alist)) + (other-lines + (or (assq 'tool-bar-lines window-system-frame-alist) + (assq 'tool-bar-lines default-frame-alist))) + (lines (or init-lines other-lines)) + (height (tool-bar-height frame-initial-frame t))) + ;; Adjust frame top if either zero (nil) tool bar lines have + ;; been requested in the most relevant of the frame's alists + ;; or tool bar mode has been explicitly turned off in the + ;; user's init file. + (when (and (> height 0) + (or (and lines + (or (null (cdr lines)) + (eq 0 (cdr lines)))) + (not tool-bar-mode))) + (let* ((initial-top + (cdr (assq 'top frame-initial-geometry-arguments))) (top (frame-parameter frame-initial-frame 'top))) (when (and (consp initial-top) (eq '- (car initial-top))) (let ((adjusted-top - (cond ((and (consp top) - (eq '+ (car top))) - (list '+ - (+ (cadr top) - (* lines char-height)))) - ((and (consp top) - (eq '- (car top))) - (list '- - (- (cadr top) - (* lines char-height)))) - (t (+ top (* lines char-height)))))) - (setq newparms - (append newparms - `((top . ,adjusted-top)) - nil)))) - (modify-frame-parameters frame-initial-frame newparms) + (cond + ((and (consp top) (eq '+ (car top))) + (list '+ (+ (cadr top) height))) + ((and (consp top) (eq '- (car top))) + (list '- (- (cadr top) height))) + (t (+ top height))))) + (modify-frame-parameters + frame-initial-frame `((top . ,adjusted-top)))))) + ;; Reset `tool-bar-mode' when zero tool bar lines have been + ;; requested for the window-system or default frame alists. + (when (and tool-bar-mode + (and other-lines + (or (null (cdr other-lines)) + (eq 0 (cdr other-lines))))) (tool-bar-mode -1))))) ;; The initial frame we create above always has a minibuffer. @@ -657,29 +651,27 @@ the new frame according to its own rules." (interactive) (let* ((display (cdr (assq 'display parameters))) (w (cond - ((assq 'terminal parameters) - (let ((type (terminal-live-p (cdr (assq 'terminal parameters))))) - (cond - ((eq type t) nil) - ((eq type nil) (error "Terminal %s does not exist" - (cdr (assq 'terminal parameters)))) - (t type)))) - ((assq 'window-system parameters) - (cdr (assq 'window-system parameters))) + ((assq 'terminal parameters) + (let ((type (terminal-live-p + (cdr (assq 'terminal parameters))))) + (cond + ((eq t type) nil) + ((null type) (error "Terminal %s does not exist" + (cdr (assq 'terminal parameters)))) + (t type)))) + ((assq 'window-system parameters) + (cdr (assq 'window-system parameters))) (display (or (window-system-for-display display) (error "Don't know how to interpret display %S" display))) - (t window-system))) - (frame-creation-function (cdr (assq w frame-creation-function-alist))) + (t window-system))) (oldframe (selected-frame)) (params parameters) frame) - (unless frame-creation-function - (error "Don't know how to create a frame on window system %s" w)) (unless (get w 'window-system-initialized) - (funcall (cdr (assq w window-system-initialization-alist)) display) + (funcall (gui-method window-system-initialization w) display) (setq x-display-name display) (put w 'window-system-initialized t)) @@ -693,13 +685,23 @@ the new frame according to its own rules." (push p params))) ;; Now make the frame. (run-hooks 'before-make-frame-hook) - (setq frame (funcall frame-creation-function params)) + +;; (setq frame-adjust-size-history '(t)) + + (setq frame + (funcall (gui-method frame-creation-function w) params)) (normal-erase-is-backspace-setup-frame frame) ;; Inherit the original frame's parameters. (dolist (param frame-inherited-parameters) (unless (assq param parameters) ;Overridden by explicit parameters. (let ((val (frame-parameter oldframe param))) (when val (set-frame-parameter frame param val))))) + + (when (eq (car frame-adjust-size-history) t) + (setq frame-adjust-size-history + (cons t (cons (list "Frame made") + (cdr frame-adjust-size-history))))) + (run-hook-with-args 'after-make-frame-functions frame) frame)) @@ -1276,16 +1278,18 @@ On graphical displays, it is displayed on the frame's title bar." (list (cons 'name name)))) (defun frame-current-scroll-bars (&optional frame) - "Return the current scroll-bar settings in frame FRAME. -Value is a cons (VERTICAL . HORIZ0NTAL) where VERTICAL specifies the -current location of the vertical scroll-bars (left, right, or nil), -and HORIZONTAL specifies the current location of the horizontal scroll -bars (top, bottom, or nil)." - (let ((vert (frame-parameter frame 'vertical-scroll-bars)) - (hor nil)) - (unless (memq vert '(left right nil)) - (setq vert default-frame-scroll-bars)) - (cons vert hor))) + "Return the current scroll-bar types for frame FRAME. +Value is a cons (VERTICAL . HORIZ0NTAL) where VERTICAL specifies +the current location of the vertical scroll-bars (`left', `right' +or nil), and HORIZONTAL specifies the current location of the +horizontal scroll bars (`bottom' or nil). FRAME must specify a +live frame and defaults to the selected one." + (let* ((frame (window-normalize-frame frame)) + (vertical (frame-parameter frame 'vertical-scroll-bars)) + (horizontal (frame-parameter frame 'horizontal-scroll-bars))) + (unless (memq vertical '(left right nil)) + (setq vertical default-frame-scroll-bars)) + (cons vertical (and horizontal 'bottom)))) (defun frame-monitor-attributes (&optional frame) "Return the attributes of the physical monitor dominating FRAME. @@ -1368,8 +1372,8 @@ frame's display)." (let ((frame-type (framep-on-display display))) (cond ((eq frame-type 'pc) - ;; MS-DOG frames support selections when Emacs runs inside - ;; the Windows' DOS Box. + ;; MS-DOS frames support selections when Emacs runs inside + ;; a Windows DOS Box. (with-no-warnings (not (null dos-windows-version)))) ((memq frame-type '(x w32 ns)) diff --git a/lisp/frameset.el b/lisp/frameset.el index e75e69f12fc..4a0637439db 100644 --- a/lisp/frameset.el +++ b/lisp/frameset.el @@ -664,10 +664,7 @@ nil while the filtering is done to restore it." ;; Set the display parameter after filtering, so that filter functions ;; have access to its original value. (when frameset--target-display - (let ((display (assq 'display filtered))) - (if display - (setcdr display (cdr frameset--target-display)) - (push frameset--target-display filtered)))) + (setf (alist-get 'display filtered) (cdr frameset--target-display))) filtered)) @@ -1266,6 +1263,17 @@ Called from `jump-to-register'. Internal use only." (with-current-buffer buffer (goto-char (aref data 2))))))) ;;;###autoload +(defun frameset--print-register (data) + "Print basic info about frameset stored in DATA. +Called from `list-registers' and `view-register'. Internal use only." + (let* ((fs (aref data 0)) + (ns (length (frameset-states fs)))) + (princ (format "a frameset (%d frame%s, saved on %s)." + ns + (if (= 1 ns) "" "s") + (format-time-string "%c" (frameset-timestamp fs)))))) + +;;;###autoload (defun frameset-to-register (register) "Store the current frameset in register REGISTER. Use \\[jump-to-register] to restore the frameset. @@ -1282,7 +1290,7 @@ Interactively, reads the register using `register-read-with-preview'." ;; in the current buffer, so record that separately. (frameset-frame-id nil) (point-marker)) - :print-func (lambda (_data) (princ "a frameset.")) + :print-func #'frameset--print-register :jump-func #'frameset--jump-to-register))) (provide 'frameset) diff --git a/lisp/fringe.el b/lisp/fringe.el index 298f03fc68f..8f40c46c3d3 100644 --- a/lisp/fringe.el +++ b/lisp/fringe.el @@ -83,9 +83,9 @@ (hollow-small . hollow-square)))) -(defmacro fringe-bitmap-p (symbol) +(defun fringe-bitmap-p (symbol) "Return non-nil if SYMBOL is a fringe bitmap." - `(get ,symbol 'fringe)) + (get symbol 'fringe)) ;; Control presence of fringes diff --git a/lisp/generic-x.el b/lisp/generic-x.el index deb185e9ab5..56e1761ae51 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -1650,7 +1650,7 @@ like an INI file. You can add this hook to `find-file-hook'." (defun named-database-print-serial () "Print a serial number based on the current date." (interactive) - (insert (format-time-string named-database-time-string (current-time))))) + (insert (format-time-string named-database-time-string)))) (when (memq 'resolve-conf-generic-mode generic-extras-enable-list) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 2bdbfcc5c23..7bf4a6e01d6 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,62 +1,632 @@ +2015-01-27 Lars Ingebrigtsen <larsi@gnus.org> + + * nnir.el (nnir-imap-expr-to-imap): Check for literal+ capability in + IMAP. + +2015-01-27 Eric Abrahamsen <eric@ericabrahamsen.net> + + * nnir.el (nnir-run-imap): Enable non-ASCII IMAP searches. + + * nnmairix.el ("nnmairix"): Declare nnmairix as virtual. + + * gnus-bcklg.el (gnus-backlog-enter-article): No virtual groups should + be added to the backlog. + +2015-01-26 Trevor Murphy <trevor.m.murphy@gmail.com> + + * nnimap.el (nnimap-header-parameters): Refactor and request + X-GM-LABELS if it's been announced. + (nnimap-transform-headers): Gather and output GM-LABELS. + +2015-01-26 Peder O. Klingenberg <peder@klingenberg.no> + + * mm-decode.el (mm-display-part): Make non-string methods work. + Non-string methods are funcalled and work just fine, the test was + bogus. + * mm-decode.el (mm-display-external): Show "external" lisp viewers in + whole frame. + +2015-01-26 Lars Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-request-accept-article): Allow respooling using + nnimap. + + * gnus-group.el (gnus-group-get-new-news-this-group): Explicitly + request rescans when being run interactively. + + * nnimap.el (nnimap-request-group): Don't rescan the group here, + because that can be very slow in large groups. + + * gnus-int.el (gnus-request-group-scan): New backend function. + + * nnimap.el (nnimap-request-scan-group): Implement in on IMAP. + +2015-01-25 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus-group.el (gnus-group-suspend): Close all backends. + +2015-01-15 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nntp.el (nntp-send-authinfo): Error out if the password is wrong. + +2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * registry.el: Don't use <class> as a variable. + +2014-12-29 Paul Eggert <eggert@cs.ucla.edu> + + * message.el (message-make-fqdn): + * nnvirtual.el (nnvirtual-retrieve-headers) + (nnvirtual-update-xref-header): Prefer (system-name) to system-name, + and avoid naming locals 'system-name'. + +2014-12-29 Lars Ingebrigtsen <larsi@gnus.org> + + * mm-decode.el (mm-shr): Bind `shr-width' to `fill-column' so that + lines don't get overlong when responding. + 2014-12-19 Andreas Schwab <schwab@linux-m68k.org> - * gnus-group.el (gnus-read-ephemeral-bug-group): Bind - coding-system-for-read and coding-system-for-write only around + * gnus-group.el (gnus-read-ephemeral-bug-group): + Bind coding-system-for-read and coding-system-for-write only around with-temp-file, and make buffer unibyte. Don't write temp file twice. -2014-11-26 John Mastro <john.b.mastro@gmail.com> (tiny change) +2014-12-18 Paul Eggert <eggert@cs.ucla.edu> + + * registry.el (registry-db): Set default slot later. + This is because its value is not a literal integer. + +2014-12-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * mm-util.el (mm-with-unibyte-current-buffer): Mark obsolete and + add warning. + + * gnus-art.el: Fix up compiler warnings. + (article-display-face, article-display-x-face): Remove unused `face'. + (gnus-article-browse-html-save-cid-content): Remove unused var `type'. + (article-date-ut): Remove unused var `first'. + (gnus-article-prepare): Remove unused var `gnus-article'. + (gnus-mime-save-part-and-strip): Remove unused var `param'. + (gnus-mime-inline-part): Remove unused vars `charset', `contents', and + `coding-system' along with corresponding dead code. + (gnus-mime-view-part-externally): Remove unused var + `mm-user-display-methods'. + (gnus-insert-mime-button): Let-bind gnus-tmp-id explicitly. + (gnus-display-mime): Remove unused var `handle'. + (gnus-mime-display-alternative): Remove unused var `props'. + (gnus-article-read-summary-keys): Remove unused var `up-to-top'. + (gnus-article-edit-done): Remove unused var `p'. + (gnus-url-mailto): Remove unused var `to'. + (gnus-treat-article): Let-bind gnus-treat-condition, part-number, + total-parts, and gnus-treat-type explicitly. Remove unused var `elem'. + +2014-12-18 Eric Abrahamsen <eric@ericabrahamsen.net> + + * registry.el (registry-db): Consolidate the :max-hard and :max-soft + slots into a :max-size slot. + (registry-db-version): Add new variable for database version number. + (registry-prune): Use :max-size slot. Accept and use a sort-function + argument. + (registry-collect-prune-candidates): Add new function for finding + non-precious pruning candidates. + (registry-prune-hard-candidates, registry-prune-soft-candidates): + Remove obsolete functions. + (initialize-instance): Upgrade registry version when starting. + + * gnus-registry.el (gnus-registry-prune-factor): Add new variable. + (gnus-registry-max-pruned-entries): Remove obsolete variable. + (gnus-registry-cache-file): Change default + filename extension to "eieio". + (gnus-registry-read): Add new function, split out from + `gnus-registry-load', that does the actual object reading. + (gnus-registry-load): Use it. Add condition case handler to check for + old filename extension and rename to the new one. + (gnus-registry-default-sort-function): New variable to specify a sort + function to use when pruning. + (gnus-registry-save, gnus-registry-insert): Use it. + (gnus-registry-sort-by-creation-time): Define a default sort function. + +2014-12-09 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-art.el (gnus-article-mime-handles): Refactor out into own + function for reuse. + (gnus-mime-buttonize-attachments-in-header): Adjust. + +2014-12-07 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * message.el (message-change-subject): Really check whether the subject + changed. + +2014-12-05 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * mailcap.el (mailcap-mime-data): Add doc-view-mode as a viewer for + PDFs. + (mailcap-view-mime): New function. + +2014-12-01 Glenn Morris <rgm@gnu.org> + + * gnus-cloud.el (gnus-cloud): Add :version tag. + +2014-11-29 John Mastro <john.b.mastro@gmail.com> (tiny change) * auth-source.el (auth-source-macos-keychain-search-items): Return result of `auth-source-macos-keychain-result-append' (bug#19074). -2014-11-10 Adam Sjøgren <asjo@koldfront.dk> +2014-11-27 Katsumi Yamaoka <yamaoka@jpl.org> - * mml2015.el (mml2015-display-key-image): New variable. + * gnus-art.el (gnus-use-idna): + * gnus-sum.el (gnus-summary-idna-message): + * message.el (message-use-idna): + Protect against nil value for idna-program. + + * message.el (message-use-idna): Load Mule-UCS for XEmacs 21.4. + +2014-11-25 Glenn Morris <rgm@gnu.org> + + * gnus-start.el (gnus-save-newsrc-file-check-timestamp): + Add :version tag. + +2014-11-23 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * pop3.el (pop3-open-server): Warn unless encrypted. + + * nnimap.el (nnimap-open-connection-1): Warn unless encrypted. + +2014-11-17 Albert Krewinkel <albert@zeitkraut.de> + + * message.el (message-valid-fqdn-regexp): Add non-internaional new + TLDs. + +2014-11-14 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-sum.el (gnus-summary-exit-no-update): Don't query about + discarding changes in ephemeral groups. + + * ietf-drums.el (ietf-drums-parse-address): Don't issue warnings about + things the user isn't interested in. + +2014-11-13 Julien Danjou <jd@abydos> + + * gnus-notifications.el (gnus-notifications-notify): Provide both + app-icon and image-path. + +2014-11-10 Kenjiro NAKAYAMA <nakayamakenjiro@gmail.com> + + * gnus/mm-url.el (mm-url-encode-multipart-form-data): + Restore to handle "multipart/form-data" by eww. + +2014-11-07 Tassilo Horn <tsdh@gnu.org> + + * gnus-start.el (gnus-activate-group): Fix typo reported by Tim + Landscheidt. + +2014-10-29 Paul Eggert <eggert@cs.ucla.edu> + + Simplify use of current-time and friends. + * gnus-delay.el (gnus-delay-article): + * gnus-sum.el (gnus-summary-read-document): + * gnus-util.el (gnus-seconds-today, gnus-seconds-month): + * message.el (message-make-expires-date): + Omit unnecessary call to current-time. + * gnus-util.el (gnus-float-time): Simplify to an alias because + time-to-seconds now behaves like float-time with respect to nil arg. + (gnus-seconds-year): Don't call current-time twice to get the current + time stamp, as this can lead to inconsistent results. 2014-10-27 Katsumi Yamaoka <yamaoka@jpl.org> * gnus.el (gnus-mode-line-buffer-identification): - Don't add image data for a non-graphic display; - Don't shadow load-path, it blocks autoloading of find-image (bug#18813). + Don't add image data for a non-graphic display (bug#18813). + +2014-10-24 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus.el (gnus-mode-line-buffer-identification): Don't shadow + load-path, it blocks autoloading of find-image (bug#18813). -2014-10-27 enami tsugutomo <tsugutomo.enami@jp.sony.com> +2014-10-24 enami tsugutomo <tsugutomo.enami@jp.sony.com> * nnimap.el (nnimap-wait-for-response): Ignore NOOP response requested to keep connection open (bug#18728). 2014-10-20 Glenn Morris <rgm@gnu.org> - * Version 24.4 released. + * Merge in all changes up to 24.4 release. + +2014-10-15 Jorge A. Alfaro-Murillo <jorge.alfaro-murillo@yale.edu> (tiny change) + + * message.el (message-insert-signature): Use `newline' instead of + inserting explicit "\n". + +2014-10-15 Sylvain Chouleur <sylvain.chouleur@gmail.com> + + * gnus-icalendar.el: Support vcal format timezones. + (gnus-icalendar-event--decode-datefield): Use icalendar functions to + compute dates with associated timezone. + (gnus-icalendar-event-from-ical): Compute all timezones. + +2014-10-14 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-start.el (gnus-save-newsrc-file-check-timestamp): New option to + check the newsrc.eld file's timestamp before saving it. + (gnus-save-newsrc-file): Use it, with a prompt when the newsrc.eld + timestamp has changed to be newer. + +2014-10-06 Jan Tatarik <jan.tatarik@gmail.com> + + * gnus-icalendar.el (gnus-icalendar-identities): + Include message-alternative-emails. + +2014-10-04 Alan Schmitt <alan.schmitt@polytechnique.org> (tiny change) + + * nnimap.el (nnimap-process-expiry-targets): Reverse the list of + expired messages only when it was built in reverse order. + +2014-10-04 Peter Münster <pmlists@free.fr> (tiny change) + + * gnus-delay.el (gnus-delay-send-queue): Remove `gnus-delay-header' + last so it can be used in `message-send-hook'. + +2014-10-02 Daiki Ueno <ueno@gnu.org> + + * mml.el (mml-parse-1): Error out if unknown mode is specified in + <#secure> tag (bug#18513). 2014-09-29 Daiki Ueno <ueno@gnu.org> * mml.el (mml-parse-1): Error out if unknown mode is specified in <#secure> tag (bug#18513). +2014-09-11 Paul Eggert <eggert@cs.ucla.edu> + + * gnus-cloud.el (gnus-cloud-parse-version-1): Fix misspelling + of ":delete". + +2014-08-26 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-browse-html-save-cid-content) + (gnus-article-browse-html-parts): + Revert last change that breaks links other than cid contents. + +2014-08-26 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-browse-html-save-cid-content) + (gnus-article-browse-html-parts): Make cid file names relative. + +2014-08-21 Katsumi Yamaoka <yamaoka@jpl.org> + + * mm-view.el (mm-display-inline-fontify): Make the working buffer + temporarily displayed when running a mode function (at least org-mode + requires it). + +2014-08-14 Alan Schmitt <alan.schmitt@polytechnique.org> + + * gnus-sum.el (gnus-summary-expire-articles): Functions registered to + the gnus-summary-article-expire-hook should be told where the function + is going. In particular, the Gnus registry might want to know. + +2014-08-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * gnus-art.el (gnus-hidden-properties): Drop the evil `intangible'. + +2014-08-06 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-sum.el (gnus-summary-expire-articles): Revert. + +2014-08-05 Eric Abrahamsen <eric@ericabrahamsen.net> + + * gnus-sum.el (gnus-summary-expire-articles): Functions registered to + the gnus-summary-article-expire-hook should be told where the function + is going. In particular, the Gnus registry might want to know. + +2014-07-31 Tassilo Horn <tsdh@gnu.org> + + * gnus-msg.el (gnus-inews-insert-gcc): Allow `gcc-self' to be a list of + groups and t. + +2014-07-22 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-utils.el (gnus-recursive-directory-files): + Unify hard or symbolic links (bug#18063). + +2013-07-17 Albert Krewinkel <albert@zeitkraut.de> + + * gnus-msg.el (gnus-configure-posting-style): + Allow string replacements in values when matching against a header. + +2014-07-07 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-start.el (gnus-dribble-read-file): Don't stop the auto-saving of + the dribble buffer even when it is shrunk a lot. + <http://thread.gmane.org/gmane.emacs.gnus.user/16923> + 2014-06-26 Glenn Morris <rgm@gnu.org> * mm-util.el (help-function-arglist): Remove outdated declaration. -2014-06-22 Andreas Schwab <schwab@linux-m68k.org> +2014-06-24 Andreas Schwab <schwab@linux-m68k.org> * html2text.el (html2text-get-attr): Rewrite to handle spaces in quoted attribute values. (Bug#17834) -2014-05-28 Andreas Schwab <schwab@linux-m68k.org> +2013-06-22 Dmitry Antipov <dmantipov@yandex.ru> + + * gnus-sum.el (gnus-summary-edit-article-done): + Prefer point-marker to copy-marker of point. + +2014-06-05 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-edit-part): Don't modifiy markers. + (gnus-article-read-summary-keys): + Don't bug out when there is no article in the summary buffer. + (gnus-mime-buttonize-attachments-in-header): + Improve criterion that finds parts to display. + + * gnus-art.el (gnus-mm-display-part): + * mm-decode.el (mm-shr): + * mm-view.el (mm-inline-text-html-render-with-w3m, mm-inline-text) + (mm-insert-inline): Revert last changes. + +2014-06-05 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-mm-display-part): + * mm-decode.el (mm-shr): + * mm-view.el (mm-inline-text-html-render-with-w3m, mm-inline-text) + (mm-insert-inline): Set insertion type of end-marker, not only + start-marker, of undisplayer so as to stay after inserted text. + +2014-06-02 Andreas Schwab <schwab@linux-m68k.org> * html2text.el (html2text-get-attr): Fix typo when splitting value from attribute. (Bug#17613) -2014-05-06 Glenn Morris <rgm@gnu.org> +2014-05-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * mm-view.el (mm-display-inline-fontify): Use font-lock-ensure. + * gnus-cite.el (gnus-message-citation-mode): Use font-lock-flush. + +2014-05-15 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-mime-inline-part, gnus-mm-display-part): + Don't delete next part button; keep spacing between buttons. + +2014-05-14 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-mime-inline-part, gnus-mm-display-part): + Work for the last MIME part in an article. + (gnus-mime-display-single): Suppress excessive newlines between parts. + + * mm-uu.el (mm-uu-dissect): Assume that separators may be accompanied + by leading or trailing newline. + +2014-05-09 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-mm-display-part): Don't put article out of sight + while prompting a user for a file name, etc. + (gnus-mime-display-single): Display part with a common appearance no + matter whether MIME button is omitted or not; don't add duplicate entry + to gnus-article-mime-handle-alist. + (gnus-mime-buttonize-attachments-in-header): Use copied buttons. + +2014-05-08 Adam Sjøgren <asjo@koldfront.dk> + + * mml2015.el (mml2015-display-key-image): New variable. + +2014-05-08 Glenn Morris <rgm@gnu.org> * gnus-fun.el (gnus-grab-cam-face): Do not use predictable temp-file name. (http://bugs.debian.org/747100) This is CVE-2014-3421. -2014-05-01 Glenn Morris <rgm@gnu.org> +2014-05-04 Glenn Morris <rgm@gnu.org> * gnus-registry.el (gnus-registry-install-p): Doc fix. +2014-05-02 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-mime-inline-part): Redisplay a button so as to show + the displaying state of a part. + (gnus-mm-display-part): Don't insert a newline in the beginning of + a part like gnus-mime-inline-part doesn't; work for XEmacs. + + * mm-decode.el (mm-display-part): Don't insert a newline in the top. + (mm-shr): Make undisplayer unbreakable. + + * mm-view.el (mm-inline-image-emacs, mm-inline-image-xemacs): + Don't insert excessive newline. + (mm-inline-text-html-render-with-w3m, mm-inline-text) + (mm-insert-inline): Make undisplayer unbreakable. + +2014-05-01 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-mm-display-part): + Highlight header attachment buttons. + +2014-04-30 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-mm-display-part): Don't move point while toggling + a part; redisplay a button (enbugged in 2014-03-23). + +2014-04-27 Teodor Zlatanov <tzz@lifelogs.com> + + * auth-source.el (auth-source-search, auth-source-search-backends): + Treat :max 0 as an indicator that a boolean return is wanted, as + documented. Reported by Joe Bloggs. + +2014-04-20 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-icalendar.el: Require gnus-art. + +2014-04-20 Jan Tatarik <jan.tatarik@gmail.com> + + * gnus-icalendar.el (gnus-icalendar-event->org-entry) + (gnus-icalendar--update-org-event): put event timestamp in + the org entry body instead of the drawer. + (gnus-icalendar-event--get-attendee-names): list of participants should + contain even attendees without common name attribute. + (gnus-icalendar--update-org-event): don't generate duplicates of empty + property tags in org drawers. + +2014-04-15 Katsumi Yamaoka <yamaoka@jpl.org> + + * gmm-utils.el (gmm-format-time-string): New function. + + * message.el (message-insert-formatted-citation-line): Use the original + author's time zone to express a date string. + +2014-04-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * gnus-srvr.el (gnus-tmp-how, gnus-tmp-name, gnus-tmp-where) + (gnus-tmp-status, gnus-tmp-agent, gnus-tmp-cloud) + (gnus-tmp-news-server, gnus-tmp-news-method, gnus-tmp-user-defined): + Silence compiler warnings. + (gnus-server-insert-server-line): Don't use dyn-bind var as argument. + +2014-03-24 Katsumi Yamaoka <yamaoka@jpl.org> + + * mml.el: Require url when compiling. + + * gnus-cloud.el (gnus-cloud-parse-version-1): + Use plist-get rather than CL's getf. + (gnus-activate-group, gnus-subscribe-group): Declare. + + * gnus-sum.el (gnus-mime-buttonize-attachments-in-header): Declare. + +2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-sum.el (gnus-summary-toggle-header): Display header attachment + buttons when toggling the header off. + +2014-03-23 Daiki Ueno <ueno@gnu.org> + + * mml2015.el (mml2015-use): Don't check the availability of GnuPG + commands here; instead, only check if epg-config.el is available. + +2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> + + * mml.el (mml-expand-html-into-multipart-related): Allow sending HTML + messages with embedded images. + (mml-generate-mime): Don't bug out if you don't have libxml. + +2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> + + * message.el (message-make-html-message-with-image-files): New command. + +2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> + + * mml.el (mml-insert-mime-headers): Allow `recipient-filename'. + +2014-03-23 David Engster <deng@randomsample.de> + + * auth-source.el (auth-source-netrc-saver): Do not depend on `cl-lib' + to stay compatible with older Emacsen, so replace `cl-loop' with + `loop'. + +2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-prepare, gnus-article-prepare-display): + Display header attachment buttons by gnus-article-prepare-display + rather than gnus-article-prepare so as to view in mml-preview as well. + +2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-goto-part): Find a button in the body first. + (gnus-mime-buttonize-attachments-in-header): Number hidden buttons. + +2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-mime-buttonize-attachments-in-header): + Display buttons that are hidden in unselected alternative part as well. + (gnus-mime-display-alternative): Redraw attachment buttons in header. + + * gmm-utils.el (gmm-labels): Add edebug spec. + +2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus-srvr.el (gnus-server-toggle-cloud-server): New command and + keystroke. + (gnus-server-toggle-cloud-server): Only allow clouding applicable + types. + +2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus.el (gnus-copy-overlay, gnus-overlays-at): New functions. + + * gnus-art.el (gnus-mime-display-attachment-buttons-in-header): + New user option. + (gnus-mime-buttonize-attachments-in-header): New function. + (gnus-article-prepare): Use it. + (gnus-mime-inline-part): Suppress extra newline. + (gnus-mm-display-part): Save excursion; + remove useless deleting and adding of buttons. + (gnus-insert-mime-button): Allow insertion in the middle of a line. + + * gnus-sum.el (gnus-summary-wash-mime-map, gnus-summary-article-menu): + Add gnus-mime-buttonize-attachments-in-header. + +2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-request-articles): New command to download several + articles at once. + + * gnus.el (gnus-variable-list): Save Cloud variables. + +2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus-cloud.el: New file to provide the Emacs Cloud. + + * gravatar.el (gravatar-retrieve-synchronously): XEmacs also has + `url-retrieve-synchronously', apparently. + + * gnus-notifications.el (gravatar-retrieve-synchronously): Declare for + XEmacs. + + * nnrss.el (libxml-parse-html-region): Silence compilation error. + +2014-03-23 Daniel Dehennin <daniel.dehennin@baby-gnu.org> + + * gnus-mlspl.el (gnus-group-split-fancy): Use `gnus-parameters' in + `gnus-group-split-fancy'. + +2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> + + * message.el (message-remove-header): Doc fix. + (message-forward-included-headers): New variable. + (message-remove-ignored-headers): Use it. + +2014-03-23 Dave Abrahams <dave@boostpro.com> + + * gnus-sum.el (gnus-summary-open-group-with-article): New command. + +2014-03-23 Rasmus Pank Roulund <emacs@pank.eu> + + * gnus-fun.el (gnus-x-face-omit-files): Regexp to omit matched results + from random face commands. + (gnus-face-directory): Like `gnus-x-face-directory` for png files and + Face. + (gnus-face-omit-files): Like `gnus-x-face-omit-files` for Face. + (gnus--random-face-with-type): Generic function returning a face-type + as a string. + (gnus--insert-random-face-with-type): Generic function inserting a face + in a message buffer header. + (gnus-random-x-face): Rewritten to use `gnus--random-face-with-type`. + (gnus-insert-random-x-face-header): Rewritten to use + `gnus--insert-random-face-with-type`. + (gnus-random-face): Return random (png) Face as string. + (nus-insert-random-face-header): Insert random (png) Face in a message + buffer. + +2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> + + * mm-url.el: Remove all usage of w3. + + * nnrss.el: Ditto. + + * mm-decode.el: Ditto. + + * mm-view.el: Ditto. + + * gnus-setup.el: Remove outdated file. + 2014-03-07 Lars Ingebrigtsen <larsi@gnus.org> * nnimap.el (nnimap-request-accept-article): Make respooling to nnimap @@ -152,7 +722,7 @@ * gnus-setup.el (gnus-use-sendmail): We never use sendmail for mail reading. -2014-01-09 Ken Olum <kdo@cosmos.phy.tufts.edu> (tiny change) +2014-01-09 Ken Olum <kdo@cosmos.phy.tufts.edu> * message.el (message-bury): Call bury-buffer with no argument in the message-return-action case too. @@ -276,7 +846,7 @@ * gnus-icalendar.el (gnus-icalendar-event:org-timestamp): Fix org-timestamp for events ending at midnight. -2013-11-21 Ivan Shmakov <ivan@siamics.net> (tiny change) +2013-11-21 Ivan Shmakov <ivan@siamics.net> * nndoc.el (nndoc-type-alist, nndoc-debbugs-db-type-p): Support debbugs .log files. @@ -23950,10 +24520,10 @@ * gnus-group.el: Require gnus-sum and autoload functions to resolve warnings when gnus-group.el compiled alone. - (gnus-group-line-format): Documented new %F. + (gnus-group-line-format): Document new %F. (size of Fetched data) group line format; identifies disk space used by agent and cache. - (gnus-group-line-format-alist): Defined new F format. + (gnus-group-line-format-alist): Define new F format. (gnus-total-fetched-for): New function. (gnus-group-delete-group): No longer update gnus-cache-active-altered as gnus-request-delete-group now keeps diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2 index e6daa5f9749..ce8e1b91e4f 100644 --- a/lisp/gnus/ChangeLog.2 +++ b/lisp/gnus/ChangeLog.2 @@ -41,20 +41,20 @@ * message.el (message-header-synonyms): Defcustom. (message-get-reply-headers): Catch `Original-To'. - (message-carefully-insert-headers): Added comment. + (message-carefully-insert-headers): Add comment. - * gnus-sum.el (gnus-summary-make-menu-bar): Improved "Washing" menu. + * gnus-sum.el (gnus-summary-make-menu-bar): Improve "Washing" menu. 2004-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus-sum.el (gnus-select-newsgroup): Use cat. - * gnus-agent.el (gnus-agent-cat-enable-undownloaded-faces): New - cat. + * gnus-agent.el (gnus-agent-cat-enable-undownloaded-faces): + New cat. - * gnus.el (gnus-user-agent): Moved here. + * gnus.el (gnus-user-agent): Move here. - * gnus-msg.el (gnus-user-agent): Moved from here. + * gnus-msg.el (gnus-user-agent): Move from here. * gnus.el (gnus-version-number): Bump. @@ -104,20 +104,19 @@ topic lines. (gnus-group-set-current-level): Fix fix. -2003-12-31 Jeremy Maitin-Shepard <jbms@attbi.com> +2003-12-31 Jeremy Maitin-Shepard <jbms@attbi.com> (tiny change) - * mml.el (mml-generate-mime-1): Use mml-compute-boundary (tiny - change). + * mml.el (mml-generate-mime-1): Use mml-compute-boundary. 2003-12-30 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-group.el: Removed `(when t ...)' around `gnus-define-keys'. - (gnus-group-group-map): Added `gnus-group-read-ephemeral-group' + * gnus-group.el: Remove `(when t ...)' around `gnus-define-keys'. + (gnus-group-group-map): Add `gnus-group-read-ephemeral-group' (already in previous commit inadvertently). - (gnus-group-make-menu-bar): Added `gnus-group-read-ephemeral-group'. + (gnus-group-make-menu-bar): Add `gnus-group-read-ephemeral-group'. (gnus-group-read-ephemeral-group): Made interactive. - * gnus-score.el (gnus-score-find-trace): Added comment on sync + * gnus-score.el (gnus-score-find-trace): Add comment on sync with `gnus-score-edit-file-at-point'. * gnus-logic.el (gnus-score-advanced): Ditto. @@ -127,8 +126,8 @@ 2003-12-30 Simon Josefsson <jas@extundo.com> - * gnus-score.el (gnus-score-edit-file-at-point): Use - gnus-point-at-*, for portability. + * gnus-score.el (gnus-score-edit-file-at-point): + Use gnus-point-at-*, for portability. 2003-12-30 Reiner Steib <Reiner.Steib@gmx.de> @@ -136,8 +135,8 @@ custom type. (gnus-button-mid-or-mail-regexp): Don't be too restrictive. Suggested by Felix Wiemann <Felix.Wiemann@gmx.net>. - (gnus-button-alist): Added "M-x ... RET" and "mid:" buttons. - Added comments about relevant RFCs. + (gnus-button-alist): Add "M-x ... RET" and "mid:" buttons. + Add comments about relevant RFCs. * gnus-sum.el (gnus-summary-mode): Untabify doc-string. (gnus-summary-goto-article): Allow `%40'. @@ -150,15 +149,15 @@ 2003-12-30 Reiner Steib <Reiner.Steib@gmx.de> - (gnus-score-find-trace): Use gnus-score-edit-file-at-point. Added - `f' and `t' commands, added quick help. With some suggestions + (gnus-score-find-trace): Use gnus-score-edit-file-at-point. + Add `f' and `t' commands, added quick help. With some suggestions from Karl Pflästerer <sigurd@12move.de>. - * gnus-util.el (gnus-emacs-version): Added doc-string. + * gnus-util.el (gnus-emacs-version): Add doc-string. * mml.el (mml-minibuffer-read-disposition): New function. (mml-attach-file): Use it. - (mml-preview): Added MIME preview to gnus-buffers. + (mml-preview): Add MIME preview to gnus-buffers. 2003-12-30 Karl Pflästerer <sigurd@12move.de> @@ -190,7 +189,7 @@ (gnus-agent-auto-agentize-methods): Customize. 2003-12-29 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus.el (gnus-server-to-method): Fixed bug in 2003-12-22 + * gnus.el (gnus-server-to-method): Fix bug in 2003-12-22 check-in. 2003-12-28 Adrian Lanz <lanz@fowi.ethz.ch> @@ -202,8 +201,8 @@ 2003-12-28 Jesper Harder <harder@ifa.au.dk> - * mm-view.el (mm-text-html-washer-alist): Use - mm-inline-wash-with-stdin for w3m-standalone. + * mm-view.el (mm-text-html-washer-alist): + Use mm-inline-wash-with-stdin for w3m-standalone. * mm-decode.el (mm-text-html-renderer): Add w3m-standalone. @@ -226,16 +225,16 @@ 2003-12-22 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-int.el (gnus-open-server): Fixed the server status such + * gnus-int.el (gnus-open-server): Fix the server status such that an agentized server, when opened offline, has a status of offline. Also fixes bug whereby the agent's backend was called twice to open each server. - * gnus-start.el (gnus-get-unread-articles-in-group): Autoload - gnus-agent-possibly-alter-active rather than inline to resolve + * gnus-start.el (gnus-get-unread-articles-in-group): + Autoload gnus-agent-possibly-alter-active rather than inline to resolve compiler warnings. - * gnus.el (gnus-server-to-method): Added fallback of iterating + * gnus.el (gnus-server-to-method): Add fallback of iterating over gnus-newsrc-alist to resolve names of foreign servers. Should fix recent agent bug. @@ -247,8 +246,8 @@ 2003-12-21 Jesper Harder <harder@ifa.au.dk> - * gnus-agent.el (gnus-agent-read-agentview): Use - car-less-than-car. + * gnus-agent.el (gnus-agent-read-agentview): + Use car-less-than-car. 2003-12-20 Artem Chuprina <ran@ran.pp.ru> (tiny change) @@ -267,17 +266,17 @@ 2003-12-18 Reiner Steib <Reiner.Steib@gmx.de> * mm-url.el (mm-url-insert-file-contents-external) - (mm-url-insert-file-contents): Added doc-strings. Autoload. + (mm-url-insert-file-contents): Add doc-strings. Autoload. 2003-12-18 Jesper Harder <harder@ifa.au.dk> - * gnus-cus.el (defvar): Defvar - gnus-agent-cat-disable-undownloaded-faces. + * gnus-cus.el (defvar): + Defvar gnus-agent-cat-disable-undownloaded-faces. 2003-12-17 Katsumi Yamaoka <yamaoka@jpl.org> - * message.el (message-forward-subject-name-subject): Use - gnus-extract-address-components instead of + * message.el (message-forward-subject-name-subject): + Use gnus-extract-address-components instead of mail-header-parse-address because it may be called with non-ascii text. @@ -320,7 +319,7 @@ 2003-12-13 Teodor Zlatanov <tzz@lifelogs.com> - * spam.el: Added some gnus-registry autoloads. + * spam.el: Add some gnus-registry autoloads. (spam-split-symbolic-return): Makes spam-split return 'spam instead of the value of spam-split-group when spam is detected. (spam-split-symbolic-return-positive): Makes spam-split return @@ -345,8 +344,8 @@ (spam-unload-hook): Remove spam-find-spam from gnus-summary-prepare-hook. - * gnus.el (spam-autodetect, spam-autodetect-methods): New - configuration items for spam autodetection. + * gnus.el (spam-autodetect, spam-autodetect-methods): + New configuration items for spam autodetection. 2003-12-12 Reiner Steib <Reiner.Steib@gmx.de> @@ -367,16 +366,16 @@ (gnus-agent-regenerate-group): When necessary, alter the group's active range to include articles newly recognized as being downloaded. - (gnus-agent-regenerate): Removed code that updated the agent's + (gnus-agent-regenerate): Remove code that updated the agent's active file as the new gnus-agent-possibly-alter-active function obsolesced it. - * gnus-cus.el (gnus-agent-customize-category): Added missing + * gnus-cus.el (gnus-agent-customize-category): Add missing agent-disable-undownloaded-faces parameter. * gnus-start.el (gnus-activate-group): Backed out my 2003-11-29 patch as it was too late at adjusting the active range. - (gnus-get-unread-articles-in-group): Added call to new + (gnus-get-unread-articles-in-group): Add call to new gnus-agent-possibly-alter-active to adjust the active range. 2003-12-10 Jesper Harder <harder@ifa.au.dk> @@ -385,10 +384,10 @@ 2003-12-10 Lőrentey Károly <lorentey@elte.hu> - * spam.el (spam-disable-spam-split-during-ham-respool): New - variable. - (spam-ham-copy-or-move-routine): Respect - spam-disable-spam-split-during-ham-respool. + * spam.el (spam-disable-spam-split-during-ham-respool): + New variable. + (spam-ham-copy-or-move-routine): + Respect spam-disable-spam-split-during-ham-respool. (spam-split-disabled): New variable. (spam-split): Respect spam-split-disabled. @@ -412,8 +411,8 @@ 2003-12-09 Xavier Maillard <zedek@gnu-rox.org> - * spam.el (spam-bogofilter-database-directory): Correct - customization group. + * spam.el (spam-bogofilter-database-directory): + Correct customization group. 2003-12-09 Per Abrahamsen <abraham@dina.kvl.dk> @@ -459,8 +458,8 @@ 2003-12-07 Jesper Harder <harder@ifa.au.dk> - * spam.el (spam-check-spamoracle, spam-spamoracle-learn): Don't - use = or zerop to test the return value of call-process, because + * spam.el (spam-check-spamoracle, spam-spamoracle-learn): + Don't use = or zerop to test the return value of call-process, because it can be a string. * mail-source.el (mail-source-fetch-with-program): Do. @@ -505,10 +504,10 @@ 2003-12-01 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-agent.el (gnus-agent-consider-all-articles): Updated - docstring. + * gnus-agent.el (gnus-agent-consider-all-articles): + Update docstring. (gnus-predicate-implies-unread, gnus-predicate-implies-unread-1): - Fixed implementation such that the predicate `true' no longer + Fix implementation such that the predicate `true' no longer evaluates to t. 2003-12-01 Adrian Lanz <lanz@fowi.ethz.ch> (tiny change) @@ -558,14 +557,14 @@ 2003-11-29 Jesper Harder <harder@ifa.au.dk> - * gnus-group.el (gnus-group-make-menu-bar): Add - gnus-group-make-rss-group. + * gnus-group.el (gnus-group-make-menu-bar): + Add gnus-group-make-rss-group. 2003-11-28 Reiner Steib <Reiner.Steib@gmx.de> - * message.el: Added custom-manual links to all variables that have + * message.el: Add custom-manual links to all variables that have an index entry in the message manual. - (message-generate-headers-first): Fixed doc-string. + (message-generate-headers-first): Fix doc-string. 2003-11-27 Katsumi Yamaoka <yamaoka@jpl.org> @@ -611,15 +610,15 @@ (spam-classification-valid-p, spam-process-type-valid-p) (spam-registration-check-valid-p) (spam-unregistration-check-valid-p): Convenience functions. - (spam-registration-function, spam-unregistration-function): Look - up the registration/unregistration function based on a + (spam-registration-function, spam-unregistration-function): + Look up the registration/unregistration function based on a classification and the check (spam-use-* symbol). (spam-list-articles): Generate list of spam/ham articles from a given list of articles. (spam-register-routine): Do the heavy work of registering and unregistering articles, using all the articles in the group or specific ones as needed. - (spam-generic-register-routine): Removed, no longer used. + (spam-generic-register-routine): Remove, no longer used. (spam-log-unregistration-needed-p, spam-log-undo-registration): Handle article registration/unregistration with a given spam/ham processor and group. @@ -642,7 +641,7 @@ parameter is specified. (spam-stat-load): Clear spam-stat-dirty. - * gnus.el (gnus-install-group-spam-parameters): Marked the + * gnus.el (gnus-install-group-spam-parameters): Mark the old-style exit processors as obsolete in the docs, added the new-style exit processors while the old ones are still allowed. @@ -666,23 +665,23 @@ 2003-11-20 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus.el (gnus-agent-covered-methods): Documented use of + * gnus.el (gnus-agent-covered-methods): Document use of named servers, not methods, to identity agentized groups. Users may now change their server configurations without having the server become "unagentized". - (gnus-agent-covered-methods): Removed from gnus-variable-list to + (gnus-agent-covered-methods): Remove from gnus-variable-list to avoid storing two copies of gnus-agent-covered-methods, one in .newsrc.eld and the other in agent/lib/servers. (gnus-server-to-method): Do not cache server for the nil method. (gnus-method-to-server): New function. Associate named server with all, even foreign, methods. - (gnus-agent-method-p, gnus-agent-method-p-cache): Incorporated + (gnus-agent-method-p, gnus-agent-method-p-cache): Incorporate simple last-response cache to offset performance lose of having to always convert methods to named servers. - * gnus-agent.el (gnus-agent-expire-days): Removed obsolete + * gnus-agent.el (gnus-agent-expire-days): Remove obsolete documentation. (gnus-agentize, gnus-agent-add-server, gnus-agent-remove-server): - Modified to support new definition of gnus-agent-covered-method. + Modify to support new definition of gnus-agent-covered-method. (gnus-agent-read-servers): Rewritten to convert old method data into server names. (gnus-agent-read-servers-validate) @@ -701,17 +700,17 @@ (gnus-agent-expire-done-message): New function. (gnus-agent-unread-articles): Bug fix. No longer drops last unread article onto read list. - (gnus-agent-regenerate-group): Changed prompt to use typical + (gnus-agent-regenerate-group): Change prompt to use typical style. (gnus-agent-group-covered-p): Rewrote to internally use gnus-agent-method-p. * gnus-int.el (gnus-start-news-server): Partially convert old gnus-agent-covered-methods to new format so that gnus-open-server functions correctly. - * gnus-srvr.el (gnus-server-insert-server-line): Replaced - gnus-agent-covered-methods with gnus-agent-method-p. - * gnus-start.el (gnus-clear-system): Added - gnus-agent-covered-methods to compensate for removing it from + * gnus-srvr.el (gnus-server-insert-server-line): + Replace gnus-agent-covered-methods with gnus-agent-method-p. + * gnus-start.el (gnus-clear-system): + Add gnus-agent-covered-methods to compensate for removing it from gnus-variable-list. (gnus-setup-news): Complete conversion of old gnus-agent-covered-methods to new format so that secondary and @@ -831,9 +830,9 @@ 2003-11-10 Reiner Steib <Reiner.Steib@gmx.de> - * message.el (message-mode-field-menu): Moved some entries, added + * message.el (message-mode-field-menu): Move some entries, added `message-insert-wide-reply'. - (message-change-subject): Fixed comment. + (message-change-subject): Fix comment. 2003-11-10 Sam Steingold <sds@gnu.org> @@ -876,15 +875,15 @@ requested. (gnus-registry-split-fancy-with-parent): When long names are in use, strip the name if we're in the native server, or else return nothing. - (gnus-registry-spool-action, gnus-registry-action): Use - gnus-group-guess-full-name-from-command-method instead of + (gnus-registry-spool-action, gnus-registry-action): + Use gnus-group-guess-full-name-from-command-method instead of gnus-group-guess-full-name. * spam.el (spam-mark-spam-as-expired-and-move-routine) (spam-ham-copy-or-move-routine): Prevent article deletions or moves unless the backend allows it. - * gnus.el (gnus-install-group-spam-parameters): Fixed parameters + * gnus.el (gnus-install-group-spam-parameters): Fix parameters to list spamoracle as well, suggested by Jean-Marc Lasgouttes <Jean-Marc.Lasgouttes@inria.fr>. @@ -899,7 +898,7 @@ 2003-10-31 Teodor Zlatanov <tzz@lifelogs.com> * spam.el - (spam-log-processing-to-registry): Improved message and comments. + (spam-log-processing-to-registry): Improve message and comments. (spam-log-unregistration-needed-p): New function. (spam-ifile-register-spam-routine) (spam-ifile-register-ham-routine, spam-stat-register-spam-routine) @@ -908,8 +907,8 @@ (spam-whitelist-register-routine) (spam-bogofilter-register-spam-routine) (spam-bogofilter-register-ham-routine) - (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): Change - spam-log-processing-to-registry invocations appropriately. + (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): + Change spam-log-processing-to-registry invocations appropriately. 2003-10-31 Derek Atkins <warlord@MIT.EDU> (tiny change) @@ -936,8 +935,8 @@ (spam-whitelist-register-routine) (spam-bogofilter-register-spam-routine) (spam-bogofilter-register-ham-routine) - (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): Add - spam-log-processing-to-registry invocations. + (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): + Add spam-log-processing-to-registry invocations. * gnus-registry.el: Fixed docs in the preface to mention gnus-registry-initialize. @@ -1002,7 +1001,7 @@ * spam.el (spam-mark-spam-as-expired-and-move-routine) (spam-ham-copy-or-move-routine): Don't ask when deleting copied articles, and use move instead of copy when possible. - (spam-split): Added the option of specifying a string as a + (spam-split): Add the option of specifying a string as a spam-split parameter; such a string will override spam-split-group temporarily. @@ -1017,8 +1016,8 @@ * gnus-art.el (gnus-button-alist): Allow & in mailto URLs. (gnus-header-button-alist): Likewise. (gnus-url-mailto): Handle ?to parameters. Replace \r\n with \n. - Reverse parameter list to use same order as in the URL. Reported - by f95-msv@f.kth.se (Mårten Svantesson). + Reverse parameter list to use same order as in the URL. + Reported by f95-msv@f.kth.se (Mårten Svantesson). 2003-10-25 Teodor Zlatanov <tzz@lifelogs.com> @@ -1036,8 +1035,8 @@ 2003-10-24 Katsumi Yamaoka <yamaoka@jpl.org> - * nndoc.el (nndoc-guess-type): Reverse the sort order. Suggested - by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>. + * nndoc.el (nndoc-guess-type): Reverse the sort order. + Suggested by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>. (nndoc-dissect-buffer): Don't miss even-numbered articles. 2003-10-23 Katsumi Yamaoka <yamaoka@jpl.org> @@ -1054,7 +1053,7 @@ requirement, now just "IP address" is enough for detection for blackhole checking. (spam-check-blackholes): Oops, the dots were not escaped. - (spam-mark-spam-as-expired-and-move-routine): Added multiple group + (spam-mark-spam-as-expired-and-move-routine): Add multiple group support (multiple copies, then delete). (spam-ham-copy-routine): New function. (spam-ham-move-routine): New function. @@ -1086,8 +1085,8 @@ * gnus-art.el (gnus-narrow-to-page): Clear as well as set the value for gnus-page-broken. - * gnus-sum.el (gnus-summary-beginning-of-article): Use - gnus-break-pages instead of gnus-page-broken. + * gnus-sum.el (gnus-summary-beginning-of-article): + Use gnus-break-pages instead of gnus-page-broken. (gnus-summary-end-of-article): Use gnus-break-pages instead of gnus-page-broken; narrow to the end of a page beforehand. (gnus-summary-toggle-header): Use gnus-break-pages instead of @@ -1113,15 +1112,15 @@ * gnus-msg.el (gnus-extended-version): Use it. - * gnus-util.el (gnus-emacs-version): Separated out into own + * gnus-util.el (gnus-emacs-version): Separate out into own function. 2003-10-19 Reiner Steib <Reiner.Steib@gmx.de> - * message.el (message-mode-field-menu): Added - message-generate-unsubscribed-mail-followup-to. + * message.el (message-mode-field-menu): + Add message-generate-unsubscribed-mail-followup-to. (message-forward-subject-fwd): Avoid double "Fwd: ". - (message-change-subject): Added comment. + (message-change-subject): Add comment. 2003-10-19 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -1131,8 +1130,8 @@ 2003-10-19 Katsumi Yamaoka <yamaoka@jpl.org> - * gnus-sum.el (gnus-remove-odd-characters): Use - mm-subst-char-in-string instead of subst-char-in-string. + * gnus-sum.el (gnus-remove-odd-characters): + Use mm-subst-char-in-string instead of subst-char-in-string. (gnus-summary-refer-article): Use gnus-replace-in-string instead of replace-regexp-in-string. @@ -1143,22 +1142,19 @@ 2003-10-18 Jesper Harder <harder@ifa.au.dk> - * gnus-sum.el (gnus-summary-save-parts-last-directory): Default - to mm-default-directory. + * gnus-sum.el (gnus-summary-save-parts-last-directory): + Default to mm-default-directory. (gnus-summary-save-parts-1): Use mm-file-name-rewrite-functions. 2003-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org> - * pop3.el (pop3-read-response): Check whether the process is - alive. + * pop3.el (pop3-read-response): Check whether the process is alive. * gnus-sum.el (gnus-summary-refer-article): Strip spaces. - * rfc2047.el (rfc2047-encode-region): Do error out on invalid - strings. + * rfc2047.el (rfc2047-encode-region): Do error out on invalid strings. - * nntp.el (nntp-retrieve-headers-with-xover): Get error messages - right. + * nntp.el (nntp-retrieve-headers-with-xover): Get error messages right. * gnus-agent.el (gnus-agent-read-servers): Remove sit-for. @@ -1244,8 +1240,8 @@ name for gcc-self. (gnus-inews-insert-archive-gcc): Paren mistake. - * gnus-sum.el (gnus-summary-enter-digest-group): Add - parent-group. + * gnus-sum.el (gnus-summary-enter-digest-group): + Add parent-group. * gnus-art.el (gnus-ignored-headers): Add more headers. @@ -1329,8 +1325,8 @@ 2003-10-06 Jesper Harder <harder@ifa.au.dk> - * gnus.el (gnus-group-faq-directory): Update .tw entry. From - Albert Chun-Chieh Huang <mr894348@cs.nthu.edu.tw> + * gnus.el (gnus-group-faq-directory): Update .tw entry. + From Albert Chun-Chieh Huang <mr894348@cs.nthu.edu.tw> 2003-10-03 Teodor Zlatanov <tzz@lifelogs.com> @@ -1355,7 +1351,7 @@ 2003-10-02 Reiner Steib <Reiner.Steib@gmx.de> - * spam.el (spam-install-hooks-function): Added Autoload cookie. + * spam.el (spam-install-hooks-function): Add Autoload cookie. 2003-10-02 Michael Shields <shields@msrl.com> @@ -1369,8 +1365,7 @@ 2003-10-01 Jesper Harder <harder@ifa.au.dk> - * message.el (message-send): Fix reversed logic of supersedes - check. + * message.el (message-send): Fix reversed logic of supersedes check. 2003-09-30 Reiner Steib <Reiner.Steib@gmx.de> @@ -1464,8 +1459,8 @@ 2003-09-05 Teodor Zlatanov <tzz@lifelogs.com> - * gnus-registry.el (gnus-registry-split-fancy-with-parent): Yet - another error. *sigh* + * gnus-registry.el (gnus-registry-split-fancy-with-parent): + Yet another error. *sigh* * gnus-registry.el (gnus-registry-fetch-extra-entry): Don't use puthash unless gnus-registry-entry-caching is on. @@ -1495,10 +1490,10 @@ (gnus-registry-register-message-ids): Pass subject to gnus-registry-add-group. (gnus-registry-simplify-subject) - (gnus-registry-fetch-simplified-message-subject-fast): New - functions. - (gnus-registry-fetch-extra, gnus-registry-fetch-extra-entry): Add - extra data entry caching. + (gnus-registry-fetch-simplified-message-subject-fast): + New functions. + (gnus-registry-fetch-extra, gnus-registry-fetch-extra-entry): + Add extra data entry caching. (gnus-registry-add-group): Handle the extra subject parameter. (gnus-registry-install-hooks, gnus-registry-unload-hook): Fix the gnus-register-* function names. @@ -1506,27 +1501,27 @@ * nnmail.el (nnmail-cache-insert): Add subject parameter, pass it on to the nnmail-spool-hook. - * nnbabyl.el (nnbabyl-request-accept-article): Added subject to + * nnbabyl.el (nnbabyl-request-accept-article): Add subject to nnmail-cache-insert call. - * nndiary.el (nndiary-request-accept-article): Added subject to + * nndiary.el (nndiary-request-accept-article): Add subject to nnmail-cache-insert call. - * nnfolder.el (nnfolder-request-accept-article): Added subject to + * nnfolder.el (nnfolder-request-accept-article): Add subject to nnmail-cache-insert call. - * nnimap.el (nnimap-split-articles): Added subject to + * nnimap.el (nnimap-split-articles): Add subject to nnmail-cache-insert call. - (nnimap-request-accept-article): Added subject to + (nnimap-request-accept-article): Add subject to nnmail-cache-insert call. - * nnmbox.el (nnmbox-request-accept-article): Added subject to + * nnmbox.el (nnmbox-request-accept-article): Add subject to nnmail-cache-insert call. - * nnmh.el (nnmh-request-accept-article): Added subject to + * nnmh.el (nnmh-request-accept-article): Add subject to nnmail-cache-insert call. - * nnml.el (nnml-request-accept-article): Added subject to + * nnml.el (nnml-request-accept-article): Add subject to nnmail-cache-insert call. 2003-09-04 Jesper Harder <harder@ifa.au.dk> @@ -1557,8 +1552,8 @@ 2003-08-29 Simon Josefsson <jas@extundo.com> - * gnus-group.el (gnus-group-delete-group): Doc fix. Suggested by - Jochen Küpper <jochen@jochen-kuepper.de>. + * gnus-group.el (gnus-group-delete-group): Doc fix. + Suggested by Jochen Küpper <jochen@jochen-kuepper.de>. 2003-08-29 Katsumi Yamaoka <yamaoka@jpl.org> @@ -1592,13 +1587,13 @@ 2003-08-24 Jesper Harder <harder@ifa.au.dk> - * gnus-art.el (gnus-header-button-alist, gnus-button-alist): Fix - type. + * gnus-art.el (gnus-header-button-alist, gnus-button-alist): + Fix type. 2003-08-22 Jesper Harder <harder@ifa.au.dk> - * message.el (message-make-forward-subject-function): Fix - customize mismatch. + * message.el (message-make-forward-subject-function): + Fix customize mismatch. * gnus.el (gnus-message-archive-method): Do. @@ -1608,7 +1603,7 @@ char is `/' and add more information for the user. * gnus-art.el (gnus-button-alist): Add `+' (gnus-button-handle-man). - (gnus-header-button-alist): Added `In-Reply-To'. + (gnus-header-button-alist): Add `In-Reply-To'. * nnimap.el (nnimap-open-connection): Allow different user names on the same server (and in the same authinfo file). @@ -1617,15 +1612,15 @@ * gnus-sieve.el (gnus-sieve-crosspost): Fix type. - * message.el (message-make-forward-subject-function): Add - message-forward-subject-name-subject to choices. + * message.el (message-make-forward-subject-function): + Add message-forward-subject-name-subject to choices. * gnus-art.el (gnus-article-edit-done, gnus-article-edit-exit): Redisplay article after editing. 2003-08-20 Jari Aalto <jari.aalto@poboxes.com> - * gnus.el (gnus-read-group): Added check to ask confirmation if + * gnus.el (gnus-read-group): Add check to ask confirmation if Group name contains invalid character. You can use '/' in IMAP, but not in filenames. G m cannot know what the user is creating, so let user decide. See thread m2oeysiev3.fsf@naima.lensflare.org. @@ -1645,8 +1640,8 @@ 2003-08-07 Jesper Harder <harder@ifa.au.dk> - * pgg-gpg.el (pgg-gpg-process-region): Bind - default-enable-multibyte-characters to nil. + * pgg-gpg.el (pgg-gpg-process-region): + Bind default-enable-multibyte-characters to nil. 2003-08-07 Katsumi Yamaoka <yamaoka@jpl.org> @@ -1729,11 +1724,11 @@ * spam.el (spam-use-regex-body, spam-regex-body-spam) (spam-regex-body-ham): New variables, default to nil/empty/empty. - (spam-install-hooks): Added spam-use-regex-body to list or + (spam-install-hooks): Add spam-use-regex-body to list or pre-install conditions. - (spam-list-of-checks): Added spam-use-regex-body and + (spam-list-of-checks): Add spam-use-regex-body and spam-check-regex-body to list of checks. - (spam-list-of-statistical-checks): Added spam-use-regex-body to + (spam-list-of-statistical-checks): Add spam-use-regex-body to list of statistical checks. (spam-check-regex-body): Invokes spam-check-regex-headers with appropriate variable masking. @@ -1754,8 +1749,8 @@ (gnus-registry-clean-empty): New variable to enable cleaning the registry when saving it by calling gnus-registry-clean-empty-function. - * spam.el (spam-summary-prepare-exit): Use - spam-process-ham-in-spam-groups. + * spam.el (spam-summary-prepare-exit): + Use spam-process-ham-in-spam-groups. (spam-process-ham-in-spam-groups): New variable. 2003-07-24 Jesper Harder <harder@ifa.au.dk> @@ -1763,8 +1758,8 @@ * pgg-gpg.el (pgg-gpg-process-region): Add "--yes" to options. * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el, pgg.el: Reapply changes - from 2003-04-03 to fix security problem. See - http://www.debian.org/security/2003/dsa-339. + from 2003-04-03 to fix security problem. + See http://www.debian.org/security/2003/dsa-339. 2003-07-23 Teodor Zlatanov <tzz@lifelogs.com> @@ -1806,8 +1801,7 @@ 2003-07-10 Kai Großjohann <kai.grossjohann@gmx.net> - * imap.el (imap-arrival-filter): Fix test for missing process - buffer. + * imap.el (imap-arrival-filter): Fix test for missing process buffer. 2003-07-09 Gaute B Strokkenes <gs234@cam.ac.uk> (tiny change) @@ -1881,8 +1875,8 @@ 2003-07-06 Jesper Harder <harder@ifa.au.dk> - * message.el (message-send-mail-with-sendmail): Handle - non-numeric return values. + * message.el (message-send-mail-with-sendmail): + Handle non-numeric return values. * gnus-start.el (gnus-clear-system): Revert change from 2003-06-19. @@ -1928,8 +1922,8 @@ 2003-06-23 Teodor Zlatanov <tzz@lifelogs.com> - * spam.el (spam-from-listed-p, spam-parse-list): Use - ietf-drums-parse-addresses to extract the address portion of the + * spam.el (spam-from-listed-p, spam-parse-list): + Use ietf-drums-parse-addresses to extract the address portion of the whitelist/blacklist file if it looks like an address can be found. 2003-06-23 Didier Verna <didier@xemacs.org> @@ -1942,8 +1936,8 @@ (gnus-xmas-remove-image): Ditto, with extents. * gnus-art.el (gnus-delete-images): Pass CATEGORY argument to gnus-[xmas-]remove-image. - (article-display-face): Don't always act as a toggle. Call - `gnus-put-image' with CATEGORY argument. + (article-display-face): Don't always act as a toggle. + Call `gnus-put-image' with CATEGORY argument. (article-display-x-face): Call `gnus-put-image' with CATEGORY argument. * smiley.el (smiley-region): Ditto. @@ -1959,11 +1953,11 @@ 2003-06-20 Jesper Harder <harder@ifa.au.dk> - * mm-util.el (mm-append-to-file): Say "Appended to". Suggested by - Dan Jacobson <jidanni@jidanni.org>. + * mm-util.el (mm-append-to-file): Say "Appended to". + Suggested by Dan Jacobson <jidanni@jidanni.org>. - * mm-view.el (mm-inline-message): Bind - gnus-original-article-buffer to the buffer in the mml handle + * mm-view.el (mm-inline-message): + Bind gnus-original-article-buffer to the buffer in the mml handle holding the message. 2003-06-20 Katsumi Yamaoka <yamaoka@jpl.org> @@ -1994,8 +1988,8 @@ 2003-06-19 Jesper Harder <harder@ifa.au.dk> - * nnheader.el (nnheader-init-server-buffer): Add - nntp-server-buffer to gnus-buffers. + * nnheader.el (nnheader-init-server-buffer): + Add nntp-server-buffer to gnus-buffers. * gnus-start.el (gnus-clear-system): Now we don't need to kill nntp-server-buffer separately. @@ -2016,8 +2010,8 @@ 2003-06-17 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-util.el (gnus-extract-address-components): Added - doc-string. + * gnus-util.el (gnus-extract-address-components): + Add doc-string. 2003-06-16 Michael Albinus <Michael.Albinus@alcatel.de> @@ -2026,8 +2020,8 @@ 2003-06-16 Katsumi Yamaoka <yamaoka@jpl.org> - * gnus-sum.el (gnus-summary-refer-parent-article): Extract - Message-ID from In-Reply-To header. + * gnus-sum.el (gnus-summary-refer-parent-article): + Extract Message-ID from In-Reply-To header. 2003-06-16 Katsumi Yamaoka <yamaoka@jpl.org> @@ -2037,14 +2031,14 @@ 2003-06-15 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Bind - `gnus-article-emulate-mime'. + * gnus-sum.el (gnus-summary-force-verify-and-decrypt): + Bind `gnus-article-emulate-mime'. 2003-06-15 Tommi Vainikainen <thv+gnus@iki.fi> - * message.el (message-is-yours-p): New function. Separated common - code from message-cancel-news and message-supersede. Added - matching code which uses message-alternative-emails regexp as last + * message.el (message-is-yours-p): New function. Separate common + code from message-cancel-news and message-supersede. + Add matching code which uses message-alternative-emails regexp as last resort. (message-cancel-news, message-supersede): Use message-is-yours-p. @@ -2055,11 +2049,11 @@ 2003-06-12 Dave Love <fx@gnu.org> - * nnheader.el (nnheader-functionp): Deleted. + * nnheader.el (nnheader-functionp): Delete. * nnmail.el (nnmail-split-fancy-syntax-table): Define all in defvar. - (nnmail-version): Deleted. + (nnmail-version): Delete. (nnmail-check-duplication, nnmail-expiry-target-group): Don't use nnheader-functionp. @@ -2077,15 +2071,15 @@ (spam-spamoracle, spam-spamoracle): New variables. (spam-group-spam-processor-spamoracle-p) (spam-group-ham-processor-spamoracle-p): New functions. - (spam-summary-prepare-exit): Added spamoracle ham/spam exit processing. - (spam-list-of-checks, spam-list-of-statistical-checks): Add - spam-use-spamoracle. + (spam-summary-prepare-exit): Add spamoracle ham/spam exit processing. + (spam-list-of-checks, spam-list-of-statistical-checks): + Add spam-use-spamoracle. (spam-check-spamoracle, spam-spamoracle-learn) (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): New functions. * gnus.el (gnus-group-spam-exit-processor-spamoracle) (gnus-group-ham-exit-processor-spamoracle): New variables for SpamOracle. - (spam-process, ham-process): Added spamoracle spam/ham processors. + (spam-process, ham-process): Add spamoracle spam/ham processors. 2003-06-08 Jesper Harder <harder@ifa.au.dk> @@ -2094,7 +2088,7 @@ 2003-06-07 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-sum.el (gnus-summary-make-menu-bar): Removed ["Add buttons" + * gnus-sum.el (gnus-summary-make-menu-bar): Remove ["Add buttons" gnus-summary-display-buttonized t]. 2003-06-07 Kai Großjohann <kai.grossjohann@gmx.net> @@ -2150,9 +2144,9 @@ (gnus-other-frame): Quote lambda used as hook. * message.el: Doc fixes. - (message-functionp): Deleted. Callers changed. - (message-fix-before-sending): Highlight with overlays. Clarify - `illegible text' messages. + (message-functionp): Delete. Callers changed. + (message-fix-before-sending): Highlight with overlays. + Clarify `illegible text' messages. (rmail-enable-mime-composing, gnus-message-group-art): Defvar when compiling. (gnus-find-method-for-group, nnvirtual-find-group-art): Autoload. @@ -2168,8 +2162,8 @@ 2003-06-03 Eric Eide <eeide@cs.utah.edu> - * gnus-xmas.el (gnus-xmas-create-image): Use - insert-file-contents-literally. + * gnus-xmas.el (gnus-xmas-create-image): + Use insert-file-contents-literally. 2003-06-02 Teodor Zlatanov <tzz@lifelogs.com> @@ -2195,8 +2189,8 @@ (gnus-registry-delete-group): Use it. (gnus-registry-unload-hook): Uninstall all the hooks. - * spam.el (spam-install-hooks-function, spam-unload-hook): New - functions so users that load spam.el for customization don't get + * spam.el (spam-install-hooks-function, spam-unload-hook): + New functions so users that load spam.el for customization don't get all the hooks installed. (spam-install-hooks): New variable, set to t by default if user has one of the spam-use-* variables set. @@ -2210,8 +2204,8 @@ * rfc2047.el (rfc2047-decode): Don't use mm-with-unibyte-current-buffer. - * qp.el (quoted-printable-decode-string): Use - mm-with-unibyte-buffer. + * qp.el (quoted-printable-decode-string): + Use mm-with-unibyte-buffer. 2003-05-29 Teodor Zlatanov <tzz@lifelogs.com> @@ -2250,7 +2244,7 @@ 2003-05-20 Dave Love <fx@gnu.org> - * rfc2047.el (rfc2047-q-encoding-alist): Deleted. + * rfc2047.el (rfc2047-q-encoding-alist): Delete. (rfc2047-q-encode-region): Don't use it. (rfc2047-encode-message-header) <(eq method 'mime)>: Bind rfc2047-encoding-type to `mime'. @@ -2268,11 +2262,11 @@ 2003-05-14 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-agent.el (gnus-agentize): Updated documentation to match + * gnus-agent.el (gnus-agentize): Update documentation to match usage. (gnus-agent-expire-group-1): Do not skip over a group when the force argument is set. - * gnus.el (gnus-agent): Updated documentation to reflect that + * gnus.el (gnus-agent): Update documentation to reflect that gnus-agent now defaults to t. 2003-05-14 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -2285,24 +2279,24 @@ 2003-05-14 Lars Magne Ingebrigtsen <larsi@gnus.org> - * mail-source.el (mail-source-delete-incoming): Changed to t. + * mail-source.el (mail-source-delete-incoming): Change to t. * rfc2047.el (rfc2047-syntax-table): Funcall. * rfc2047.el (rfc2047-encodable-p): Use the header charset. - * gnus-sum.el (gnus-summary-reselect-current-group): Supply - leave-hidden. + * gnus-sum.el (gnus-summary-reselect-current-group): + Supply leave-hidden. 2003-05-14 Jonathan I. Kamens <jik@kamens.brookline.ma.us> - * gnus-sum.el (gnus-summary-exit): Added `leave-hidden'. (Tiny + * gnus-sum.el (gnus-summary-exit): Add `leave-hidden'. (Tiny patch.) 2003-05-13 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-registry.el (gnus-registry-store-extra-entry): Use - gnus-assq-delete-all. + * gnus-registry.el (gnus-registry-store-extra-entry): + Use gnus-assq-delete-all. * gnus-xmas.el (gnus-xmas-assq-delete-all): New function. @@ -2341,10 +2335,10 @@ (gnus-agent-cat-disable-undownloaded-faces): New function. Accessor for new agent property 'agent-disable-undownloaded-faces'. - gnus-cus.el (gnus-agent-parameters): Added - agent-disable-undownloaded-faces and corrected documentation. + gnus-cus.el (gnus-agent-parameters): + Add agent-disable-undownloaded-faces and corrected documentation. (gnus-agent-cat-prepare-category-field, - gnus-agent-customize-category): Changed to avoid creating free + gnus-agent-customize-category): Change to avoid creating free references to each field's symbol. gnus-sum.el (gnus-summary-use-undownloaded-faces): New local variable. (gnus-select-newgroup): Initialize it. @@ -2352,15 +2346,15 @@ 2003-05-12 Dave Love <fx@gnu.org> - * mm-util.el (mm-read-charset): Deleted. + * mm-util.el (mm-read-charset): Delete. (mm-coding-system-mime-charset): New. (mm-read-coding-system, mm-mule-charset-to-mime-charset) (mm-charset-to-coding-system, mm-mime-charset) (mm-find-mime-charset-region): Use it. (mm-default-multibyte-p): Fix non-mule case. - * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-bol): Eval - and compile. + * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-bol): + Eval and compile. (rfc2047-syntax-table): Fix building table to work in Emacs 22. (rfc2047-unfold-region): Delete unused var `leading'. @@ -2371,8 +2365,8 @@ 2003-05-11 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-agent.el (gnus-agent-expire-unagentized-dirs): Added - space. + * gnus-agent.el (gnus-agent-expire-unagentized-dirs): + Add space. 2003-05-11 Jesper Harder <harder@ifa.au.dk> @@ -2390,7 +2384,7 @@ 2003-05-10 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus.el (gnus-logo-color-alist): Added no colors. + * gnus.el (gnus-logo-color-alist): Add no colors. 2003-05-09 Dave Love <fx@gnu.org> @@ -2415,12 +2409,12 @@ * gnus-registry.el (gnus-registry-unregistered-group-regex): removed in favor of the group/topic/global variables. - (gnus-registry-register-message-ids): Fixed test to omit + (gnus-registry-register-message-ids): Fix test to omit gnus-registry-unregistered-group-regex. - * gnus.el (gnus-variable-list): Removed gnus-registry-alist and + * gnus.el (gnus-variable-list): Remove gnus-registry-alist and gnus-registry-headers-alist from the list. - (gnus-registry-headers-alist): Removed. + (gnus-registry-headers-alist): Remove. (registry-ignore): New parameter, with accompanying gnus-registry-ignored-groups global variable. @@ -2430,12 +2424,12 @@ used by gnus-registry.el. * gnus-registry.el (gnus-registry-cache-file): New file variable. - (gnus-registry-cache-read, gnus-registry-cache-save): New - functions. + (gnus-registry-cache-read, gnus-registry-cache-save): + New functions. (gnus-registry-save, gnus-registry-read): Use the new gnus-registry-cache-{read|save} functions, and change the name from gnus-registry-translate-{from|to}-alist. - (gnus-registry-clear): Fixed so it doesn't refer to old function name. + (gnus-registry-clear): Fix so it doesn't refer to old function name. 2003-05-09 Dan Christensen <jdc@chow.mat.jhu.edu> @@ -2448,7 +2442,7 @@ 2003-05-08 Teodor Zlatanov <tzz@lifelogs.com> - * gnus-start.el (gnus-clear-system): Added gnus-registry-alist to + * gnus-start.el (gnus-clear-system): Add gnus-registry-alist to the list of cleared variables. * gnus-registry.el (gnus-registry-split-fancy-with-parent): @@ -2461,8 +2455,8 @@ 2003-05-08 Kai Großjohann <kai.grossjohann@gmx.net> - * gnus-sum.el (gnus-summary-next-page): Mention - `gnus-article-skip-boring' in docstring. + * gnus-sum.el (gnus-summary-next-page): + Mention `gnus-article-skip-boring' in docstring. 2003-05-08 Jesper Harder <harder@ifa.au.dk> @@ -2546,13 +2540,13 @@ * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-eol): New. Callers of gnus- versions changed to use them. - (rfc2047-header-encoding-alist): Add `address-mime' part. Doc - fixes. + (rfc2047-header-encoding-alist): Add `address-mime' part. + Doc fixes. (rfc2047-encoding-type): New. (rfc2047-encode-message-header): Use mm-charset-to-coding-system. Don't include header name field in encoding. Add `address-mime' case and bind rfc2047-encoding-type for `mime' case. - (rfc2047-encodable-p): Deleted. + (rfc2047-encodable-p): Delete. (rfc2047-syntax-table): New. (rfc2047-encode-region, rfc2047-encode): Rewritten to take account of rfc2047 rules with respect to rfc2822 tokens and to do encoding @@ -2566,8 +2560,8 @@ 2003-05-02 Dave Love <fx@gnu.org> - * rfc2047.el (rfc2047-q-encode-region, rfc2047-decode): Use - mm-with-unibyte-current-buffer. + * rfc2047.el (rfc2047-q-encode-region, rfc2047-decode): + Use mm-with-unibyte-current-buffer. (ietf-drums, gnus-util): Don't require. * sieve.el (sieve-manage-mode-menu): Define before use. @@ -2577,9 +2571,9 @@ * mm-util.el (mm-coding-system-p): Don't override nil from coding-system-p. (mm-mule4-p, mm-disable-multibyte-mule4) - (mm-with-unibyte-current-buffer-mule4): Deleted. + (mm-with-unibyte-current-buffer-mule4): Delete. (mm-multibyte-p): Use defun, not defalias. - (mm-make-temp-file): Moved to group at top of file. + (mm-make-temp-file): Move to group at top of file. (mm-point-at-eol, mm-point-at-bol): New. * gnus-cite.el (gnus-art): Require. @@ -2599,29 +2593,29 @@ (gnus-output-to-rmail): Require mm-util. * mail-source.el (mail-source-callback): Use mm-make-temp-file. - (mail-source-make-complex-temp-name): Deleted. + (mail-source-make-complex-temp-name): Delete. * message.el (message-use-idna): Use mm-coding-system-p. (message-tokenize-header, message-make-organization) (message-make-from): Use with-temp-buffer. - (message-set-work-buffer): Deleted. + (message-set-work-buffer): Delete. (message-fill-paragraph): Use `if' not `and' for compiler warning. (message-check-news-header-syntax): Remove useless lambda. (message-forward-make-body): Use mm-disable-multibyte, mm-with-unibyte-current-buffer, mm-enable-multibyte. - (message-replace-chars-in-string): Deleted. + (message-replace-chars-in-string): Delete. * mm-extern.el (mm-extern-local-file): Use mm-disable-multibyte. (mm-extern-url): Use mm-with-unibyte-current-buffer, mm-disable-multibyte. (mm-extern-anon-ftp): Use mm-disable-multibyte. - * mml1991.el (mml1991-mailcrypt-encrypt, mml1991-gpg-encrypt): Use - mm-with-unibyte-current-buffer. + * mml1991.el (mml1991-mailcrypt-encrypt, mml1991-gpg-encrypt): + Use mm-with-unibyte-current-buffer. * mml2015.el (mml): Require. - (mml2015-mailcrypt-encrypt, mml2015-gpg-encrypt): Use - mm-with-unibyte-current-buffer. + (mml2015-mailcrypt-encrypt, mml2015-gpg-encrypt): + Use mm-with-unibyte-current-buffer. * nnheader.el (gnus-util): Require. @@ -2656,7 +2650,7 @@ * gnus-registry.el (gnus-registry-fetch-extra) (gnus-registry-store-extra, gnus-registry-group-count): New functions. (gnus-registry-fetch-group, gnus-registry-delete-group) - (gnus-registry-add-group): Changed to work with extra data element + (gnus-registry-add-group): Change to work with extra data element if present. 2003-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no> @@ -2693,8 +2687,8 @@ 2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org> - * message.el (message-forward-subject-name-subject): Decode - string when forwarding. + * message.el (message-forward-subject-name-subject): + Decode string when forwarding. 2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -2756,7 +2750,7 @@ 2003-04-30 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-art.el (gnus-button-prefer-mid-or-mail): Fixed typo in + * gnus-art.el (gnus-button-prefer-mid-or-mail): Fix typo in doc-string. 2003-05-01 Steve Youngs <youngs@xemacs.org> @@ -2778,20 +2772,20 @@ 2003-04-30 Teodor Zlatanov <tzz@lifelogs.com> - * gnus-registry.el (gnus-registry-split-fancy-with-parent): Added - diagnostic message. + * gnus-registry.el (gnus-registry-split-fancy-with-parent): + Add diagnostic message. (gnus-registry-grep-in-list): Don't run when word is nil. (gnus-registry-fetch-message-id-fast): New function. (gnus-registry-delete-group, gnus-registry-add-group): Make sure the id and group are not nil. (gnus-registry-register-message-ids): New function. - (gnus-register-action): Optimized logical flow. - (gnus-summary-prepare-hook): Added gnus-registry-register-message-ids. + (gnus-register-action): Optimize logical flow. + (gnus-summary-prepare-hook): Add gnus-registry-register-message-ids. 2003-04-30 Kai Großjohann <kai.grossjohann@gmx.net> - * gnus-delay.el (gnus-delay-article): Call - `gnus-agent-queue-setup' to create the delay group. + * gnus-delay.el (gnus-delay-article): + Call `gnus-agent-queue-setup' to create the delay group. * gnus-agent.el (gnus-agent-queue-setup): Support optional arg for the (queue) group name. @@ -2804,17 +2798,17 @@ 2003-04-30 Kevin Greiner <kgreiner@xpediantsolutions.com> * gnus-agent.el (gnus-agent-cat-defaccessor, gnus-agent-cat-name): - Wrapped in eval-when-compile. + Wrap in eval-when-compile. (gnus-agent-mode): Bind gnus-agent-go-online to nil as you shouldn't be asked twice to go online with each server. (gnus-agent-get-undownloaded-list, gnus-agent-fetch-articles, gnus-agent-crosspost, gnus-agent-flush-cache, gnus-agent-fetch-session, gnus-agent-unread-articles, gnus-agent-uncached-articles, gnus-agent-regenerate-group, - gnus-agent-group-covered-p): Expanded pop macros used for + gnus-agent-group-covered-p): Expand pop macros used for effect. Avoids compilation warning in emacs 21.3. - * gnus-int.el (gnus-open-server): Restructured to only open + * gnus-int.el (gnus-open-server): Restructure to only open nnagent when gnus-plugged is nil. 2003-04-29 Teodor Zlatanov <tzz@lifelogs.com> @@ -2830,7 +2824,7 @@ 2003-04-29 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-art.el (gnus-button-alist): Fixed CTAN regexp. + * gnus-art.el (gnus-button-alist): Fix CTAN regexp. 2003-04-29 Teodor Zlatanov <tzz@lifelogs.com> @@ -2892,7 +2886,7 @@ * gnus-art.el (gnus-mime-display-multipart-as-mixed) (gnus-mime-display-multipart-alternative-as-mixed) - (gnus-mime-display-multipart-related-as-mixed): Added doc-strings, + (gnus-mime-display-multipart-related-as-mixed): Add doc-strings, allow customization. 2003-04-27 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -2909,7 +2903,7 @@ 2003-04-27 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-registry.el (gnus-register-spool-action): Replaced literal + * gnus-registry.el (gnus-register-spool-action): Replace literal carriage-return character with its escape sequence. 2003-04-27 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -2921,7 +2915,7 @@ * gnus.el: Remove gnus-functionp throughout. - * gnus-util.el (gnus-functionp): Removed. + * gnus-util.el (gnus-functionp): Remove. * gnus-msg.el (gnus-summary-wide-reply-with-original): Doc fix. @@ -2985,8 +2979,8 @@ * gnus-start.el (message-make-date): Autoload rather than requiring message. - * gnus-group.el (gnus-group-name-charset-group-alist): Use - mm-coding-system-p. + * gnus-group.el (gnus-group-name-charset-group-alist): + Use mm-coding-system-p. (gnus-cache-active-altered): Defvar when compiling. (gnus-group-delete-group): Re-write to help avoid warnings. @@ -3032,12 +3026,12 @@ 2003-04-22 Paul Jarc <prj@po.cwru.edu> - * gnus-util.el (gnus-merge): Added "type" argument to match CL + * gnus-util.el (gnus-merge): Add "type" argument to match CL merge and gnus-sum.el's expectations. 2003-04-21 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-art.el (gnus-button-url-regexp): Added nntp. + * gnus-art.el (gnus-button-url-regexp): Add nntp. * message.el (message-generate-headers-first): Default to '(references). @@ -3089,8 +3083,8 @@ * spam.el (spam-split): Allow a particular check as a parameter, e.g. (: spam-split 'spam-use-bogofilter). (spam-mark-only-unseen-as-spam): New parameter, see doc. - (spam-mark-junk-as-spam-routine): Use - spam-mark-only-unseen-as-spam, simplify routine to take advantage + (spam-mark-junk-as-spam-routine): + Use spam-mark-only-unseen-as-spam, simplify routine to take advantage of gnus-newsgroup-unread as well as gnus-newsgroup-unseen. 2003-04-17 Teodor Zlatanov <tzz@lifelogs.com> @@ -3103,7 +3097,7 @@ * gnus-registry.el (gnus-registry-clear) (gnus-registry-fetch-group, gnus-registry-grep-in-list) (gnus-registry-split-fancy-with-parent): New functions. - (gnus-register-spool-action, gnus-register-action): Simplified the + (gnus-register-spool-action, gnus-register-action): Simplify the format. (gnus-registry): New customization group. (gnus-registry-unfollowed-groups): New variable. @@ -3154,9 +3148,9 @@ * spam-report.el (Module): New module for spam reporting. - * gnus.el (spam-process): Added - gnus-group-spam-exit-processor-report-gmane to the list of choices. - (gnus-install-group-spam-parameters): Defined new spam exit processor. + * gnus.el (spam-process): + Add gnus-group-spam-exit-processor-report-gmane to the list of choices. + (gnus-install-group-spam-parameters): Define new spam exit processor. * spam.el (autoload): Autoload spam-report-gmane when needed. (spam-report-gmane-register-routine): Glue for spam-report.el. @@ -3200,7 +3194,7 @@ 2003-04-16 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-agent.el (gnus-agent-make-cat): Added optional parameter to + * gnus-agent.el (gnus-agent-make-cat): Add optional parameter to specify a predicate other than false. (gnus-category-read): Use the new feature to create a 'default' category with a 'short' predicate. @@ -3214,7 +3208,7 @@ 2003-04-15 Teodor Zlatanov <tzz@lifelogs.com> - * spam.el (spam-split): Added save-restriction to save-excursion. + * spam.el (spam-split): Add save-restriction to save-excursion. 2003-04-15 Julien Avarre <julien@avarre.com> @@ -3276,8 +3270,8 @@ 2003-04-13 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-agent.el (gnus-agent-group-pathname): Bind - gnus-command-method so that gnus-agent-directory will always + * gnus-agent.el (gnus-agent-group-pathname): + Bind gnus-command-method so that gnus-agent-directory will always return a valid directory. * gnus-cache.el (gnus-cache-enter-article): Remove article from gnus-newsgroup-undownloaded so that the summary will display the @@ -3300,13 +3294,13 @@ 2003-04-12 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-art.el (gnus-article-next-page): Use - gnus-article-over-scroll. + * gnus-art.el (gnus-article-next-page): + Use gnus-article-over-scroll. (gnus-article-over-scroll): New variable. * message.el (message-newline-and-reformat): Place a boundary before filling. - (message-make-forward-subject-function): Changed default to + (message-make-forward-subject-function): Change default to message-forward-subject-name-subject. (message-forward-subject-name-subject): New function. @@ -3314,16 +3308,15 @@ * gnus-sum.el (gnus-summary-line-message-size): Ditto. - * gnus-cus.el (gnus-group-parameters): Removed "which see". + * gnus-cus.el (gnus-group-parameters): Remove "which see". - * mml.el (mml-minibuffer-read-file): Bind - completion-ignored-extensions to nil. + * mml.el (mml-minibuffer-read-file): + Bind completion-ignored-extensions to nil. * message.el (message-fix-before-sending): Comment fix. (message-fix-before-sending): Make hidden headers visible. (message-hide-headers): Bind after-change-functions to nil. - (message-forbidden-properties): Put invisible and intangible - back. + (message-forbidden-properties): Put invisible and intangible back. (message-strip-forbidden-properties): Ignore message-hidden text. * gnus-msg.el: Hide headers. @@ -3332,8 +3325,7 @@ (message-hide-headers): New function. (message-hide-header-p): New function. (message-hide-header-p): Change logic. - (message-forbidden-properties): Remove intangible nil invisible - nil. + (message-forbidden-properties): Remove intangible nil invisible nil. (message-hide-headers): Narrow to headers. 2003-04-12 Jesper Harder <harder@ifa.au.dk> @@ -3348,7 +3340,7 @@ * gnus-agent.el (gnus-agent-get-undownloaded-list): Articles in the CACHE are now detected and handled the same as an article downloaded into the agent. - (gnus-agent-group-path): Modified to match nnmail-group-pathname + (gnus-agent-group-path): Modify to match nnmail-group-pathname so that the agent front-end and back-end (nnagent) always use the same directory. (gnus-agent-group-pathname): New function. Wrapper for @@ -3371,7 +3363,7 @@ 2003-04-09 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-agent.el (gnus-agent-write-active): Added option of + * gnus-agent.el (gnus-agent-write-active): Add option of replacing, rather than updating, the agent's active file. Do NOT use the fully qualified group name as gnus-active-to-gnus-format blindly prefixes group names with server names. @@ -3384,9 +3376,9 @@ (gnus-agent-expire-unagentized-dirs): Avoid asking to delete the same ancestor multiple times. - * gnus-async.el (gnus-asynchronous): Moved defcustom of - gnus-asynchronous away from defgroup of gnus-asynchronous. This - seems to fix an intermittant error in which loading gnus-async + * gnus-async.el (gnus-asynchronous): Move defcustom of + gnus-asynchronous away from defgroup of gnus-asynchronous. + This seems to fix an intermittant error in which loading gnus-async fails to define gnus-asynchronous (the variable). * gnus-sum.el: Concur with Steve Young, 5th argument to 'load' is @@ -3395,7 +3387,7 @@ group's active range to include fetched articles that are no longer in the server's active range. - * gnus-util.el (gnus-with-output-to-file): Removed all of the + * gnus-util.el (gnus-with-output-to-file): Remove all of the print-* bindings as they should be handled by the function doing the printing. @@ -3443,8 +3435,8 @@ 2003-04-06 Jesper Harder <harder@ifa.au.dk> - * mm-uu.el (mm-uu-copy-to-buffer): Copy - `buffer-file-coding-system' to the new buffer. + * mm-uu.el (mm-uu-copy-to-buffer): + Copy `buffer-file-coding-system' to the new buffer. (mm-uu-pgp-signed-extract-1): Don't copy `buffer-file-coding-system' here. @@ -3452,8 +3444,8 @@ exist in XEmacs. (mm-decode-body): Add missing quote. - * mm-uu.el (mm-uu-pgp-signed-extract-1): Set - buffer-file-coding-system. + * mm-uu.el (mm-uu-pgp-signed-extract-1): + Set buffer-file-coding-system. * mm-bodies.el (mm-decode-body): Set buffer-file-coding-system to last-coding-system-used. @@ -3484,8 +3476,8 @@ 2003-04-05 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bound - print-escape-nonascii to fix more characters in compiled format + * gnus-start.el (gnus-gnus-to-quick-newsrc-format): + Bound print-escape-nonascii to fix more characters in compiled format specs. 2003-04-05 Jesper Harder <harder@ifa.au.dk> @@ -3495,8 +3487,8 @@ 2003-04-04 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bound - print-quoted, print-readably, print-escape-multibyte, and + * gnus-start.el (gnus-gnus-to-quick-newsrc-format): + Bound print-quoted, print-readably, print-escape-multibyte, and print-level to match original behavior of gnus-prin1. This should repair the format of .newsrc.eld when using compiled format specs. @@ -3514,7 +3506,7 @@ 2003-04-03 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-art.el (gnus-button-ctan-directory-regexp): Changed meaning + * gnus-art.el (gnus-button-ctan-directory-regexp): Change meaning and value. (gnus-button-alist): Use it. @@ -3534,9 +3526,9 @@ 2003-04-02 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-util.el (gnus-message): Added doc-string. + * gnus-util.el (gnus-message): Add doc-string. - * gnus-score.el (gnus-score-find-trace): Changed behavior of `q'. + * gnus-score.el (gnus-score-find-trace): Change behavior of `q'. (gnus-score-edit-file-at-point): Goto first match when using `e'. 2003-04-01 Reiner Steib <Reiner.Steib@gmx.de> @@ -3551,22 +3543,22 @@ 2003-03-31 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bound - print-escape-newlines to print escape sequences rather than + * gnus-start.el (gnus-gnus-to-quick-newsrc-format): + Bound print-escape-newlines to print escape sequences rather than literal newline characters. 2003-03-31 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-art.el (gnus-button-valid-fqdn-regexp): Use - `message-valid-fqdn-regexp' for initialization. - (gnus-button-handle-info-url): Renamed and extended version of + * gnus-art.el (gnus-button-valid-fqdn-regexp): + Use `message-valid-fqdn-regexp' for initialization. + (gnus-button-handle-info-url): Rename and extended version of `gnus-button-handle-info'. - (gnus-button-message-level): Renamed from `gnus-button-mail-level'. + (gnus-button-message-level): Rename from `gnus-button-mail-level'. (gnus-button-handle-symbol, gnus-button-handle-library) (gnus-button-handle-info-keystrokes): New functions. (gnus-button-browse-level): New variable. (gnus-button-alist): Use them. Added levels. - (gnus-header-button-alist): Added levels. + (gnus-header-button-alist): Add levels. 2003-03-31 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -3578,10 +3570,10 @@ 2003-03-31 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-start.el (gnus-unload): Removed. + * gnus-start.el (gnus-unload): Remove. - * pop3.el (pop3-read-response): Use - nnheader-accept-process-output. + * pop3.el (pop3-read-response): + Use nnheader-accept-process-output. (pop3-retr): Ditto. * mm-view.el (mm-text-html-renderer-alist): Add -nolist to Lynx. @@ -3601,7 +3593,7 @@ * nnheader.el (nnheader-read-timeout): New variable. (nnheader-accept-process-output): New function. - * nntp.el (nntp-read-timeout): Removed. + * nntp.el (nntp-read-timeout): Remove. * gnus-sum.el (gnus-summary-prepare-threads): Add comment. @@ -3622,8 +3614,8 @@ 2003-03-28 Vasily Korytov <deskpot@myrealbox.com> - * message.el (message-make-in-reply-to): Use - mail-extract-address-components to determine sender's + * message.el (message-make-in-reply-to): + Use mail-extract-address-components to determine sender's name/address. 2003-03-30 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -3634,8 +3626,8 @@ valid lambda. (gnus-registry-translate-from-alist): Ditto. - * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bind - print-length to nil. + * gnus-start.el (gnus-gnus-to-quick-newsrc-format): + Bind print-length to nil. * gnus-sum.el (gnus-summary-highlight-line-0): Indent. @@ -3658,14 +3650,14 @@ (gnus-registry-translate-from-alist): New functions. (gnus-register-spool-action): Add a spool item to the registry. - * gnus.el (gnus-variable-list): Added gnus-registry-alist to the + * gnus.el (gnus-variable-list): Add gnus-registry-alist to the list of saved variables. (gnus-registry-alist): New variable. 2003-03-28 Andreas Fuchs <asf@void.at> - * gnus-registry.el (alist-to-hashtable, hashtable-to-alist): New - functions. + * gnus-registry.el (alist-to-hashtable, hashtable-to-alist): + New functions. 2003-03-27 Simon Josefsson <jas@extundo.com> @@ -3683,7 +3675,7 @@ 2003-03-26 Kevin Ryde <user42@zip.com.au> - * gnus-sum.el (gnus-summary-find-for-reselect): Renamed from + * gnus-sum.el (gnus-summary-find-for-reselect): Rename from gnus-summary-find-uncancelled, skip temporary articles inserted by "refer" functions. @@ -3693,7 +3685,7 @@ 2003-03-26 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-agent.el (gnus-agent-fetch-selected-article): Replaced + * gnus-agent.el (gnus-agent-fetch-selected-article): Replace gnus-summary-update-line (which updated the article's face) with gnus-summary-update-download-mark (which updates the article's face by calling gnus-summary-update-line AND updates the download @@ -3717,8 +3709,8 @@ * rfc2047.el (rfc2047-header-encoding-alist): Make Followup-To same as Newsgroups. - * nntp.el (nntp-open-connection-function): Mention - nntp-open-tls-stream. + * nntp.el (nntp-open-connection-function): + Mention nntp-open-tls-stream. (nntp-open-tls-stream): New function. * tls.el: New file. @@ -3769,10 +3761,10 @@ * gnus-int.el (gnus-open-server): Catch errors in backend's open-server method. Returns nil rather than crashing startup. - * gnus-sum.el (eval-when-compile): Modified to resolve + * gnus-sum.el (eval-when-compile): Modify to resolve compile-time warnings. - * gnus-uu.el (gnus-uu-mark-series): Added informative msg. + * gnus-uu.el (gnus-uu-mark-series): Add informative msg. Reports length of series so that the user can compare N with a subject that should, if the entire series is present, contain '(.../N)'. @@ -3801,7 +3793,7 @@ 2003-03-20 Reiner Steib <Reiner.Steib@gmx.de> - * message.el (message-check-news-header-syntax): Fixed regexp. + * message.el (message-check-news-header-syntax): Fix regexp. 2003-03-20 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -3860,7 +3852,7 @@ * spam.el (spam-group-ham-mark-p, spam-group-spam-mark-p) (spam-group-ham-marks, spam-group-spam-marks): New functions. - (spam-spam-marks, spam-ham-marks): Removed in favor of the + (spam-spam-marks, spam-ham-marks): Remove in favor of the spam-marks and ham-marks parameters. (spam-generic-register-routine, spam-ham-move-routine): Use the new spam-group-{spam,ham}-mark-p functions. @@ -4030,23 +4022,23 @@ 2003-03-09 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-agent.el (gnus-agent-fetched-hook): New variable. Just - fixing the code to match the documentation. - (gnus-agent-fetch-selected-article): Replaced + * gnus-agent.el (gnus-agent-fetched-hook): New variable. + Just fixing the code to match the documentation. + (gnus-agent-fetch-selected-article): Replace gnus-summary-update-article-line with gnus-summary-update-line as the former did not correctly recalculate the thread indentation. (gnus-agent-find-parameter): The agent-predicate, if not found anywhere else, defaults to the value of gnus-agent-predicate. - (gnus-agent-fetch-session): Fixed typo; now executes + (gnus-agent-fetch-session): Fix typo; now executes gnus-agent-fetched-hook rather than the undocumented gnus-agent-fetch-hook. - (gnus-agent-fetch-group-1): Removed part of 2003-03-06 fix. The - default agent predicate is now provided by + (gnus-agent-fetch-group-1): Remove part of 2003-03-06 fix. + The default agent predicate is now provided by gnus-agent-find-parameter. (gnus-agent-message): New macro. This macro avoids potentially costly parameter evaluation when the message's level is too high to display. - (gnus-agent-expire-group-1): Disabled undo tracking in temp + (gnus-agent-expire-group-1): Disable undo tracking in temp overview buffer. Uses new gnus-agent-message macro to reduce overhead of optional messages. Reversed message levels to emphasize percent completion messages. Detailed messages of @@ -4054,8 +4046,8 @@ 2003-03-08 Teodor Zlatanov <tzz@lifelogs.com> - * spam.el (spam-ham-move-routine): Use - spam-mark-ham-unread-before-move-from-spam-group. + * spam.el (spam-ham-move-routine): + Use spam-mark-ham-unread-before-move-from-spam-group. (spam-mark-ham-unread-before-move-from-spam-group): New variable. 2003-03-07 Teodor Zlatanov <tzz@lifelogs.com> @@ -4074,7 +4066,7 @@ 2003-03-07 Teodor Zlatanov <tzz@lifelogs.com> * spam.el (spam-use-hashcash): New variable. - (spam-list-of-checks): Added spam-use-hashcash with associated + (spam-list-of-checks): Add spam-use-hashcash with associated spam-check-hashcash. (spam-check-hashcash): New function, installed iff hashcash.el is loaded. @@ -4082,7 +4074,7 @@ 2003-03-06 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-agent.el (gnus-agent-fetch-group-1): Added default + * gnus-agent.el (gnus-agent-fetch-group-1): Add default predicate of `false' to avoid an error when a group defines no predicate. Fixed typo that disabled agent scoring (i.e. the low/high predicates should now work). @@ -4091,10 +4083,10 @@ * spam.el: Add spam-maybe-spam-stat-load to gnus-get-top-new-news-hook, remove it from gnus-get-new-news-hook. - (spam-bogofilter-register-with-bogofilter): Use - spam-bogofilter-spam-switch and spam-bogofilter-ham-switch. - (spam-bogofilter-spam-switch, spam-bogofilter-ham-switch): New - custom variables to replace "-s" and "-n". + (spam-bogofilter-register-with-bogofilter): + Use spam-bogofilter-spam-switch and spam-bogofilter-ham-switch. + (spam-bogofilter-spam-switch, spam-bogofilter-ham-switch): + New custom variables to replace "-s" and "-n". * gnus-group.el (gnus-group-get-new-news): Call the new gnus-get-top-new-news-hook hook. @@ -4113,9 +4105,9 @@ 2003-03-06 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-agent.el (gnus-agent-fetch-group-1): Added missing binding + * gnus-agent.el (gnus-agent-fetch-group-1): Add missing binding on gnus-agent-short-article. - (gnus-category-read): Replaced CL function mapcar* with new macro: + (gnus-category-read): Replace CL function mapcar* with new macro: gnus-mapcar. * gnus-util.el (gnus-mapcar): New macro. Generalizes mapcar to support functions that accept multiple parameters. A separate @@ -4144,19 +4136,19 @@ 2003-03-04 Kai Großjohann <kai.grossjohann@uni-duisburg.de> - * gnus-agent.el (gnus-function-implies-unread-1): Grok - byte-compiled functions. + * gnus-agent.el (gnus-function-implies-unread-1): + Grok byte-compiled functions. 2003-03-04 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-sum.el (gnus-auto-goto-ignores): New variable. Provides - customization between new maneuvering (which permits selecting + * gnus-sum.el (gnus-auto-goto-ignores): New variable. + Provides customization between new maneuvering (which permits selecting undownloaded articles) and old maneuvering (which skipped over undownloaded articles) behaviors. (gnus-summary-find-next): Pass through the unread and subject parameters when calling gnus-summary-find-prev. - (gnus-summary-find-next, gnus-summary-find-prev): Apply - gnus-auto-goto-ignores to filter out unacceptable articles. + (gnus-summary-find-next, gnus-summary-find-prev): + Apply gnus-auto-goto-ignores to filter out unacceptable articles. 2003-03-04 Jesper Harder <harder@ifa.au.dk> @@ -4167,8 +4159,8 @@ (mail-source-fetch-webmail): Use read-passwd. * nntp.el (nntp-send-authinfo, nntp-send-nosy-authinfo) - (nntp-open-telnet, nntp-open-via-telnet-and-telnet): Use - read-passwd. + (nntp-open-telnet, nntp-open-via-telnet-and-telnet): + Use read-passwd. * nnwarchive.el (nnwarchive-open-server): Use read-passwd. @@ -4182,14 +4174,14 @@ (sieve-manage-interactive-login): Use read-passwd. * pop3.el (pop3-read-passwd): Remove. - (pop3-movemail, pop3-get-message-count, pop3-apop): Use - read-passwd. + (pop3-movemail, pop3-get-message-count, pop3-apop): + Use read-passwd. * pgg.el (pgg-read-passphrase): Simplify. 2003-03-04 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-agent.el (gnus-agent-mode): Fixed the mode line reports + * gnus-agent.el (gnus-agent-mode): Fix the mode line reports 'plugged' when actually 'unplugged' bug. (gnus-category-read): Ignore nil values when converting an old-format category so that the new-format category will default @@ -4197,8 +4189,8 @@ 2003-03-03 Reiner Steib <Reiner.Steib@gmx.de> - * mail-source.el (mail-source-delete-old-incoming-confirm): Fixed - doc-string. + * mail-source.el (mail-source-delete-old-incoming-confirm): + Fix doc-string. 2003-03-03 Jesper Harder <harder@ifa.au.dk> @@ -4226,12 +4218,12 @@ 2003-03-03 Reiner Steib <Reiner.Steib@gmx.de> * gnus-msg.el (gnus-extended-version): Fix for 'emacs-gnus-config. - (gnus-user-agent): Fixed typo. + (gnus-user-agent): Fix typo. 2003-03-03 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-agent.el (gnus-agent-enable-expiration): Fixed documentation. - (gnus-agent-expire-group-1): Removed invalid (interactive) specifier. + * gnus-agent.el (gnus-agent-enable-expiration): Fix documentation. + (gnus-agent-expire-group-1): Remove invalid (interactive) specifier. 2003-03-03 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -4241,8 +4233,8 @@ 2003-03-03 Jesper Harder <harder@ifa.au.dk> * gnus-sum.el (gnus-highlight-selected-summary) - (gnus-article-get-xrefs, gnus-summary-show-thread): Use - `gnus-point-at-bol' and `gnus-point-at-eol' instead of + (gnus-article-get-xrefs, gnus-summary-show-thread): + Use `gnus-point-at-bol' and `gnus-point-at-eol' instead of `(progn (beginning-of-line) (point))'. It's shorter, faster, and makes it clear that we don't need the side effect. * gnus-util.el (gnus-delete-line): Do. @@ -4280,8 +4272,8 @@ 2003-03-02 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-agent.el (gnus-agent-enable-expiration): New - variable. Either ENABLE or DISABLE. Sets default behavior for + * gnus-agent.el (gnus-agent-enable-expiration): + New variable. Either ENABLE or DISABLE. Sets default behavior for selecting which groups are expired. (gnus-agent-cat-set-property, gnus-agent-cat-defaccessor, gnus-agent-set-cat-groups): Provides abstract interface for @@ -4289,8 +4281,8 @@ (gnus-agent-add-group, gnus-agent-remove-group, gnus-category-insert-line, gnus-category-edit-predicate, gnus-category-edit-score, gnus-category-edit-groups, - gnus-category-copy, gnus-category-add, gnus-group-category): Use - new agent category abstraction. + gnus-category-copy, gnus-category-add, gnus-group-category): + Use new agent category abstraction. (gnus-agent-find-parameter): New function. Search for agent configuration parameter first in the group's parameters, then its topics (if any), and then the group's category. If not found @@ -4310,11 +4302,11 @@ (gnus-category-write): Writes category file compatible with current, and previous, versions of gnus-agent. (gnus-category-make-function, gnus-category-make-function-1): - Corrected documentation; parameter is predicate NOT category. + Correct documentation; parameter is predicate NOT category. (gnus-predicate-implies-unread): Now works in more cases per the todo comment. - (gnus-function-implies-unread-1): New function. Supports - gnus-predicate-implies-unread. + (gnus-function-implies-unread-1): New function. + Supports gnus-predicate-implies-unread. (gnus-agent-expire-group): Command now provides default of group under point. (gnus-agent-expire-group-1): Obeys new agent-enable-expiration and @@ -4323,12 +4315,12 @@ (gnus-agent-request-article): Now performs its own checks of gnus-agent, gnus-agent-cache, and gnus-plugged rather than assuming that the caller will do them correctly. - (): Added one-time hook to gnus-group-prepare-hook. Detects when + (): Add one-time hook to gnus-group-prepare-hook. Detects when gnus-agent-expire-days is set to an alist. Converts said alist into group parameter so that gnus-agent-expire-days will not be needed. - * gnus-art.el (gnus-request-article-this-buffer): Conditional - checks surrounding gnus-agent-request-article removed; now + * gnus-art.el (gnus-request-article-this-buffer): + Conditional checks surrounding gnus-agent-request-article removed; now performed by gnus-agent-request-article. * gnus-cus.el (gnus-agent-parameters): New variable. List of customizable group/topic parameters that regulate the agent. @@ -4351,8 +4343,8 @@ warnings. (gnus-long-file-names): New function. Isolates platform dependent msdos-long-file-names. - (gnus-save-startup-file-via-temp-buffer): New variable. Provides - option of writing directly to file. Avoids memory exhausted + (gnus-save-startup-file-via-temp-buffer): New variable. + Provides option of writing directly to file. Avoids memory exhausted errors when .newsrc.eld is huge. (gnus-save-newsrc-file): Uses new gnus-save-startup-file-via-temp-buffer. @@ -4419,12 +4411,11 @@ nnimap-split-download-body, we add it to gnus-get-new-news-hook. (spam-list-of-statistical-checks): List of statistical splitter checks. - (spam-split): Added a widen call when a statistical check is - enabled. + (spam-split): Add a widen call when a statistical check is enabled. 2003-02-28 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-msg.el (gnus-user-agent): Changed default to + * gnus-msg.el (gnus-user-agent): Change default to 'emacs-gnus-type, renamed 'full. 2003-02-28 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -4444,8 +4435,8 @@ 2003-02-26 Simon Josefsson <jas@extundo.com> - * gnus-sum.el (gnus-summary-toggle-header): Run - gnus-article-decode-hook instead of calling a-decode-encoded-words + * gnus-sum.el (gnus-summary-toggle-header): + Run gnus-article-decode-hook instead of calling a-decode-encoded-words directly (the latter is run as part of the former). 2003-02-26 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -4460,13 +4451,13 @@ 2003-02-25 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): Added - compensation for TDMA addresses. + * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): + Add compensation for TDMA addresses. 2003-02-24 Reiner Steib <Reiner.Steib@gmx.de> * gnus-msg.el (gnus-user-agent): New variable. - (gnus-version-expose-system): Removed. Obsoleted by + (gnus-version-expose-system): Remove. Obsoleted by `gnus-user-agent'. (gnus-extended-version): Use `gnus-user-agent'. @@ -4478,17 +4469,17 @@ 2003-02-24 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-group.el (gnus-topic-mode-p): Fixed free variable + * gnus-group.el (gnus-topic-mode-p): Fix free variable reference. 2003-02-24 Kevin Greiner <kgreiner@xpediantsolutions.com> - * nnheader.el (nnheader-find-nov-line): Changed midpoint + * nnheader.el (nnheader-find-nov-line): Change midpoint calculation to avoid integer overflow. 2003-02-24 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-start.el (gnus-backup-startup-file): Fixed custom type. + * gnus-start.el (gnus-backup-startup-file): Fix custom type. 2003-02-24 Teodor Zlatanov <tzz@lifelogs.com> @@ -4528,10 +4519,10 @@ clause of the condition-case statement. Errors connecting to a server no longer terminate gnus. - * gnus-agent.el (gnus-agent-toggle-plugged): Renamed parameter to + * gnus-agent.el (gnus-agent-toggle-plugged): Rename parameter to make its use obvious. Added no-nothing case to avoid opening(closing) servers when already open(closed). - (gnus-agent-while-plugged): Added macro to facilitate internal use + (gnus-agent-while-plugged): Add macro to facilitate internal use of gnus-agent-toggle-plugged. (gnus-agent-fetch-group): Use new gnus-agent-while-plugged to temporarily open servers. @@ -4565,8 +4556,8 @@ 2003-02-20 Reiner Steib <Reiner.Steib@gmx.de> - * message.el (message-user-fqdn, message-valid-fqdn-regexp): New - variables. + * message.el (message-user-fqdn, message-valid-fqdn-regexp): + New variables. (message-make-fqdn): Use it. Improved validity check. 2003-02-23 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -4592,7 +4583,7 @@ 2003-02-23 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-art.el (gnus-button-url-regexp): Removed `. + * gnus-art.el (gnus-button-url-regexp): Remove `. 2003-02-23 Max Froumentin <mf@w3.org> @@ -4603,13 +4594,13 @@ * gnus-art.el (gnus-mime-action-on-part): Require a match interactively. - * gnus-start.el (gnus-save-newsrc-file): Use - gnus-backup-startup-file. + * gnus-start.el (gnus-save-newsrc-file): + Use gnus-backup-startup-file. (gnus-backup-startup-file): New variable. 2003-02-22 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus.el (gnus-summary-buffer-name): Moved function here. + * gnus.el (gnus-summary-buffer-name): Move function here. * gnus-draft.el (defun): Remove debug. @@ -4631,8 +4622,8 @@ 2003-02-22 Kai Großjohann <kai.grossjohann@uni-duisburg.de> - * gnus-agent.el (gnus-agent-get-undownloaded-list): Sort - `gnus-newsgroup-headers'. + * gnus-agent.el (gnus-agent-get-undownloaded-list): + Sort `gnus-newsgroup-headers'. 2003-02-22 Karl Pflästerer <sigurd@12move.de> @@ -4651,18 +4642,18 @@ just article ID. * gnus-registry.el (gnus-registry-hashtb, gnus-register-action) - (gnus-register-spool-action): Added hashtable of message ID keys + (gnus-register-spool-action): Add hashtable of message ID keys with message motion data. 2003-02-21 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): New - variable, used in `gnus-button-mid-or-mail-heuristic'. + * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): + New variable, used in `gnus-button-mid-or-mail-heuristic'. (gnus-button-mid-or-mail-heuristic): New function derived from Florian Weimer's Perl script. (gnus-button-handle-mid-or-mail): Allow a function instead of 'guess. - (gnus-button-guessed-mid-regexp): Removed. + (gnus-button-guessed-mid-regexp): Remove. 2003-02-20 Katsumi Yamaoka <yamaoka@jpl.org> @@ -4700,7 +4691,7 @@ 2003-02-19 Reiner Steib <Reiner.Steib@gmx.de> * gnus-cite.el (gnus-cite-unsightly-citation-regexp) - (gnus-cite-parse): Renamed `gnus-unsightly-citation-regexp' to + (gnus-cite-parse): Rename `gnus-unsightly-citation-regexp' to `gnus-cite-unsightly-citation-regexp'. 2003-02-19 Katsumi Yamaoka <yamaoka@jpl.org> @@ -4723,8 +4714,8 @@ 2003-02-18 Teodor Zlatanov <tzz@lifelogs.com> * spam.el (spam-ham-move-routine) - (spam-mark-spam-as-expired-and-move-routine): Use - gnus-summary-kill-process-mark and gnus-summary-yank-process-mark + (spam-mark-spam-as-expired-and-move-routine): + Use gnus-summary-kill-process-mark and gnus-summary-yank-process-mark around process-mark manipulation on the group. 2003-02-17 Kai Großjohann <kai.grossjohann@uni-duisburg.de> @@ -4739,8 +4730,8 @@ 2003-02-16 Lars Magne Ingebrigtsen <larsi@gnus.org> - * nndraft.el (nndraft-request-move-article): Bind - nnmh-allow-delete-final to t. + * nndraft.el (nndraft-request-move-article): + Bind nnmh-allow-delete-final to t. 2003-02-14 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -4821,8 +4812,8 @@ * gnus-art.el (gnus-article-only-boring-p): New. (gnus-article-skip-boring): New. * gnus-cite.el (gnus-article-boring-faces): New. - * gnus-sum.el (gnus-summary-next-page): Use - gnus-article-only-boring-p. + * gnus-sum.el (gnus-summary-next-page): + Use gnus-article-only-boring-p. 2003-02-12 Teodor Zlatanov <tzz@lifelogs.com> @@ -4842,7 +4833,7 @@ 2003-02-11 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-agent.el (gnus-summary-set-agent-mark): Added call to + * gnus-agent.el (gnus-summary-set-agent-mark): Add call to gnus-summary-goto-subject as gnus-summary-update-mark operates on the current LINE. (gnus-agent-summary-fetch-group): Minimized the number of times @@ -4868,8 +4859,8 @@ 2003-02-10 Jesper Harder <harder@ifa.au.dk> - * mm-util.el (mm-mule-charset-to-mime-charset): Use - sort-coding-systems to prefer utf-8 over utf-16. + * mm-util.el (mm-mule-charset-to-mime-charset): + Use sort-coding-systems to prefer utf-8 over utf-16. 2003-02-09 Kevin Greiner <kgreiner@xpediantsolutions.com> @@ -4880,9 +4871,9 @@ If you don't want to run gnus-agent-expire, don't call it. (gnus-agent-expire): The broken test to disable gnus-agent-expire when g-a-e-d was NOT nil was removed. - (gnus-agent-article-name): Removed unnecessary input test as + (gnus-agent-article-name): Remove unnecessary input test as article IDs are always strings. - (gnus-agent-regenerate-group): Added check to protect against + (gnus-agent-regenerate-group): Add check to protect against servers that generate absurdly long article IDs. Valid IDs are less than 10 digits to avoid overflow errors. Fixed logic error when ensuring that the final article ID is present in the new @@ -4918,8 +4909,8 @@ 2003-02-08 Jesper Harder <harder@ifa.au.dk> - * gnus-art.el (gnus-article-refer-article): Use - gnus-replace-in-string. + * gnus-art.el (gnus-article-refer-article): + Use gnus-replace-in-string. * gnus-util.el (gnus-map-function): Remove unneeded let-binding. (gnus-remove-duplicates): Do. @@ -4928,12 +4919,12 @@ * gnus-int.el (gnus-internal-registry-spool-current-method): New variable. - (gnus-request-scan): Set - gnus-internal-registry-spool-current-method to gnus-command-method + (gnus-request-scan): + Set gnus-internal-registry-spool-current-method to gnus-command-method before a request-scan operation. - * gnus-registry.el (regtest-nnmail): Use - gnus-internal-registry-spool-current-method. + * gnus-registry.el (regtest-nnmail): + Use gnus-internal-registry-spool-current-method. 2003-02-07 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -4946,7 +4937,7 @@ * gnus-registry.el: New file with examples of using the hooks. - * gnus.el (gnus-registry): Added registry customization group. + * gnus.el (gnus-registry): Add registry customization group. (gnus-group-prefixed-name): Improve function to return full group name optionally. (gnus-group-guess-prefixed-name): Shortcut to @@ -4990,8 +4981,8 @@ 2003-02-07 Simon Josefsson <jas@extundo.com> - * mml-sec.el (mml-unsecure-message): Don't use kill-region. Tiny - patch from deskpot@myrealbox.com (Vasily Korytov). + * mml-sec.el (mml-unsecure-message): Don't use kill-region. + Tiny patch from deskpot@myrealbox.com (Vasily Korytov). 2003-02-02 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -5000,8 +4991,8 @@ 2003-02-06 Katsumi Yamaoka <yamaoka@jpl.org> - * gnus-art.el (gnus-mime-view-part-internally): Bind - buffer-read-only to nil. + * gnus-art.el (gnus-mime-view-part-internally): + Bind buffer-read-only to nil. 2003-02-05 Katsumi Yamaoka <yamaoka@jpl.org> @@ -5120,14 +5111,14 @@ * gnus-util.el (gnus-prin1-to-string): Bind print-length and print-level. - * gnus-art.el (article-display-x-face): Removed gray x-face stuff. - (gnus-treat-display-grey-xface): Removed. + * gnus-art.el (article-display-x-face): Remove gray x-face stuff. + (gnus-treat-display-grey-xface): Remove. * gnus-fun.el (gnus-grab-cam-face): New. - (gnus-convert-image-to-gray-x-face): Removed. - (gnus-convert-gray-x-face-to-xpm): Removed. - (gnus-convert-gray-x-face-region): Removed. - (gnus-grab-gray-x-face): Removed. + (gnus-convert-image-to-gray-x-face): Remove. + (gnus-convert-gray-x-face-to-xpm): Remove. + (gnus-convert-gray-x-face-region): Remove. + (gnus-grab-gray-x-face): Remove. * nnmail.el (nnmail-expiry-wait-function): Doc indent. @@ -5179,7 +5170,7 @@ * gnus-fun.el (gnus-face-encode): New function. (gnus-convert-png-to-face): Use it. - * gnus-sum.el (gnus-summary-make-menu-bar): Added M-& to marks. + * gnus-sum.el (gnus-summary-make-menu-bar): Add M-& to marks. 2003-01-26 Jesper Harder <harder@ifa.au.dk> @@ -5201,16 +5192,16 @@ * mm-encode.el (mm-qp-or-base64): Always QP iff mm-use-ultra-safe-encoding and cleartext PGP. - * gnus-sum.el (gnus-summary-select-article): Inhibit - redisplay (mainly for secured messages). + * gnus-sum.el (gnus-summary-select-article): + Inhibit redisplay (mainly for secured messages). * nnmail.el (nnmail-article-group): Copy body too (but don't process it). 2003-01-25 Jesper Harder <harder@ifa.au.dk> - * gnus-art.el (gnus-article-setup-buffer): Reset - gnus-button-marker-list. + * gnus-art.el (gnus-article-setup-buffer): + Reset gnus-button-marker-list. 2003-01-25 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -5219,8 +5210,8 @@ 2003-01-24 Lars Magne Ingebrigtsen <larsi@gnus.org> - * nnheader.el (nnheader-directory-separator-character): New - variable. + * nnheader.el (nnheader-directory-separator-character): + New variable. 2003-01-24 Kai Großjohann <kai.grossjohann@uni-duisburg.de> @@ -5257,8 +5248,8 @@ 2003-01-24 Teodor Zlatanov <tzz@lifelogs.com> * spam.el (spam-check-blackholes, spam-split) - (spam-mark-junk-as-spam-routine, spam-summary-prepare-exit): Added - gnus-message calls to show to users what spam.el is doing. + (spam-mark-junk-as-spam-routine, spam-summary-prepare-exit): + Add gnus-message calls to show to users what spam.el is doing. 2003-01-24 Jesper Harder <harder@ifa.au.dk> @@ -5282,7 +5273,7 @@ * gnus-async.el (gnus-async-wait-for-article): Don't use a timeout. - * nntp.el (nntp-accept-process-output): Removed timeout. + * nntp.el (nntp-accept-process-output): Remove timeout. (nntp-read-timeout): New variable. (nntp-accept-process-output): Use it. @@ -5290,14 +5281,14 @@ 2003-01-23 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-sum.el (gnus-summary-first-subject): Fixed bug that I + * gnus-sum.el (gnus-summary-first-subject): Fix bug that I introduced on 2002-01-22. (gnus-summary-first-unseen-or-unread-subject): Ditto. 2003-01-23 Teodor Zlatanov <tzz@lifelogs.com> * spam.el (spam-check-regex-headers, spam-list-of-checks) - (spam-regex-headers-spam, spam-regex-headers-ham): Added spam/ham + (spam-regex-headers-spam, spam-regex-headers-ham): Add spam/ham checks of incoming mail based on simple header regexp matching. 2003-01-22 Teodor Zlatanov <tzz@lifelogs.com> @@ -5310,16 +5301,16 @@ gnus-newsgroup-unfetched, the list of articles whose headers have not been fetched from the server. - * gnus-sum.el (gnus-summary-find-next): Removed undownloaded + * gnus-sum.el (gnus-summary-find-next): Remove undownloaded parameter as it never worked due to a bug. Added check to prevent selection of any article in the gnus-newsgroup-unfetched list. - (gnus-summary-find-prev): Added check to prevent selection of any + (gnus-summary-find-prev): Add check to prevent selection of any article in the gnus-newsgroup-unfetched list. - (gnus-summary-first-subject): Documented API. Modified - implementation so that constraints are handled independently. + (gnus-summary-first-subject): Document API. + Modified implementation so that constraints are handled independently. Added check to prevent selection of any article in the gnus-newsgroup-unfetched list. - (gnus-summary-first-unseen-subject): Updated parameters in + (gnus-summary-first-unseen-subject): Update parameters in gnus-summary-first-subject call to match new API. (gnus-summary-first-unseen-or-unread-subject): Ditto. (gnus-summary-catchup): Do not mark unfetched articles as read. @@ -5330,8 +5321,8 @@ make-obsolete-variable allows only two arguments in XEmacs and Emacs 20. - * gnus-sum.el (gnus-summary-wash-hide-map): Remove - gnus-article-hide-pgp. + * gnus-sum.el (gnus-summary-wash-hide-map): + Remove gnus-article-hide-pgp. (gnus-summary-make-menu-bar): Do. * gnus-art.el (gnus-treat-strip-pgp): Make obsolete. @@ -5348,21 +5339,21 @@ 2003-01-21 Teodor Zlatanov <tzz@lifelogs.com> - * spam.el (spam-group-ham-processor-bogofilter-p): Fixed bug. - (spam-ifile-register-ham-routine, spam-ifile-ham-category): New - option to make ifile a purely binary classifier. + * spam.el (spam-group-ham-processor-bogofilter-p): Fix bug. + (spam-ifile-register-ham-routine, spam-ifile-ham-category): + New option to make ifile a purely binary classifier. 2003-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org> - * mml-sec.el (mml-secure-sign-pgpauto): Renamed. - (mml-secure-encrypt-pgpmime): Removed double. + * mml-sec.el (mml-secure-sign-pgpauto): Rename. + (mml-secure-encrypt-pgpmime): Remove double. - * gnus-sum.el (gnus-summary-mark-article-as-replied): Added - debugging statements. + * gnus-sum.el (gnus-summary-mark-article-as-replied): + Add debugging statements. 2003-01-21 Andreas Fuchs <asf@void.at> - * mml-sec.el (mml-sign-alist): Added pgpauto. + * mml-sec.el (mml-sign-alist): Add pgpauto. 2003-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -5374,7 +5365,7 @@ 2003-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-art.el (gnus-button-url-regexp): Removed |. + * gnus-art.el (gnus-button-url-regexp): Remove |. * message.el (message-send-hook): Doc fix. @@ -5394,10 +5385,10 @@ 2003-01-18 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-agent.el (gnus-agent-regenerate-group): Added interactive form. + * gnus-agent.el (gnus-agent-regenerate-group): Add interactive form. - * gnus-sum.el (gnus-summary-update-article-line): Fixed - calculation of net characters added for use in the gnus-data + * gnus-sum.el (gnus-summary-update-article-line): + Fix calculation of net characters added for use in the gnus-data structure. 2003-01-18 Kai Großjohann <kai.grossjohann@uni-duisburg.de> @@ -5431,8 +5422,8 @@ avoid encoding problems. * mailcap.el (mailcap-ps-command): New variable. - (mailcap-mime-data): Add print entry where applicable. Use - pdftotext on a tty. + (mailcap-mime-data): Add print entry where applicable. + Use pdftotext on a tty. 2003-01-16 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -5449,7 +5440,7 @@ * spam.el (spam-get-article-as-filename): New function (unused for now). (spam-get-article-as-buffer): New function. (spam-get-article-as-string): Use spam-get-article-as-buffer. - (spam-summary-prepare-exit): Fixed bug, noticed by Malcolm Purvis. + (spam-summary-prepare-exit): Fix bug, noticed by Malcolm Purvis. 2003-01-15 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -5500,7 +5491,7 @@ (spam-group-ham-processor-bogofilter-p): New functions for the new Bogofilter interface. (spam-summary-prepare-exit): Use the new Bogofilter functions. - (spam-list-of-checks): Added spam-use-bogofilter-headers. + (spam-list-of-checks): Add spam-use-bogofilter-headers. (spam-bogofilter-score): Rewrote function. (spam-check-bogofilter): Optional score parameter, uses spam-check-bogofilter-headers better. @@ -5546,9 +5537,9 @@ 2003-01-13 Jhair Tocancipa Triana <jhair_tocancipa@gmx.net> - * gnus-audio.el (gnus-audio-au-player, gnus-audio-wav-player): Use - /usr/bin/play as default player. - (gnus-audio-play): Added ARG-DESCRIPTOR to prompt for a file to play. + * gnus-audio.el (gnus-audio-au-player, gnus-audio-wav-player): + Use /usr/bin/play as default player. + (gnus-audio-play): Add ARG-DESCRIPTOR to prompt for a file to play. 2003-01-14 Katsumi Yamaoka <yamaoka@jpl.org> @@ -5560,7 +5551,7 @@ fictitious headers generated by nnagent (ie. Undownloaded Article ####) in the list of articles that have not been downloaded. - * gnus-int.el (): Added require declarations to resolve + * gnus-int.el (): Add require declarations to resolve compile-time warnings. (gnus-open-server): If the server status is set to offline, recursively execute gnus-open-server to open the offline backend @@ -5568,8 +5559,8 @@ 2003-01-14 Jesper Harder <harder@ifa.au.dk> - * gnus-art.el (gnus-article-reply-with-original): Use - gnus-mark-active-p. + * gnus-art.el (gnus-article-reply-with-original): + Use gnus-mark-active-p. (gnus-article-followup-with-original): Do. 2003-01-13 Reiner Steib <Reiner.Steib@gmx.de> @@ -5596,8 +5587,8 @@ * deuglify.el (gnus-article-outlook-unwrap-lines) (gnus-article-outlook-repair-attribution) (gnus-article-outlook-rearrange-citation): New function names, - renamed from "gnus-outlook-" to "gnus-article-outlook-". Changed - doc-string. + renamed from "gnus-outlook-" to "gnus-article-outlook-". + Changed doc-string. * gnus-sum.el (gnus-summary-mode-map): Use new function names, removed `W k' key binding (use `W Y f' instead). @@ -5632,7 +5623,7 @@ 2003-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org> - * mail-source.el (mail-sources): Removed autoload to make it + * mail-source.el (mail-sources): Remove autoload to make it compile under XEmacs. 2003-01-12 Raymond Scholz <ray-2003@zonix.de> @@ -5660,8 +5651,8 @@ 2003-01-12 Simon Josefsson <jas@extundo.com> - * sieve.el (sieve-upload-and-bury): New. Suggested by - kai.grossjohann@uni-duisburg.de (Kai Großjohann). + * sieve.el (sieve-upload-and-bury): New. + Suggested by kai.grossjohann@uni-duisburg.de (Kai Großjohann). * sieve-mode.el (sieve-mode-map): Bind s-u-a-b to C-c C-c. Suggested by kai.grossjohann@uni-duisburg.de (Kai Großjohann). @@ -5706,8 +5697,8 @@ 2003-01-10 Reiner Steib <Reiner.Steib@gmx.de> - * deuglify.el (gnus-outlook-deuglify-attrib-verb-regexp): Added - castellano. + * deuglify.el (gnus-outlook-deuglify-attrib-verb-regexp): + Add castellano. (gnus-outlook-display-hook): New variable. (gnus-outlook-display-article-buffer): New function. (gnus-outlook-unwrap-lines, gnus-outlook-repair-attribution) @@ -5716,8 +5707,8 @@ (gnus-article-outlook-deuglify-article): Use `g-o-d-a-b'. * gnus-sum.el: Added autoloads. - (gnus-summary-mode-map): Added gnus-summary-wash-deuglify-map. - (gnus-summary-make-menu-bar): Added "(Outlook) Deuglify" menu. + (gnus-summary-mode-map): Add gnus-summary-wash-deuglify-map. + (gnus-summary-make-menu-bar): Add "(Outlook) Deuglify" menu. 2003-01-11 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -5765,7 +5756,7 @@ * gnus-fun.el (gnus-face-from-file): New function. (gnus-convert-face-to-png): Ditto. - * gnus-art.el (gnus-ignored-headers): Added Face. + * gnus-art.el (gnus-ignored-headers): Add Face. 2003-01-10 Simon Josefsson <jas@extundo.com> @@ -5787,13 +5778,13 @@ * spam-stat.el (spam-stat): Typo fix. (spam-stat-install-hooks): New variable. - (spam-stat-split-fancy-spam-group): Added documentation clarification. + (spam-stat-split-fancy-spam-group): Add documentation clarification. (spam-stat-split-fancy-spam-threshhold): New variable. (spam-stat-install-hooks): Make hooks conditional. (spam-stat-split-fancy): Use spam-stat-split-fancy-spam-threshhold. - * gnus.el (gnus-group-ham-exit-processor-stat, spam-process): Add - spam-stat ham/spam processor symbols. + * gnus.el (gnus-group-ham-exit-processor-stat, spam-process): + Add spam-stat ham/spam processor symbols. 2003-01-10 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -5811,7 +5802,7 @@ 2003-01-09 Teodor Zlatanov <tzz@lifelogs.com> - * spam.el (spam-check-ifile): Fixed call-process-region to use the + * spam.el (spam-check-ifile): Fix call-process-region to use the db parameter only if it's set. (spam-ifile-register-with-ifile): Ditto. @@ -5857,17 +5848,17 @@ * spam.el: Fixed the BBDB autoloads again, using bbdb-search-simple now (which is not a macro, thank god). - * gnus.el (ham-process-destination): Added new parameter for + * gnus.el (ham-process-destination): Add new parameter for destination of ham articles found in spam groups at summary exit. * spam.el (spam-get-ifile-database-parameter): use spam-ifile-database-path. (spam-check-ifile, spam-ifile-register-with-ifile): use spam-get-ifile-database-parameter. - (spam-ifile-database-path): Added new parameter for ifile's database. + (spam-ifile-database-path): Add new parameter for ifile's database. (spam-move-spam-nonspam-groups-only): New parameter to determine if spam should be moved from all groups or only some. - (spam-summary-prepare-exit): Fixed logic to use + (spam-summary-prepare-exit): Fix logic to use spam-move-spam-nonspam-groups-only when deciding to invoke spam-mark-spam-as-expired-and-move-routine; always invoke that routine after the spam has been expired-or-moved in case there's @@ -5879,8 +5870,8 @@ * gnus-spec.el (gnus-parse-complex-format): %~ => ~*. - * gnus-agent.el (gnus-agent-fetch-selected-article): Use - gnus-summary-update-article-line. + * gnus-agent.el (gnus-agent-fetch-selected-article): + Use gnus-summary-update-article-line. 2003-01-08 Simon Josefsson <jas@extundo.com> @@ -5889,7 +5880,7 @@ 2003-01-07 Teodor Zlatanov <tzz@lifelogs.com> - * spam.el (spam-check-ifile): Fixed the spam-ifile-all-categories + * spam.el (spam-check-ifile): Fix the spam-ifile-all-categories logic, finally. 2003-01-08 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -5914,21 +5905,21 @@ * message.el (message-make-mail-followup-to, message-generate-unsubscribed-mail-followup-to): New function names. Renamed functions: "-mft" -> "-mail-followup-to". - (message-make-mft, message-gen-unsubscribed-mft): Removed function + (message-make-mft, message-gen-unsubscribed-mft): Remove function names. * mml.el (mml-preview-insert-mail-followup-to): New function name. - (mml-preview-insert-mft): Removed function name. + (mml-preview-insert-mft): Remove function name. (mml-preview): Use new function names. * gnus-art.el (gnus-article-edit-mode-map): Use new function names. - * message.el (message-mode-field-menu): Moved header related + * message.el (message-mode-field-menu): Move header related commands from "Message" to "Field" menu. 2003-01-07 Reiner Steib <Reiner.Steib@gmx.de> - * message.el (message-generate-headers-first): Added customization + * message.el (message-generate-headers-first): Add customization if variable is a list. 2003-01-07 Michael Shields <shields@msrl.com> @@ -5940,8 +5931,8 @@ * gnus-msg.el (gnus-debug): Use ignore-errors. - * gnus-agent.el (gnus-agent-fetch-selected-article): Use - `gnus-summary-update-line'. + * gnus-agent.el (gnus-agent-fetch-selected-article): + Use `gnus-summary-update-line'. 2003-01-08 Simon Josefsson <jas@extundo.com> @@ -5969,8 +5960,8 @@ 2003-01-07 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-sum.el (gnus-summary-make-menu-bar): Added - gnus-summary-refer-thread to thread menu. + * gnus-sum.el (gnus-summary-make-menu-bar): + Add gnus-summary-refer-thread to thread menu. 2003-01-07 Kevin Greiner <kgreiner@xpediantsolutions.com> @@ -5986,16 +5977,16 @@ * spam.el (spam-check-ifile, spam-ifile-register-with-ifile) (spam-ifile-register-spam-routine) - (spam-ifile-register-ham-routine): Added ifile functionality that + (spam-ifile-register-ham-routine): Add ifile functionality that does not use ifile-gnus.el to classify and register articles. (spam-get-article-as-string): Convenience function. - (spam-summary-prepare-exit): Added ifile spam and ham registration. + (spam-summary-prepare-exit): Add ifile spam and ham registration. (spam-ifile-all-categories, spam-ifile-spam-category) - (spam-ifile-path, spam-ifile): Added customization options. + (spam-ifile-path, spam-ifile): Add customization options. - * gnus.el (gnus-group-ham-exit-processor-ifile): Added ifile ham + * gnus.el (gnus-group-ham-exit-processor-ifile): Add ifile ham exit processor. - (spam-process): Added gnus-group-ham-exit-processor-ifile to the + (spam-process): Add gnus-group-ham-exit-processor-ifile to the list of choices. 2003-01-07 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -6005,7 +5996,7 @@ 2003-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org> - * nnweb.el (nnweb-asynchronous-p): Changed to nil. + * nnweb.el (nnweb-asynchronous-p): Change to nil. 2003-01-07 Simon Josefsson <jas@extundo.com> @@ -6033,14 +6024,14 @@ 2003-01-06 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-agent.el (gnus-agent-fetch-group): Modified to permit execution + * gnus-agent.el (gnus-agent-fetch-group): Modify to permit execution in either the group or summary buffer. New command "JS", in summary buffer, will fetch articles per the group's category, predicate, and processable flags. (gnus-agent-summary-fetch-series): Rewritten to call gnus-agent-session-fetch-group once with all articles in the series. - (gnus-agent-summary-fetch-group): Fixed bug and modified code to + (gnus-agent-summary-fetch-group): Fix bug and modified code to return list of fetched articles. (gnus-agent-fetch-articles): Split fetch list into sublists such that the article buffer is only slightly larger than @@ -6055,9 +6046,9 @@ When called in the group buffer, articles that can not be fetched are AUTOMATICALLY MARKED AS READ. - * gnus-sum.el (): Modified eval-when-compile to minimize + * gnus-sum.el (): Modify eval-when-compile to minimize misleading compilation warnings. - (gnus-update-summary-mark-positions): Changed code to use + (gnus-update-summary-mark-positions): Change code to use gnus-undownloaded-mark rather than gnus-downloaded-mark. * nnheader.el (nnheader-insert-nov-file): Do not try to insert an @@ -6071,18 +6062,18 @@ determine the appropriate course of action. Instead, two function implementations are provided and the nntp-report function value is bound to the appropriate implementation. - (nntp-retrieve-data): Moved nntp-report call to end of implementation. + (nntp-retrieve-data): Move nntp-report call to end of implementation. (nntp-with-open-group): Now binds nntp-report's function cell rather than binding gnus-with-open-group-first-pass. Added a condition-case to detect a quit during a nntp command. When the quit occurs, the current connection is closed as a fetch articles request could have several megabytes queued up for reading. - (nntp-retrieve-headers): Bind articles to itself. If - nntp-with-open-group repeats this command, I must have access to + (nntp-retrieve-headers): Bind articles to itself. + If nntp-with-open-group repeats this command, I must have access to the original list of articles. (nntp-retrieve-groups): Ditto for groups. (nntp-retrieve-articles): Ditto for articles. - (*): Replaced nntp-possibly-change-group calls to + (*): Replace nntp-possibly-change-group calls to nntp-with-open-group forms in all, but one, occurrence. (nntp-accept-process-output): Bug fix. Detect when called with null process. @@ -6106,8 +6097,8 @@ * mm-url.el (mm-url-program): Doc fix. - * message.el (message-mode-map): Rebound - message-insert-wide-reply. + * message.el (message-mode-map): + Rebound message-insert-wide-reply. 2003-01-05 Katsumi Yamaoka <yamaoka@jpl.org> @@ -6118,9 +6109,9 @@ * spam.el: Fixed line lengths to 80 chars or less. - * gnus-sum.el (gnus-read-mark-p): Added the spam-mark as a + * gnus-sum.el (gnus-read-mark-p): Add the spam-mark as a "not-read" mark. - (gnus-summary-mark-forward): Added the spam-mark to the list of + (gnus-summary-mark-forward): Add the spam-mark to the list of marks not to be marked as "read" when viewed. 2003-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -6170,8 +6161,8 @@ 2003-01-04 Kevin Ryde <user42@zip.com.au> - * gnus-art.el (gnus-mime-jka-compr-maybe-uncompress): New - function. + * gnus-art.el (gnus-mime-jka-compr-maybe-uncompress): + New function. 2003-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -6215,7 +6206,7 @@ (spam-generic-register-routine, spam-BBDB-register-routine) (spam-ifile-register-routine, spam-blacklist-register-routine) (spam-whitelist-register-routine): New functions. - (spam-summary-prepare-exit): Added summary exit processing (expire + (spam-summary-prepare-exit): Add summary exit processing (expire or move) of spam-marked articles for spam groups; added slots for all the spam-*-register-routine functions. @@ -6254,8 +6245,8 @@ 2003-01-02 Jesper Harder <harder@ifa.au.dk> - * gnus-group.el (gnus-group-fetch-charter): Use - http://TLH.news-admin.org/charters/GROUPNAME as a fallback. + * gnus-group.el (gnus-group-fetch-charter): + Use http://TLH.news-admin.org/charters/GROUPNAME as a fallback. 2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -6316,13 +6307,13 @@ * gnus.el (nnheader): Require nnheader. - * nndraft.el (nndraft-request-associate-buffer): Use - make-local-variable. + * nndraft.el (nndraft-request-associate-buffer): + Use make-local-variable. 2003-01-02 Michael Shields <shields@msrl.com> - * nndraft.el (nndraft-request-associate-buffer): Make - write-contents-hooks buffer-local before setting it. + * nndraft.el (nndraft-request-associate-buffer): + Make write-contents-hooks buffer-local before setting it. 2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -6344,11 +6335,11 @@ 2003-01-01 Teodor Zlatanov <tzz@lifelogs.com> - * spam.el (spam-summary-prepare-exit): Added slots for spam- and + * spam.el (spam-summary-prepare-exit): Add slots for spam- and ham-processing of articles; use the new spam-group-(spam|ham)-contents-p functions. - (spam-group-spam-contents-p, spam-group-ham-contents-p): New - convenience functions. + (spam-group-spam-contents-p, spam-group-ham-contents-p): + New convenience functions. (spam-mark-junk-as-spam-routine): Use the new spam-group-spam-contents-p function. @@ -6360,13 +6351,13 @@ (gnus-group-spam-exit-processor-whitelist) (gnus-group-spam-exit-processor-BBDB) (gnus-group-spam-classification-spam) - (gnus-group-spam-classification-ham): Added new symbols for the + (gnus-group-spam-classification-ham): Add new symbols for the spam-process and spam-contents parameters. - * spam.el (spam-ham-marks, spam-spam-marks): Changed list + * spam.el (spam-ham-marks, spam-spam-marks): Change list customization and list itself to store mark symbol rather than mark character. - (spam-bogofilter-register-routine): Added logic to generate mark + (spam-bogofilter-register-routine): Add logic to generate mark values list from spam-ham-marks and spam-spam-marks, so (member) would work. @@ -6376,10 +6367,10 @@ 2003-01-01 Teodor Zlatanov <tzz@lifelogs.com> - * spam.el (spam-ham-marks, spam-spam-marks): Changed list + * spam.el (spam-ham-marks, spam-spam-marks): Change list customization and list itself to store mark symbol rather than mark character. - (spam-bogofilter-register-routine): Added logic to generate mark + (spam-bogofilter-register-routine): Add logic to generate mark values list from spam-ham-marks and spam-spam-marks, so (member) would work. @@ -6396,16 +6387,16 @@ message-cross-post-note-function): New variables names. (message-xpost-old-target, message-xpost-default, message-xpost-note, message-fup2-note, - message-xpost-note-function): Removed variable names. + message-xpost-note-function): Remove variable names. (message-cross-post-followup-to-header, message-cross-post-insert-note, message-cross-post-followup-to): New function names. (message-xpost-fup2-header, message-xpost-insert-note, - message-xpost-fup2): Removed function names. + message-xpost-fup2): Remove function names. 2002-12-30 Reiner Steib <Reiner.Steib@gmx.de> - * message.el (message-send-mail): Added message-cleanup-headers to + * message.el (message-send-mail): Add message-cleanup-headers to prevent newlines in headers. 2003-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -6417,8 +6408,8 @@ 2003-01-01 Wes Hardaker <wes@hardakers.net> - * gnus-sum.el (gnus-summary-display-while-building): New - variable. + * gnus-sum.el (gnus-summary-display-while-building): + New variable. 2003-01-01 Raymond Scholz <ray-2003@zonix.de> @@ -6435,8 +6426,8 @@ lambda form. (message-draft-headers): New variable. - * gnus-msg.el (gnus-inews-make-draft-meta-information): New - function. + * gnus-msg.el (gnus-inews-make-draft-meta-information): + New function. (gnus-setup-message): Use it. * message.el (message-generate-headers-first): Doc fix. @@ -6455,8 +6446,8 @@ 2002-12-31 Raymond Scholz <ray-2002@zonix.de> - * deuglify.el (gnus-outlook-rearrange-article): Use - `transpose-regions' instead of tempering the kill-ring. + * deuglify.el (gnus-outlook-rearrange-article): + Use `transpose-regions' instead of tempering the kill-ring. (gnus-article-outlook-deuglify-article): Rehighlight article instead of a complete redisplay. @@ -6515,7 +6506,7 @@ 2002-12-30 Reiner Steib <Reiner.Steib@gmx.de> - * message.el (message-completion-alist): Added "Mail-Followup-To" + * message.el (message-completion-alist): Add "Mail-Followup-To" and "Mail-Copies-To". 2002-07-21 Jesper Harder <harder@ifa.au.dk> @@ -6528,10 +6519,10 @@ * spam.el (spam-use-dig): New variable for blackhole checking through dig.el. - (spam-check-blackholes): Added dig.el checking functionality and + (spam-check-blackholes): Add dig.el checking functionality and more verbose reporting; query-dig is autoloaded from dig.el. (spam-use-blackholes): Disabled by default. - (spam-blackhole-servers): Removed rbl.maps.vix.com from the + (spam-blackhole-servers): Remove rbl.maps.vix.com from the blackhole servers list. 2002-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -6555,7 +6546,7 @@ 2002-08-10 Jari Aalto <jari.aalto@poboxes.com> - * nnmail.el (nnmail-split-it): Added tracing to + * nnmail.el (nnmail-split-it): Add tracing to `:' split rule. 2002-08-13 Hrvoje Niksic <hniksic@xemacs.org> @@ -6581,7 +6572,7 @@ * gnus-topic.el (gnus-topic-display-missing-topic): New function. (gnus-topic-goto-missing-group): Use it. - * message.el (message-required-news-headers): Removed Lines. + * message.el (message-required-news-headers): Remove Lines. (message-reply): Don't insert References first. (message-followup): Ditto. (message-make-references): New function. @@ -6702,7 +6693,7 @@ 2002-12-12 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-agent.el (gnus-agent-fetch-selected-article): Added call to + * gnus-agent.el (gnus-agent-fetch-selected-article): Add call to gnus-summary-update-download-mark to update the article in the summary. @@ -6712,14 +6703,14 @@ gnus-summary-normal-uncached-face, gnus-summary-low-uncached-face) New faces. - * gnus-agent.el (gnus-agent-downloaded-article-face): REMOVED. I - added this on 2002-11-23 but it just wasn't working out as + * gnus-agent.el (gnus-agent-downloaded-article-face): REMOVED. + I added this on 2002-11-23 but it just wasn't working out as intended. The idea isn't entirely dead, three new faces gnus-summary-*-uncached-face are being added to gnus.el to provide the basis for an improved implementation. - (gnus-agent-read-servers): Undo the change made on 2002-11-23. The - proper file to open is lib/servers. - (gnus-summary-set-agent-mark): Expanded documentation. Unmarking + (gnus-agent-read-servers): Undo the change made on 2002-11-23. + The proper file to open is lib/servers. + (gnus-summary-set-agent-mark): Expand documentation. Unmarking (i.e. removing the article from gnus-newsgroup-downloadable) will now restore the article's default mark rather than simply setting no mark. @@ -6730,8 +6721,8 @@ (gnus-agent-summary-fetch-group): Keep gnus-newsgroup-undownloaded up to date. Call new gnus-summary-update-download-mark to keep summary buffer up-to-date. - (gnus-agent-fetch-selected-article): Keep - gnus-newsgroup-undownloaded up to date. + (gnus-agent-fetch-selected-article): + Keep gnus-newsgroup-undownloaded up to date. (gnus-agent-fetch-articles): Return list of articles that were successfully fetched. (gnus-agent-check-overview-buffer): No more thingatpt. @@ -6749,14 +6740,14 @@ downloaded/undownloaded mark is no longer stored as the article's mark. - * gnus-salt.el (gnus-tree-highlight-node): Added uncached as + * gnus-salt.el (gnus-tree-highlight-node): Add uncached as gnus-summary-highlight may use it. Added downloaded as gnus-summary-highlight was using it. - * gnus-sum.el (gnus-undownloaded-mark): Changed from ?@ to ?- as + * gnus-sum.el (gnus-undownloaded-mark): Change from ?@ to ?- as the download mark now follows Kai's +/- convention. - (gnus-downloaded-mark): Added ?+ mark. - (gnus-summary-highlight): Added rules to select + (gnus-downloaded-mark): Add ?+ mark. + (gnus-summary-highlight): Add rules to select gnus-summary-high-uncached-face, gnus-summary-normal-uncached-face, and gnus-summary-low-uncached-face. Removed the @@ -6770,7 +6761,7 @@ you don't have to agentize every server that you use. (gnus-update-summary-mark-positions): Completed support for the download type of mark. - (gnus-summary-insert-line): Added undownloaded to the parameters. + (gnus-summary-insert-line): Add undownloaded to the parameters. (gnus-summary-prepare-threads): Set gnus-tmp-downloaded for reference by the gnus-summary-line-format-spec. @@ -6816,8 +6807,8 @@ 2002-12-09 Kai Großjohann <kai.grossjohann@uni-duisburg.de> - * nntp.el (nntp-send-command): Braino in last commit. Replace - `and' with `or'. + * nntp.el (nntp-send-command): Braino in last commit. + Replace `and' with `or'. 2002-12-08 Kai Großjohann <kai.grossjohann@uni-duisburg.de> @@ -6850,7 +6841,7 @@ 2002-11-29 Kai Großjohann <kai.grossjohann@uni-duisburg.de> - * gnus-art.el (gnus-inhibit-mime-unbuttonizing): Moved here from + * gnus-art.el (gnus-inhibit-mime-unbuttonizing): Move here from gnus-sum. Made into a user option. * gnus-sum.el (gnus-simplify-ignored-prefixes) @@ -6911,7 +6902,7 @@ (gnus-summary-mark-article-as-unread) (gnus-mark-article-as-unread, gnus-summary-highlight-line): Reformatting to avoid long lines. - (gnus-inhibit-mime-unbuttonizing): Moved to gnus-art. + (gnus-inhibit-mime-unbuttonizing): Move to gnus-art. 2002-11-28 Daiki Ueno <ueno@unixuser.org> @@ -6933,15 +6924,15 @@ 2002-11-26 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-agent.el (gnus-agent-uncached-articles): If - gnus-agent-load-alist fails, return ARTICLES. + * gnus-agent.el (gnus-agent-uncached-articles): + If gnus-agent-load-alist fails, return ARTICLES. * nnrss.el (nnrss-group-alist): Update the link of Jabber. 2002-11-26 Kai Großjohann <kai.grossjohann@uni-duisburg.de> - * gnus-sum.el (gnus-summary-insert-old-articles): Remove - superfluous function call. + * gnus-sum.el (gnus-summary-insert-old-articles): + Remove superfluous function call. (gnus-summary-catchup-all, gnus-summary-catchup-all-and-exit): Add warning to docstring. @@ -6952,8 +6943,8 @@ 2002-11-26 Kai Großjohann <kai.grossjohann@uni-duisburg.de> - * gnus-agent.el (gnus-agent-check-overview-buffer): Explicitly - require thingatpt (for number-at-point) and protect against + * gnus-agent.el (gnus-agent-check-overview-buffer): + Explicitly require thingatpt (for number-at-point) and protect against deactivate-mark being unbound (on XEmacs). 2002-11-25 Kai Großjohann <kai.grossjohann@uni-duisburg.de> @@ -6968,8 +6959,8 @@ 2002-11-24 Kai Großjohann <kai.grossjohann@uni-duisburg.de> - * gnus-sum.el (gnus-summary-insert-old-articles): Use - gnus-remove-from-range instead of gnus-range-difference which + * gnus-sum.el (gnus-summary-insert-old-articles): + Use gnus-remove-from-range instead of gnus-range-difference which doesn't exist. 2002-11-23 Kevin Greiner <kgreiner@xpediantsolutions.com> @@ -6979,11 +6970,11 @@ (gnus-agent-article-alist): Format change. Add documentation. (gnus-agent-summary-mode-map): New keybinding `J s' for fetching process-marked articles. - (gnus-agent-summary-fetch-series): Command for `J s'. Articles - in the series are individually fetched to minimize lose of + (gnus-agent-summary-fetch-series): Command for `J s'. + Articles in the series are individually fetched to minimize lose of content due to an error/quit. - (gnus-agent-synchronize-flags-server, gnus-agent-add-server): Use - gnus-message instead of message. + (gnus-agent-synchronize-flags-server, gnus-agent-add-server): + Use gnus-message instead of message. (gnus-agent-read-servers): Use file lib/methods instead of lib/servers. TODO: Why? (gnus-summary-set-agent-mark): Adapt to new agent-alist format. @@ -6992,7 +6983,7 @@ (gnus-agent-fetch-selected-article): Don't use history. (gnus-agent-save-history, gnus-agent-enter-history) (gnus-agent-article-in-history-p, gnus-agent-history-path): - Removed function; history is not used anymore. + Remove function; history is not used anymore. (gnus-agent-fetch-articles): Fix handling of crossposted articles. (gnus-agent-crosspost): Started rewrite then realized that a typo in gnus-agent-fetch-articles ensures that this function is never @@ -7022,8 +7013,8 @@ (gnus-agent-regenerate-group): No longer needs to be called from gnus-agent-regenerate. Individual groups may be regenerated. The regeneration code now fixes duplicate, and mis-ordered, NOV entries. - The article fetch dates are validated in the article alist. The - article alist is pruned of entries that do not reference existing + The article fetch dates are validated in the article alist. + The article alist is pruned of entries that do not reference existing NOV entries. All changes are computed then applied with inhibit-quit bound to t. As a result, it is now safe to quit out of regeneration. The optional clean parameter has been replaced with @@ -7031,11 +7022,11 @@ regeneration gets the appropriate setting from gnus-agent-consider-all-articles. The new reread parameter will result in fetched, or all, articles being marked as unread. - (gnus-agent-regenerate): Removed code to regenerate the history + (gnus-agent-regenerate): Remove code to regenerate the history file as it is no longer used. - * gnus-start.el (gnus-make-ascending-articles-unread): New - function, for efficient mass-marking. + * gnus-start.el (gnus-make-ascending-articles-unread): + New function, for efficient mass-marking. * gnus-sum.el (gnus-summary-highlight): Use new face for downloaded articles. @@ -7045,7 +7036,7 @@ line. (gnus-summary-highlight-line): Use new face for downloaded articles. - (gnus-summary-insert-old-articles): Improved performance by + (gnus-summary-insert-old-articles): Improve performance by replacing the initial LIST of older articles with a compressed RANGE of older articles. Some servers appear to lie about their active range so the original list could contain millions @@ -7069,8 +7060,8 @@ 2002-11-19 Simon Josefsson <jas@extundo.com> - * gnus-sum.el (gnus-summary-morse-message): Load - morse.el (unmorse-region not autoloaded in Emacs 20 nor XEmacs). + * gnus-sum.el (gnus-summary-morse-message): + Load morse.el (unmorse-region not autoloaded in Emacs 20 nor XEmacs). (unmorse-region): Autoload it instead. 2002-11-18 Simon Josefsson <jas@extundo.com> @@ -7097,13 +7088,13 @@ 2002-11-17 ShengHuo ZHU <zsh@cs.rochester.edu> - * message.el (message-set-auto-save-file-name): Use - make-directory, to avoid the dependence on gnus-util. + * message.el (message-set-auto-save-file-name): + Use make-directory, to avoid the dependence on gnus-util. 2002-11-16 Simon Josefsson <jas@extundo.com> * nnimap.el (nnimap-callback-callback-function): - (nnimap-callback-buffer): Removed, these cannot be global but must + (nnimap-callback-buffer): Remove, these cannot be global but must be embedded into the callback. (nnimap-make-callback): New. Embedd article number, callback and buffer in function. @@ -7119,8 +7110,8 @@ 2002-11-11 Simon Josefsson <jas@extundo.com> - * pgg.el (pgg-encrypt, pgg-decrypt, pgg-sign, pgg-verify): Display - output when called interactively. + * pgg.el (pgg-encrypt, pgg-decrypt, pgg-sign, pgg-verify): + Display output when called interactively. 2002-11-08 Katsumi Yamaoka <yamaoka@jpl.org> @@ -7201,15 +7192,15 @@ works better. (gnus-agent-fetch-headers): New implementation from Kevin Greiner. Uses gnus-agent-article-alist to store information - about fetched messages which aren't on the server anymore. The - trick is to return a list of considered messages to the caller, + about fetched messages which aren't on the server anymore. + The trick is to return a list of considered messages to the caller, but to only fetch those which haven't been fetched yet. 2002-10-30 Simon Josefsson <jas@extundo.com> * pgg-def.el (pgg-passphrase-cache-expiry): New, defcustom. - * pgg.el (pgg-passphrase-cache-expiry): Removed. + * pgg.el (pgg-passphrase-cache-expiry): Remove. 2002-10-30 TSUCHIYA Masatoshi <tsuchiya@namazu.org> @@ -7217,14 +7208,14 @@ versions of emacs-w3m than 1.3.3. * mm-view.el (mm-w3m-mode-command-alist) - (mm-w3m-mode-dont-bind-keys, mm-w3m-mode-ignored-keys): Removed. + (mm-w3m-mode-dont-bind-keys, mm-w3m-mode-ignored-keys): Remove. (mm-w3m-mode-map): Undefined for Emacs21 and XEmacs. - (mm-setup-w3m): Simplified. + (mm-setup-w3m): Simplify. (mm-w3m-local-map-property): New function. (mm-inline-text-html-render-with-w3m): Use it. - * gnus-art.el (gnus-article-wash-html-with-w3m): Use - mm-w3m-local-map-property. + * gnus-art.el (gnus-article-wash-html-with-w3m): + Use mm-w3m-local-map-property. 2002-10-29 Katsumi Yamaoka <yamaoka@jpl.org> @@ -7240,7 +7231,7 @@ 2002-10-28 Josh Huber <huber@alum.wpi.edu> - * mml.el (mml-mode-map): Fixed keybindings for mml-secure-* + * mml.el (mml-mode-map): Fix keybindings for mml-secure-* functions. 2002-10-28 Mark A. Hershberger <mah@everybody.org> @@ -7256,8 +7247,8 @@ 2002-10-25 Kai Großjohann <kai.grossjohann@uni-duisburg.de> - * gnus-agent.el (gnus-agent-save-fetched-headers): Create - directory if it doesn't exist. + * gnus-agent.el (gnus-agent-save-fetched-headers): + Create directory if it doesn't exist. (gnus-agent-fetch-headers): Remove old cruft that tried to abstain from downloading articles more than once if gnus-agent-consider-all-articles was true. This is now done @@ -7289,8 +7280,8 @@ * gnus-agent.el (gnus-agent-fetched-headers): New variable, contains range of headers that have been fetched by the agent already. Compare gnus-agent-article-alist. - (gnus-agent-file-header-cache): Like - gnus-agent-file-loading-cache, but for gnus-agent-fetched-headers. + (gnus-agent-file-header-cache): + Like gnus-agent-file-loading-cache, but for gnus-agent-fetched-headers. (gnus-agent-fetch-headers): Improve comment. Revert to old seen/recent logic. Remember which headers have been fetched before and don't fetch @@ -7351,7 +7342,7 @@ * gnus-group.el (gnus-fetch-group): Allow an optional specification of the articles to select. - * gnus-srvr.el (gnus-server-prepare): Removed superfluous cdr. + * gnus-srvr.el (gnus-server-prepare): Remove superfluous cdr. 2002-10-20 Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> @@ -7363,8 +7354,8 @@ 2002-10-20 Steve Youngs <youngs@xemacs.org> - * pgg-parse.el (pgg-parse-public-key-algorithm-alist): XEmacs - doesn't have the 'alist custom type, use cons cells instead. + * pgg-parse.el (pgg-parse-public-key-algorithm-alist): + XEmacs doesn't have the 'alist custom type, use cons cells instead. (pgg-parse-symmetric-key-algorithm-alist): Ditto. (pgg-parse-hash-algorithm-alist): Ditto. (pgg-parse-compression-algorithm-alist): Ditto. @@ -7441,8 +7432,8 @@ (nnheader-remove-cr-followed-by-lf): New function. (nnheader-ms-strip-cr): Use the above function. - * gnus-agent.el (gnus-agent-regenerate-group): Call - `nnheader-remove-body'; use `nnheader-parse-naked-head' instead of + * gnus-agent.el (gnus-agent-regenerate-group): + Call `nnheader-remove-body'; use `nnheader-parse-naked-head' instead of `nnheader-parse-head'. * gnus-cache.el (gnus-cache-possibly-enter-article): Ditto. @@ -7463,8 +7454,8 @@ 2002-10-16 Katsumi Yamaoka <yamaoka@jpl.org> * spam-stat.el: Check for the existence of hash functions instead - of the Emacs version to decide whether to load cl. Suggested by - Kai Großjohann. + of the Emacs version to decide whether to load cl. + Suggested by Kai Großjohann. 2002-10-15 Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> @@ -7487,7 +7478,7 @@ 2002-10-11 Teodor Zlatanov <tzz@lifelogs.com> - * spam.el (spam-check-ifile): Added ifile as a spam checking + * spam.el (spam-check-ifile): Add ifile as a spam checking backend, and spam-use-ifle as the variable to toggle that check. 2002-10-12 Simon Josefsson <jas@extundo.com> @@ -7526,7 +7517,7 @@ * mml2015.el (mml2015-pgg-decrypt): Set gnus details even when decrypt failed. - (mml2015-trust-boundaries-alist): Removed. + (mml2015-trust-boundaries-alist): Remove. (mml2015-gpg-extract-signature-details): Don't use it. (mml2015-unabbrev-trust-alist): New. (mml2015-gpg-extract-signature-details): Use it. @@ -7547,8 +7538,8 @@ * pgg-gpg.el (pgg-gpg-verify-region): Filter out stuff into output buffer and error buffer depending on type of information. - * mml2015.el (mml2015-gpg-extract-signature-details): Parse - --status-fd stuff even if gpg.el is not used (revert earlier + * mml2015.el (mml2015-gpg-extract-signature-details): + Parse --status-fd stuff even if gpg.el is not used (revert earlier change). (mml2015-pgg-{clear-,}verify): Store both output and errors as gnus details. @@ -7594,8 +7585,8 @@ 2002-10-08 Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> - * gnus-agent.el (gnus-agent-fetch-selected-article): Bind - gnus-agent-current-history. + * gnus-agent.el (gnus-agent-fetch-selected-article): + Bind gnus-agent-current-history. 2002-10-06 Simon Josefsson <jas@extundo.com> @@ -7623,8 +7614,8 @@ * pgg-gpg.el (pgg-gpg-encrypt-region): Make signencrypt work. - * pgg-pgp.el (pgg-pgp-verify-region): Inline - binary-write-decoded-region from MEL. + * pgg-pgp.el (pgg-pgp-verify-region): + Inline binary-write-decoded-region from MEL. * pgg.el (pgg-encrypt-region): Support sign. @@ -7679,13 +7670,13 @@ (pgg-string-as-unibyte): Defalias. (pgg-parse-armor-region): Use it. - * pgg-gpg.el (pgg-gpg-process-region): Use - pgg-temporary-file-directory. + * pgg-gpg.el (pgg-gpg-process-region): + Use pgg-temporary-file-directory. * luna.el: Don't def-edebug. - * pgg-pgp5.el (pgg-scheme-verify-region): Inline - binary-write-decoded-region from MEL. + * pgg-pgp5.el (pgg-scheme-verify-region): + Inline binary-write-decoded-region from MEL. * pgg-pgp5.el, pgg-gpg.el: Don't require mel. @@ -7790,8 +7781,8 @@ * gnus-art.el (gnus-article-mode-syntax-table): Make M-. work in article buffers. - * nnimap.el (nnimap-fixup-unread-after-getting-new-news): Autoload - it just in case. + * nnimap.el (nnimap-fixup-unread-after-getting-new-news): + Autoload it just in case. (nnimap-update-unseen): New function; update unseen count in `n-m-info'. (nnimap-close-group): Call it. @@ -7924,8 +7915,8 @@ * gnus-art.el (gnus-button-handle-apropos-variable): Fall back to apropos if apropos-variable does not exist. (gnus-button-guessed-mid-regexp) - (gnus-button-handle-describe-prefix, gnus-button-alist): Better - regexes. + (gnus-button-handle-describe-prefix, gnus-button-alist): + Better regexes. (gnus-button-handle-describe-function) (gnus-button-handle-describe-variable): Doc fix. (gnus-button-handle-describe-key, gnus-button-handle-apropos) @@ -7960,8 +7951,8 @@ 2002-09-23 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-art.el (gnus-button-guessed-mid-regexp): Improved regexp. - (gnus-button-alist): Improved regexp for + * gnus-art.el (gnus-button-guessed-mid-regexp): Improve regexp. + (gnus-button-alist): Improve regexp for gnus-button-handle-mid-or-mail (false positives), fixed gnus-button-handle-man entries. @@ -7972,8 +7963,8 @@ 2002-09-23 Paul Jarc <prj@po.cwru.edu> - * nnmaildir.el: Store article numbers persistently. General - revision. + * nnmaildir.el: Store article numbers persistently. + General revision. (nnmaildir-request-expire-articles): Handle 'immediate and 'never for nnmail-expiry-wait; delete instead of moving if 'force is given. @@ -8015,8 +8006,8 @@ * gnus-msg.el (gnus-configure-posting-styles): Sort results. - * gnus-art.el (gnus-article-reply-with-original): Correct - with-current-buffer scope. + * gnus-art.el (gnus-article-reply-with-original): + Correct with-current-buffer scope. * message.el (message-completion-alist): Add Reply-To, From, etc. @@ -8043,7 +8034,7 @@ describtion and menu. (message-change-subject, message-xpost-fup2): Signal error if current header is empty. - (message-xpost-insert-note): Changed insert position. + (message-xpost-insert-note): Change insert position. (message-archive-note): Ensure to insert note in message body (not in head). (message-archive-header, message-archive-note) @@ -8056,7 +8047,7 @@ (message-subject-trailing-was-query) (message-subject-trailing-was-ask-regexp) (message-subject-trailing-was-regexp): New variables. - (message-to-list-only): Added doc-string and menu entry. + (message-to-list-only): Add doc-string and menu entry. * message-utils.el: Removed. Functions are now in message.el. @@ -8177,8 +8168,8 @@ 2002-09-03 Katsumi Yamaoka <yamaoka@jpl.org> - * gnus-util.el (gnus-frame-or-window-display-name): Exclude - invalid display names. + * gnus-util.el (gnus-frame-or-window-display-name): + Exclude invalid display names. 2002-08-30 Reiner Steib <Reiner.Steib@gmx.de> @@ -8220,8 +8211,8 @@ 2002-08-27 Simon Josefsson <jas@extundo.com> - * gnus-msg.el (posting-charset-alist): Use - gnus-define-group-parameter instead of defcustom. + * gnus-msg.el (posting-charset-alist): + Use gnus-define-group-parameter instead of defcustom. (gnus-put-message): Handle SPC in GCC. (gnus-inews-insert-gcc): Ditto. (gnus-inews-insert-archive-gcc): Ditto. @@ -8326,12 +8317,12 @@ 2002-08-11 Reiner Steib <Reiner.Steib@gmx.de> * message-utils.el (message-xpost-default) - (message-xpost-fup2-header, message-xpost-fup2): Fixed Typos. + (message-xpost-fup2-header, message-xpost-fup2): Fix Typos. 2002-08-09 Simon Josefsson <jas@extundo.com> - * message.el (message-canlock-password): Set - canlock-password-for-verify to newly generated canlock-password. + * message.el (message-canlock-password): + Set canlock-password-for-verify to newly generated canlock-password. When Emacs is restarted, Custom makes sure this is set, but during the same session we must set it manually. @@ -8389,7 +8380,7 @@ * nnweb.el (nnweb-type, nnweb-type-definition) (nnweb-gmane-create-mapping, nnweb-gmane-wash-article) - (nnweb-gmane-search, nnweb-gmane-identity): Added gmane + (nnweb-gmane-search, nnweb-gmane-identity): Add gmane functionality. * nnweb.el: Removed old non-functioning search engines. @@ -8401,8 +8392,8 @@ * flow-fill.el (fill-flowed): Disable filladapt-mode. - * gnus-sieve.el (gnus-sieve-guess-rule-for-article): Don't - regexp-quote, Cyrus Sieve is fixed. + * gnus-sieve.el (gnus-sieve-guess-rule-for-article): + Don't regexp-quote, Cyrus Sieve is fixed. * sieve-manage.el (sieve-manage-deletescript): New function. @@ -8420,13 +8411,13 @@ * mm-decode.el (mm-inline-text-html-with-images): Doc fix. (mm-w3m-safe-url-regexp): New user option. - * mm-view.el (mm-inline-text-html-render-with-w3m): Use - `mm-w3m-safe-url-regexp' to bind `w3m-safe-url-regexp'. + * mm-view.el (mm-inline-text-html-render-with-w3m): + Use `mm-w3m-safe-url-regexp' to bind `w3m-safe-url-regexp'. 2002-07-23 Karl Kleinpaste <karl@charcoal.com> - * gnus-sum.el (gnus-summary-delete-article): Force - nnmail-expiry-target to 'delete, so that absolute deletion + * gnus-sum.el (gnus-summary-delete-article): + Force nnmail-expiry-target to 'delete, so that absolute deletion happens when absolute deletion is requested. 2002-07-21 Nevin Kapur <nevin@jhu.edu> @@ -8487,8 +8478,8 @@ 2002-07-06 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-topic.el (gnus-topic-indent, gnus-topic-unindent): Change - cdaar to cdar and car. + * gnus-topic.el (gnus-topic-indent, gnus-topic-unindent): + Change cdaar to cdar and car. * nnsoup.el (nnsoup-retrieve-headers, nnsoup-request-type) (nnsoup-read-active-file, nnsoup-article-to-area): Ditto. @@ -8574,8 +8565,8 @@ 2002-06-17 Simon Josefsson <jas@extundo.com> - * gnus-start.el (gnus-clear-system, gnus-read-newsrc-file): Make - sure to write byte-compiled versions of gnus-*-format-alist to + * gnus-start.el (gnus-clear-system, gnus-read-newsrc-file): + Make sure to write byte-compiled versions of gnus-*-format-alist to .newsrc.eld. 2002-06-16 Bjørn Mork <bmork@dod.no> @@ -8594,7 +8585,7 @@ * nnheader.el (nnheader-file-name-translation-alist): Set the default value for MS Windows systems. - * gnus-ems.el (nnheader-file-name-translation-alist): Removed. + * gnus-ems.el (nnheader-file-name-translation-alist): Remove. 2002-06-14 Katsumi Yamaoka <yamaoka@jpl.org> @@ -8660,8 +8651,8 @@ * gnus-msg.el (gnus-group-mail, gnus-group-news) (gnus-group-post-news, gnus-summary-mail-other-window) - (gnus-summary-news-other-window, gnus-summary-post-news): Bind - gnus-article-copy to nil, thereby inhibiting the `header' posting + (gnus-summary-news-other-window, gnus-summary-post-news): + Bind gnus-article-copy to nil, thereby inhibiting the `header' posting style match to use data from last viewed article. Suggested by Hrvoje Niksic. @@ -8753,8 +8744,8 @@ 2002-05-20 Jason Baker <jbaker@cs.utah.edu> (tiny change) - * gnus-art.el (gnus-request-article-this-buffer): Try - reconnecting if you don't get the message. + * gnus-art.el (gnus-request-article-this-buffer): + Try reconnecting if you don't get the message. 2002-05-20 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -8840,7 +8831,7 @@ 2002-05-06 Josh Huber <huber@alum.wpi.edu> - * mml2015.el (mml2015-gpg-encrypt): Changed name of optional + * mml2015.el (mml2015-gpg-encrypt): Change name of optional argument, and fixed compiler warning. (Added autoload for gpg-encrypt). @@ -8864,10 +8855,10 @@ * mml-sec.el (mml-signencrypt-style): New. * mml-sec.el (mml-pgpmime-encrypt-buffer): Accept optional argument `sign'. - * mml-sec.el (mml-secure-message-encrypt-pgp): Changed default to + * mml-sec.el (mml-secure-message-encrypt-pgp): Change default to signencrypt. * mml-sec.el (mml-secure-message-encrypt-pgpmime): Ditto. - * mml.el (mml-generate-mime-1): Changed logic so a part which is + * mml.el (mml-generate-mime-1): Change logic so a part which is both signed & encryped is processed in one operation (rather than two separate ops: sign, then encrypt). * mml2015.el (mml2015-gpg-extract-signature-details): Give some @@ -8903,8 +8894,8 @@ 2002-05-01 Simon Josefsson <jas@extundo.com> - * imap.el (imap-parse-resp-text-code, imap-parse-status): Treat - UIDNEXT as a string. + * imap.el (imap-parse-resp-text-code, imap-parse-status): + Treat UIDNEXT as a string. * nnimap.el (nnimap-string-lessp-numerical): New function. (nnimap-retrieve-groups): Compare UIDNEXT as strings instead of @@ -8927,8 +8918,8 @@ (nnimap-mailbox-info): New internal variable. (nnimap-retrieve-groups): Implement faster new mail check. - * nnimap.el (nnimap-split-articles): Support - nnmail-cache-accepted-message-ids. + * nnimap.el (nnimap-split-articles): + Support nnmail-cache-accepted-message-ids. (nnimap-request-accept-article): Ditto. * imap.el (imap-mailbox-status-asynch): New command. @@ -9013,8 +9004,8 @@ 2002-04-23 Matthieu Moy <Matthieu.Moy@imag.fr> - * gnus-msg.el (gnus-summary-resend-message-edit): Remove - message-ignored-resent-headers, too. + * gnus-msg.el (gnus-summary-resend-message-edit): + Remove message-ignored-resent-headers, too. 2002-04-22 Björn Torkelsson <torkel@acc.umu.se> @@ -9048,7 +9039,7 @@ (message-mode): Add description for `message-to-list-only'. (message-to-list-only): New. - (message-make-mft): Changed to use the cl loop macro, and added + (message-make-mft): Change to use the cl loop macro, and added optional flag to return only the matched list (for use in new message-to-list-only function). @@ -9082,11 +9073,11 @@ 2002-04-13 Josh Huber <huber@alum.wpi.edu> - * mml-sec.el (mml-secure-message): Changed to support arbritrary + * mml-sec.el (mml-secure-message): Change to support arbritrary modes. * mml-sec.el (mml-secure-message-encrypt-(smime|pgp|pgpmime)): changed to support "signencrypt" mode. - * mml.el (mml-parse-1): Changed to support different secure modes + * mml.el (mml-parse-1): Change to support different secure modes more easily (for signencrypt). 2002-04-11 Stefan Monnier <monnier@cs.yale.edu> @@ -9107,13 +9098,13 @@ 2002-04-12 Daiki Ueno <ueno@unixuser.org> - * gnus-srvr.el (gnus-server-set-info): Clear - `gnus-server-method-cache' when `gnus-server-alist' is changed. + * gnus-srvr.el (gnus-server-set-info): + Clear `gnus-server-method-cache' when `gnus-server-alist' is changed. 2002-04-11 Simon Josefsson <jas@extundo.com> - * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Force - viewing of security buttons. Thanks to Nicolas Kowalski + * gnus-sum.el (gnus-summary-force-verify-and-decrypt): + Force viewing of security buttons. Thanks to Nicolas Kowalski <Nicolas.Kowalski@imag.fr>. * smime.el (smime-CA-directory): Fix doc. Thanks to Arne @@ -9142,7 +9133,7 @@ 2002-04-07 Josh Huber <huber@alum.wpi.edu> - * message.el (message-make-mft): Changed MFT code from using + * message.el (message-make-mft): Change MFT code from using message-recipients (which included Bcc) to use only the To and CC headers. @@ -9202,8 +9193,8 @@ * nnmaildir.el: Use defstruct. Use a single copy of nnmail-extra-headers to save memory. Store server's group name prefix instead of each group's prefixed name. - * nnnil.el (nnnil-retrieve-headers, nnnil-request-list): Erase - nntp-server-buffer. + * nnnil.el (nnnil-retrieve-headers, nnnil-request-list): + Erase nntp-server-buffer. 2002-03-31 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -9272,7 +9263,7 @@ 2002-03-22 Josh Huber <huber@alum.wpi.edu> - * mml.el (mml-mode-map): Added a keybinding for + * mml.el (mml-mode-map): Add a keybinding for `mml-unsecure-message'. Also, added a menu entry for said function in the Attachments menu. @@ -9340,8 +9331,8 @@ 2002-03-12 Faried Nawaz <fn@hungry.org> (tiny change) - * message.el (message-qmail-inject-args): May be function. Adjust - doc string and custom type. + * message.el (message-qmail-inject-args): May be function. + Adjust doc string and custom type. (message-send-mail-with-qmail): Call function if m-q-i-a is a function. @@ -9367,8 +9358,8 @@ 2002-03-09 Andre Srinivasan <andre@slamdunknetworks.com> (tiny change) - * gnus-sum.el (gnus-summary-save-parts-default-mime): Remove - duplication. + * gnus-sum.el (gnus-summary-save-parts-default-mime): + Remove duplication. (gnus-summary-save-parts-type-history): Ditto. (gnus-summary-save-parts-last-directory): Ditto. @@ -9408,8 +9399,8 @@ * qp.el (quoted-printable-decode-region): Doc addition. From: Eli Zaretskii <eliz@is.elta.co.il> - * mail-source.el (make-source-make-complex-temp-name): Use - make-temp-file. + * mail-source.el (make-source-make-complex-temp-name): + Use make-temp-file. * mm-util.el (mm-make-temp-file): New function. * nneething.el (nneething-file-name): Use it. @@ -9424,8 +9415,8 @@ 2002-03-04 Paul Jarc <prj@po.cwru.edu> - * message.el (nnmaildir-article-number-to-base-name): New - function. + * message.el (nnmaildir-article-number-to-base-name): + New function. (nnmaildir-base-name-to-article-number): New function. 2002-03-04 Katsumi Yamaoka <yamaoka@jpl.org> @@ -9477,7 +9468,7 @@ * gnus-util.el (gnus-multiple-choice): New function. - * gnus-kill.el (gnus-score-insert-help): Removed, because it is + * gnus-kill.el (gnus-score-insert-help): Remove, because it is also defined in gnus-score.el. 2002-03-01 Paul Jarc <prj@po.cwru.edu> @@ -9544,8 +9535,8 @@ 2002-02-22 Andre Srinivasan <andre@slamdunknetworks.com> (tiny change) - * mm-decode.el (mm-display-external): Use - mm-file-name-rewrite-functions. + * mm-decode.el (mm-display-external): + Use mm-file-name-rewrite-functions. 2002-02-22 Paul Jarc <prj@po.cwru.edu> @@ -9559,13 +9550,13 @@ 2002-02-21 Paul Jarc <prj@po.cwru.edu> - * nnmaildir.el (nnmaildir-request-expire-articles): Use - nnmail-expiry-wait* if expire-age parameter is not set. + * nnmaildir.el (nnmaildir-request-expire-articles): + Use nnmail-expiry-wait* if expire-age parameter is not set. 2002-02-21 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-group.el (gnus-group-sort-groups-by-real-name): New - function. + * gnus-group.el (gnus-group-sort-groups-by-real-name): + New function. (gnus-group-sort-selected-groups-by-real-name): New function. (gnus-group-make-menu-bar): Add sort by real name. @@ -9615,8 +9606,8 @@ * rfc2231.el (rfc2231-parse-string): Support non-ascii chars. - * gnus-art.el (gnus-article-wash-html-with-w3): Remove - w3-delay-image-loads. + * gnus-art.el (gnus-article-wash-html-with-w3): + Remove w3-delay-image-loads. * mm-view.el (mm-inline-text-html-render-with-w3): Ditto. (mm-w3-prepare-buffer): Ditto. @@ -9686,7 +9677,7 @@ 2002-02-18 Katsumi Yamaoka <yamaoka@jpl.org> - * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Improved to speed + * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Improve to speed up. Suggested by Yuuichi Teranishi <teranisi@gohome.org>. * gnus-art.el (article-display-x-face): Sort gray X-Faces. @@ -9784,8 +9775,8 @@ * gnus-agent.el (gnus-get-predicate): Use nconc. - * gnus-sum.el (gnus-summary-display-make-predicate): Use - gnus-summary-display-cache as cache. + * gnus-sum.el (gnus-summary-display-make-predicate): + Use gnus-summary-display-cache as cache. * nndoc.el (nndoc-type-alist): Add mail-in-mail type. (nndoc-mail-in-mail-type-p): New function. @@ -9795,8 +9786,8 @@ * mailcap.el (mailcap-mime-data): Use enriched-decode. - * gnus-cite.el (gnus-article-fill-cited-article): Bind - use-hard-newlines to nil. + * gnus-cite.el (gnus-article-fill-cited-article): + Bind use-hard-newlines to nil. * gnus-xmas.el (gnus-xmas-image-type-available-p): Assume that image is not available if window-system is not available. @@ -9813,8 +9804,8 @@ * gnus-soup.el (gnus-soup-send-packet): Send news and mail directly instead of calling message-send-mail. - * gnus-start.el (gnus-read-descriptions-file): Use - gnus-default-charset. + * gnus-start.el (gnus-read-descriptions-file): + Use gnus-default-charset. * mm-util.el (mm-guess-mime-charset): New function. @@ -9857,16 +9848,16 @@ 2002-02-07 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-art.el (gnus-article-treat-body-boundary): Add - gnus-decoration property. + * gnus-art.el (gnus-article-treat-body-boundary): + Add gnus-decoration property. * gnus-msg.el (gnus-copy-article-buffer): Remove gnus-decoration. * gnus-art.el (gnus-article-treat-unfold-headers): Don't remove too many spaces. * rfc2047.el (rfc2047-unfold-region): Ditto. - (rfc2047-decode-region): Don't unfold. Let - gnus-article-treat-unfold-headers do it. + (rfc2047-decode-region): Don't unfold. + Let gnus-article-treat-unfold-headers do it. 2002-02-07 Matt Armstrong <matt@lickey.com> @@ -9946,8 +9937,8 @@ force, prevent errors when following up from article buffer. (gnus-article-reply-with-original): Ditto. - * binhex.el (binhex-decoder-switches): Fix doc. From - Pavel@Janik.cz (Pavel Janík). + * binhex.el (binhex-decoder-switches): Fix doc. + From Pavel@Janik.cz (Pavel Janík). 2002-02-04 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -9984,11 +9975,11 @@ * gnus-cache.el (gnus-summary-insert-cached-articles): (gnus-summary-limit-include-cached): gnus-newsgroup-cached is sorted. - * gnus-group.el (gnus-group-mark-article-read): Nreverse - gnus-newsgroups-unselected. + * gnus-group.el (gnus-group-mark-article-read): + Nreverse gnus-newsgroups-unselected. - * gnus-agent.el (gnus-summary-set-agent-mark): Use - gnus-add-to-sorted-list. + * gnus-agent.el (gnus-summary-set-agent-mark): + Use gnus-add-to-sorted-list. * gnus-sum.el (gnus-summary-update-info): gnus-newsgroup-unreads gnus-newsgroup-unselected are sorted. Use gnus-sorted-union. @@ -10003,8 +9994,8 @@ directories. (gnus-dired-print): New function. - * gnus-art.el (gnus-mime-print-part): Add argument filename. Call - ps-despool. + * gnus-art.el (gnus-mime-print-part): Add argument filename. + Call ps-despool. 2002-02-02 Simon Josefsson <jas@extundo.com> @@ -10048,11 +10039,11 @@ 2002-01-31 ShengHuo ZHU <zsh@cs.rochester.edu> - * nnfolder.el (nnfolder-request-replace-article): Unfold. Don't - use mail-header-unfold-field. + * nnfolder.el (nnfolder-request-replace-article): Unfold. + Don't use mail-header-unfold-field. - * gnus-cache.el (gnus-summary-insert-cached-articles): Use - gnus-summary-limit. + * gnus-cache.el (gnus-summary-insert-cached-articles): + Use gnus-summary-limit. * gnus-range.el (gnus-add-to-sorted-list): New function. * gnus-sum.el (gnus-mark-article-as-read): Use it. @@ -10068,8 +10059,8 @@ * gnus-msg.el (gnus-posting-styles): Add new format of header. (gnus-configure-posting-styles): Support the new format. - * mail-source.el (mail-source-bind, mail-source-bind-common): Set - edebug-form-spec to (sexp body). + * mail-source.el (mail-source-bind, mail-source-bind-common): + Set edebug-form-spec to (sexp body). Suggested by Joe Wells <jbw@izanami.cee.hw.ac.uk>. * message.el (message-reply-headers): Add doc. @@ -10095,19 +10086,19 @@ * nnagent.el (nnagent-retrieve-headers): Use gnus-sorted-difference. - * gnus-agent.el (gnus-agent-retrieve-headers): Use - gnus-sorted-difference. + * gnus-agent.el (gnus-agent-retrieve-headers): + Use gnus-sorted-difference. - * nnsoup.el (nnsoup-request-expire-articles): Use - gnus-sorted-difference. + * nnsoup.el (nnsoup-request-expire-articles): + Use gnus-sorted-difference. * nnheader.el: Autoload gnus-sorted-difference. - * nnfolder.el (nnfolder-request-expire-articles): Use - gnus-sorted-difference. + * nnfolder.el (nnfolder-request-expire-articles): + Use gnus-sorted-difference. - * gnus-cache.el (gnus-cache-retrieve-headers): Use - gnus-sorted-difference. + * gnus-cache.el (gnus-cache-retrieve-headers): + Use gnus-sorted-difference. * gnus-range.el: Autoload cookies. (gnus-sorted-difference): New function. @@ -10122,8 +10113,8 @@ * gnus-sum.el (gnus-select-newsgroup): Use gnus-sorted-difference, gnus-sorted-ndifference, and gnus-sorted-nintersection. (gnus-articles-to-read): Use gnus-sorted-difference. - (gnus-summary-limit-mark-excluded-as-read): Use - gnus-sorted-intersection and gnus-sorted-ndifference. + (gnus-summary-limit-mark-excluded-as-read): + Use gnus-sorted-intersection and gnus-sorted-ndifference. (gnus-list-of-read-articles): Use gnus-list-range-difference. (gnus-summary-insert-articles): Use gnus-sorted-difference. @@ -10139,7 +10130,7 @@ * mm-view.el (mm-w3m-mode-map): New variable. (mm-w3m-mode-command-alist): New variable. - (mm-w3m-minor-mode): Removed. + (mm-w3m-minor-mode): Remove. (mm-setup-w3m): Setup `mm-w3m-mode-map'; don't add minor mode. (mm-inline-text-html-render-with-w3m): Add keymap property to the buffer for using emacs-w3m command keys. @@ -10150,11 +10141,11 @@ (message-cite-prefix-regexp): Auto detect non word constituents. (message-cite-prefix-regexp): Don't use with-syntax-table. - * gnus-sum.el (gnus-summary-update-info): Use - gnus-list-range-intersection. + * gnus-sum.el (gnus-summary-update-info): + Use gnus-list-range-intersection. - * gnus-agent.el (gnus-agent-fetch-headers): Use - gnus-list-range-intersection. + * gnus-agent.el (gnus-agent-fetch-headers): + Use gnus-list-range-intersection. * gnus-range.el (gnus-range-normalize): Use correct predicate. (gnus-list-range-intersection): Use it. @@ -10189,8 +10180,8 @@ Don't split when the window is small, e.g. when a small *BBDB* window is the lowest one. - * gnus-agent.el (gnus-agent-retrieve-headers): Use - nnheader-find-nov-line to speed up. Use nreverse, because it is + * gnus-agent.el (gnus-agent-retrieve-headers): + Use nnheader-find-nov-line to speed up. Use nreverse, because it is sorted. Use nnheader-insert-nov-file. 2002-01-28 Katsumi Yamaoka <yamaoka@jpl.org> @@ -10208,7 +10199,7 @@ * time-date.el: Add autoload cookies. Many doc fixes. (time-add): New function. - (time-subtract): Renamed from subtract-time. + (time-subtract): Rename from subtract-time. (subtract-time): New alias for time-subtract. 2002-01-28 Katsumi Yamaoka <yamaoka@jpl.org> @@ -10254,7 +10245,7 @@ 2002-01-26 Lars Magne Ingebrigtsen <larsi@gnus.org> * nnml.el (nnml-use-compressed-files): New variable. - (nnml-filenames-are-evil): Removed. + (nnml-filenames-are-evil): Remove. (nnml-current-group-article-to-file-alist): Don't use. (nnml-update-file-alist): Inhibit. (nnml-article-to-file): Use new var. @@ -10319,7 +10310,7 @@ 2002-01-25 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-agent.el (gnus-agent-save-alist): Optimized. + * gnus-agent.el (gnus-agent-save-alist): Optimize. 2002-01-25 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -10330,15 +10321,15 @@ (gnus-server-method-cache): New variable. (gnus-server-to-method): Use it. (gnus-group-method-cache): New variable. - (gnus-find-method-for-group-1): Renamed. + (gnus-find-method-for-group-1): Rename. (gnus-find-method-for-group): New function. - (gnus-group-method-cache): Removed. + (gnus-group-method-cache): Remove. * gnus-sum.el (gnus-compute-unseen-list): Use new optimized function. * gnus-range.el (gnus-members-of-range): New function. - (gnus-list-range-intersection): Renamed. + (gnus-list-range-intersection): Rename. (gnus-inverse-list-range-intersection): New function. * gnus-sum.el (gnus-compute-unseen-list): Made into own function. @@ -10350,8 +10341,8 @@ 2002-01-25 Katsumi Yamaoka <yamaoka@jpl.org> - * mm-view.el (mm-inline-text-html-render-with-w3m): Decode - charset-encoded html contents. + * mm-view.el (mm-inline-text-html-render-with-w3m): + Decode charset-encoded html contents. 2002-01-24 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -10401,12 +10392,12 @@ 2002-01-22 Josh Huber <huber@alum.wpi.edu> - * mml.el (mml-parse-1): Fixed usage of recipients in the secure + * mml.el (mml-parse-1): Fix usage of recipients in the secure tag. 2002-01-22 Josh Huber <huber@alum.wpi.edu> - * message.el (message-font-lock-keywords): Added the secure tag. + * message.el (message-font-lock-keywords): Add the secure tag. * mml-sec.el: Added functions to generate/modify/remove the secure tag while in message mode. * mml-sec.el (mml-secure-message): New. @@ -10417,12 +10408,12 @@ * mml-sec.el (mml-secure-message-encrypt-smime): New. * mml-sec.el (mml-secure-message-encrypt-pgp): New. * mml-sec.el (mml-secure-message-encrypt-pgpmime): New. - * mml.el (mml-parse-1): Added code to recognize the secure tag and + * mml.el (mml-parse-1): Add code to recognize the secure tag and convert it to either a part or multipart depending on if there are other parts in the message. - * mml.el (mml-mode-map): Changed default sign/encrypt keybindings + * mml.el (mml-mode-map): Change default sign/encrypt keybindings to use the secure tag, rather than the part tag. - * mml.el (mml-preview): Added a save-excursion to keep cursor + * mml.el (mml-preview): Add a save-excursion to keep cursor position after doing an MML preview. 2002-01-22 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -10462,8 +10453,8 @@ 2002-01-20 Lars Magne Ingebrigtsen <larsi@gnus.org> - * nnfolder.el (nnfolder-request-accept-article): Unfold - x-from-line. + * nnfolder.el (nnfolder-request-accept-article): + Unfold x-from-line. (nnfolder-request-replace-article): Ditto. 2002-01-20 Nevin Kapur <nevin@jhu.edu> @@ -10487,8 +10478,8 @@ * message.el (message-dont-send): Doc fix. - * gnus-util.el (gnus-completing-read): Remove - inherit-input-method. + * gnus-util.el (gnus-completing-read): + Remove inherit-input-method. * gnus-art.el (gnus-treat-smiley): Doc fix. @@ -10541,8 +10532,8 @@ 2002-01-19 Daniel Pittman <daniel@rimspace.net> - * gnus-sum.el (gnus-summary-first-unseen-or-unread-subject): New - functions. + * gnus-sum.el (gnus-summary-first-unseen-or-unread-subject): + New functions. 2002-01-19 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -10551,7 +10542,7 @@ * gnus-sum.el (gnus-summary-goto-subject): Error on non-numerical articles. - * gnus-util.el (gnus-completing-read-with-default): Renamed. + * gnus-util.el (gnus-completing-read-with-default): Rename. * nnmail.el (nnmail-article-group): Clean up. @@ -10571,17 +10562,17 @@ * smiley-ems.el (smiley-region): Register smiley. (smiley-toggle-buffer): Rewrite the function. - (smiley-active): Removed. + (smiley-active): Remove. 2002-01-19 Simon Josefsson <jas@extundo.com> - * gnus-util.el (gnus-parent-id): Optimize null n case. From - Jesper Harder <harder@ifa.au.dk>. + * gnus-util.el (gnus-parent-id): Optimize null n case. + From Jesper Harder <harder@ifa.au.dk>. 2002-01-18 TSUCHIYA Masatoshi <tsuchiya@namazu.org> - * gnus-art.el (gnus-request-article-this-buffer): Call - `nneething-get-file-name' to extract the file name from the + * gnus-art.el (gnus-request-article-this-buffer): + Call `nneething-get-file-name' to extract the file name from the message id. * nneething.el (nneething-encode-file-name): New function. @@ -10649,21 +10640,21 @@ 2002-01-17 ShengHuo ZHU <zsh@cs.rochester.edu> * gnus-agent.el (gnus-agent-retrieve-headers): Use correct buffer. - (gnus-agent-braid-nov): Switch back to nntp-server-buffer. Remove - duplications. + (gnus-agent-braid-nov): Switch back to nntp-server-buffer. + Remove duplications. (gnus-agent-batch): Bind gnus-agent-confirmation-function. 2002-01-16 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-sum.el (gnus-summary-initial-limit): Inline - gnus-summary-limit-children. + * gnus-sum.el (gnus-summary-initial-limit): + Inline gnus-summary-limit-children. (gnus-summary-initial-limit): Don't limit if gnus-newsgroup-display is nil. (gnus-summary-initial-limit): No, don't. * gnus-util.el - (gnus-put-text-property-excluding-characters-with-faces): Inline - gnus-put-text-property. + (gnus-put-text-property-excluding-characters-with-faces): + Inline gnus-put-text-property. * gnus-spec.el (gnus-default-format-specs): New variable. @@ -10680,8 +10671,8 @@ * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Inline some functions. - (gnus-gather-threads-by-references): Inline - `gnus-split-references'. + (gnus-gather-threads-by-references): + Inline `gnus-split-references'. * gnus-spec.el (gnus-summary-line-format-spec): New, optimized default value of gnus-summary-line-format-spec. @@ -10691,7 +10682,7 @@ * nnslashdot.el (nnslashdot-retrieve-headers-1): A better error message. (nnslashdot-request-list): Ditto. - (nnslashdot-sid-strip): Removed. + (nnslashdot-sid-strip): Remove. 2002-01-15 Simon Josefsson <jas@extundo.com> @@ -10705,14 +10696,14 @@ 2002-01-15 TSUCHIYA Masatoshi <tsuchiya@namazu.org> - * nneething.el (nneething-request-article): Set - `nnmail-file-coding-system' to `binary' locally, in order to read + * nneething.el (nneething-request-article): + Set `nnmail-file-coding-system' to `binary' locally, in order to read files without any conversion. 2002-01-15 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-agent.el (gnus-agent-retrieve-headers): Use - nnheader-file-coding-system and nnmail-active-file-coding-system. + * gnus-agent.el (gnus-agent-retrieve-headers): + Use nnheader-file-coding-system and nnmail-active-file-coding-system. (gnus-agent-regenerate-group): Ditto. (gnus-agent-regenerate): Ditto. (gnus-agent-write-active): Ditto. @@ -10747,19 +10738,19 @@ * imap.el (imap-close): Keep going if quit. - * gnus-agent.el (gnus-agent-retrieve-headers): Erase - nntp-server-buffer. + * gnus-agent.el (gnus-agent-retrieve-headers): + Erase nntp-server-buffer. 2002-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org> * mm-view.el (mm-display-inline-fontify): Require font-lock to avoid unbinding shadowed variables. - * gnus-art.el (gnus-picon-databases): Moved here. - (gnus-picons-installed-p): Moved here. + * gnus-art.el (gnus-picon-databases): Move here. + (gnus-picons-installed-p): Move here. (gnus-article-reply-with-original): Use `mark'. - * gnus.el (gnus-picon): Moved here and renamed. + * gnus.el (gnus-picon): Move here and renamed. * gnus-art.el (gnus-treat-from-picon): Only be on if picons are installed. @@ -10782,8 +10773,8 @@ 2002-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-art.el (gnus-article-reply-with-original): Use - `mark-active'. + * gnus-art.el (gnus-article-reply-with-original): + Use `mark-active'. * gnus-msg.el (gnus-summary-reply): Don't bug out on regions. @@ -10794,16 +10785,16 @@ 2002-01-12 Simon Josefsson <jas@extundo.com> * flow-fill.el (fill-flowed-display-column) - (fill-flowed-encode-columnq): New variables. Suggested by - Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Großjohann). + (fill-flowed-encode-columnq): New variables. + Suggested by Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Großjohann). (fill-flowed-encode, fill-flowed): Use them. - * message.el (message-send-news, message-send-mail): Use - m-b-s-n-p-e-h-n. + * message.el (message-send-news, message-send-mail): + Use m-b-s-n-p-e-h-n. * mml.el (autoload): Autoload fill-flowed-encode. - (mml-buffer-substring-no-properties-except-hard-newlines): New - function. + (mml-buffer-substring-no-properties-except-hard-newlines): + New function. (mml-read-part): Use it. (mml-generate-mime-1): Encode format=flowed if appropriate. (mml-insert-mime-headers): Insert format=flowed. @@ -10843,8 +10834,8 @@ gnus-article-prepare-hook. * gnus-agent.el (gnus-agent-retrieve-headers): Load agentview. - (gnus-agent-toggle-plugged): Use gnus-agent-go-online. Move - gnus-agent-possibly-synchronize-flags to the last. + (gnus-agent-toggle-plugged): Use gnus-agent-go-online. + Move gnus-agent-possibly-synchronize-flags to the last. (gnus-agent-go-online): New function. New variable. 2002-01-11 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -10904,8 +10895,8 @@ 2002-01-10 ShengHuo ZHU <zsh@cs.rochester.edu> - * nnkiboze.el (nnkiboze-request-article): Use - gnus-agent-request-article. + * nnkiboze.el (nnkiboze-request-article): + Use gnus-agent-request-article. * nnagent.el (nnagent-retrieve-headers): Don't use nnml function. Insert undownloaded NOV. @@ -10915,13 +10906,13 @@ * gnus.el (gnus-agent-cache): New variable. - * gnus-int.el (gnus-retrieve-headers): Use - gnus-agent-retrieve-headers. + * gnus-int.el (gnus-retrieve-headers): + Use gnus-agent-retrieve-headers. (gnus-request-head): Use gnus-agent-request-article. (gnus-request-body): Ditto. - * gnus-art.el (gnus-request-article-this-buffer): Use - gnus-agent-request-article. + * gnus-art.el (gnus-request-article-this-buffer): + Use gnus-agent-request-article. * gnus-sum.el (gnus-summary-read-group-1): Don't show the first article if it is undownloaded. @@ -10942,8 +10933,8 @@ 2002-01-08 ShengHuo ZHU <zsh@cs.rochester.edu> - * mm-encode.el (mm-content-transfer-encoding-defaults): Add - application/x-emacs-lisp. + * mm-encode.el (mm-content-transfer-encoding-defaults): + Add application/x-emacs-lisp. * gnus-msg.el (gnus-bug): Use application/emacs-lisp. @@ -10986,8 +10977,8 @@ 2002-01-07 TSUCHIYA Masatoshi <tsuchiya@namazu.org> * nneething.el (nneething-request-article): When a non-text file - is converted to an article, its data is encoded in base64. Call - `nneething-make-head' with options to specify MIME types. + is converted to an article, its data is encoded in base64. + Call `nneething-make-head' with options to specify MIME types. (nneething-make-head): Add optional arguments to specify MIME types. @@ -11007,13 +10998,13 @@ 2002-01-06 Simon Josefsson <jas@extundo.com> - * imap.el (imap-ssl-open, imap-ssl-open, imap-parse-fetch): Use - condition-case, not ignore-errors. + * imap.el (imap-ssl-open, imap-ssl-open, imap-parse-fetch): + Use condition-case, not ignore-errors. 2002-01-06 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-sum.el (gnus-summary-insert-old-articles): Bind - gnus-fetch-old-headers. + * gnus-sum.el (gnus-summary-insert-old-articles): + Bind gnus-fetch-old-headers. * gnus-art.el (article-display-x-face): Use the current buffer unless `W f'. Otherwise, X-Face may be shown in the header of a @@ -11023,8 +11014,8 @@ 2002-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-group.el (gnus-group-read-ephemeral-group): Fix - parameters. + * gnus-group.el (gnus-group-read-ephemeral-group): + Fix parameters. 2002-01-06 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -11034,8 +11025,8 @@ (mm-detect-coding-region): New function. (mm-detect-mime-charset-region): New function. - * gnus-sum.el (gnus-summary-show-article): Use - mm-detect-coding-region. + * gnus-sum.el (gnus-summary-show-article): + Use mm-detect-coding-region. 2002-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -11071,7 +11062,7 @@ 2002-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus.el (gnus-logo-color-alist): Added more colors from Luis. + * gnus.el (gnus-logo-color-alist): Add more colors from Luis. 2002-01-05 Keiichi Suzuki <keiichi@nanap.org> (tiny change) @@ -11096,7 +11087,7 @@ 2002-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus-sum.el (gnus-thread-latest-date): New function. - (gnus-thread-sort-by-most-recent-number): Renamed. + (gnus-thread-sort-by-most-recent-number): Rename. (gnus-thread-sort-functions): Doc fix. (gnus-select-group-hook): Don't use setq on a hook. (gnus-thread-latest-date): Use date, not number. @@ -11104,14 +11095,14 @@ * gnus-agent.el (gnus-agent-expire-days): Doc fix. (gnus-agent-expire): Allow regexp of expire-days. - * gnus-art.el (gnus-article-reply-with-original): Deactivate - region. + * gnus-art.el (gnus-article-reply-with-original): + Deactivate region. (gnus-article-followup-with-original): Ditto. * gnus-sum.el (gnus-thread-highest-number): Doc fix. - * gnus-art.el (gnus-mime-display-alternative): Use - gnus-local-map-property. + * gnus-art.el (gnus-mime-display-alternative): + Use gnus-local-map-property. (gnus-mime-display-alternative): Ditto. (gnus-insert-mime-security-button): Ditto. (gnus-insert-next-page-button): Ditto. @@ -11130,7 +11121,7 @@ "X-Face: " to the data in the built-in scenario. * gnus-spec.el (gnus-parse-simple-format): Use gnus-pad-form. - (gnus-correct-pad-form): Renamed. + (gnus-correct-pad-form): Rename. (gnus-tilde-max-form): Clean up. (gnus-pad-form): Use gnus-use-correct-string-widths. @@ -11161,30 +11152,30 @@ * gnus-fun.el (gnus-display-x-face-in-from): Use face. - * gnus-ems.el (gnus-article-xface-ring-internal): Removed. - (gnus-article-xface-ring-size): Removed. - (gnus-article-display-xface): Removed. + * gnus-ems.el (gnus-article-xface-ring-internal): Remove. + (gnus-article-xface-ring-size): Remove. + (gnus-article-display-xface): Remove. (gnus-remove-image): Cleaned up. * gnus-xmas.el (gnus-xmas-create-image): Convert pbm to xbm. (gnus-xmas-create-image): Take pbm files. - (gnus-x-face): Removed. - (gnus-xmas-article-display-xface): Removed. + (gnus-x-face): Remove. + (gnus-xmas-article-display-xface): Remove. - * gnus-fun.el (gnus-display-x-face-in-from): Bind - default-enable-multibyte-characters. + * gnus-fun.el (gnus-display-x-face-in-from): + Bind default-enable-multibyte-characters. * compface.el (uncompface): Doc fix. - * gnus-art.el (gnus-article-x-face-command): Use - gnus-display-x-face-in-from. + * gnus-art.el (gnus-article-x-face-command): + Use gnus-display-x-face-in-from. * gnus-xmas.el (gnus-xmas-put-image): Return the image. * gnus-ems.el (gnus-put-image): Return the image. * gnus-fun.el (gnus-display-x-face-in-from): New function. - (gnus-x-face): Moved here. + (gnus-x-face): Move here. 2002-01-04 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -11218,9 +11209,9 @@ * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Use uncompface. - * compface.el (compface-xbm-p): Removed. + * compface.el (compface-xbm-p): Remove. - * gnus-ems.el (gnus-article-compface-xbm): Removed. + * gnus-ems.el (gnus-article-compface-xbm): Remove. (gnus-article-display-xface): Use compface. * compface.el: New file. @@ -11232,8 +11223,8 @@ 2002-01-03 Paul Jarc <prj@po.cwru.edu> - * nnmaildir.el (nnmaildir-request-expire-articles): Evaluate - the expire-group parameter once per article rather than once + * nnmaildir.el (nnmaildir-request-expire-articles): + Evaluate the expire-group parameter once per article rather than once per group; bind `nnmaildir-article-file-name' and `article' for convenience. Leave article alone when expire-group specifies the current group. @@ -11246,7 +11237,7 @@ 2002-01-03 Dave Love <d.love@dl.ac.uk> - * gnus-start.el (gnus-startup-file-coding-system): Removed. + * gnus-start.el (gnus-startup-file-coding-system): Remove. (gnus-read-init-file): Don't use it. 2002-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -11268,7 +11259,7 @@ 2002-01-03 Per Abrahamsen <abraham@dina.kvl.dk> - * gnus.el (gnus-summary-line-format): Added :link. + * gnus.el (gnus-summary-line-format): Add :link. * gnus-topic.el (gnus-topic-line-format): Ditto. * gnus-sum.el (gnus-summary-dummy-line-format): Ditto. * gnus-srvr.el (gnus-server-line-format): Ditto. @@ -11336,7 +11327,7 @@ 2002-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Renamed. + * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Rename. * gnus-art.el (gnus-ignored-headers): Hide all X-Faces. (article-display-x-face): Display gray X-Faces. @@ -11389,10 +11380,10 @@ * gnus-fun.el: New file. (gnus-convert-image-to-x-face-command): New variable. (gnus-insert-x-face): New function. - (gnus-random-x-face): Renamed. - (gnus-x-face-from-file): Renamed. + (gnus-random-x-face): Rename. + (gnus-x-face-from-file): Rename. - * gnus-art.el (gnus-body-boundary-delimiter): Changed default to + * gnus-art.el (gnus-body-boundary-delimiter): Change default to "_". (gnus-body-boundary-delimiter): Typo fix. @@ -11442,7 +11433,7 @@ * gnus-picon.el (gnus-picon-find-face): Search MISC for all types. (gnus-picon-transform-address): Search for unknown faces as well. (gnus-picon-find-face): Don't search "news" for MISC. - (gnus-picon-user-directories): Changed default back to exclude + (gnus-picon-user-directories): Change default back to exclude "unknown". * gnus-sum.el (gnus-summary-hide-all-threads): Reversed logic. @@ -11455,13 +11446,13 @@ keystroke. (gnus-topic-goto-next-topic): Ditto. - * gnus.el (gnus-summary-line-format): Changed default. + * gnus.el (gnus-summary-line-format): Change default. * nnmail.el (nnmail-extra-headers): Change default. * gnus-sum.el (gnus-extra-headers): Change default. - * message.el (message-news-other-window): Changed "news" to + * message.el (message-news-other-window): Change "news" to "posting". (message-news-other-frame): Ditto. (message-do-send-housekeeping): Ditto. @@ -11499,8 +11490,8 @@ 2002-01-01 Steve Youngs <youngs@xemacs.org> - * gnus-xmas.el (gnus-xmas-article-display-xface): Uncomment - 'set-glyph-face' so x-face back/foreground can be set. + * gnus-xmas.el (gnus-xmas-article-display-xface): + Uncomment 'set-glyph-face' so x-face back/foreground can be set. 2001-12-31 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -11508,16 +11499,16 @@ 2002-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-art.el (gnus-treat-smiley): Renamed command. + * gnus-art.el (gnus-treat-smiley): Rename command. (gnus-article-remove-images): New command and keystroke. - * gnus-sum.el (gnus-summary-toggle-smiley): Removed. + * gnus-sum.el (gnus-summary-toggle-smiley): Remove. - * smiley-ems.el (gnus-smiley-display): Removed. + * smiley-ems.el (gnus-smiley-display): Remove. * gnus.el (gnus-version-number): Update version. - * message.el (message-text-with-property): Renamed and moved + * message.el (message-text-with-property): Rename and moved here. (message-fix-before-sending): Highlight invisible text and place point there. @@ -11528,7 +11519,7 @@ 2002-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-delay.el (gnus-delay-send-queue): Renamed. + * gnus-delay.el (gnus-delay-send-queue): Rename. * gnus-art.el (gnus-ignored-headers): More headers. @@ -11558,7 +11549,7 @@ 2001-12-31 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-group.el (gnus-group-line-format): Added %O to the default + * gnus-group.el (gnus-group-line-format): Add %O to the default value. * gnus-util.el (gnus-text-with-property): The smallest point is @@ -11591,7 +11582,7 @@ * gnus-ems.el (gnus-article-display-xface): Mark and store image. - * gnus-art.el (gnus-article-wash-status-entry): Renamed. + * gnus-art.el (gnus-article-wash-status-entry): Rename. (gnus-article-wash-status): Use it. (gnus-signature-toggle): Clean up. (gnus-add-wash-status): New function. @@ -11615,7 +11606,7 @@ * smiley-ems.el (gnus-smiley-file-types): New variable. (smiley-update-cache): Use it. (smiley-regexp-alist): Suffix-less smiley names. - (smiley-regexp-alist): Added more smileys. + (smiley-regexp-alist): Add more smileys. * gnus-sum.el (gnus-print-buffer): Made into own function. (gnus-summary-print-article): Use it. @@ -11630,8 +11621,8 @@ 2001-12-31 Simon Josefsson <jas@extundo.com> - * imap.el (imap-parse-fetch): Notice empty flags responses. From - Nic Ferrier <nferrier@tf1.tapsellferrier.co.uk>. + * imap.el (imap-parse-fetch): Notice empty flags responses. + From Nic Ferrier <nferrier@tf1.tapsellferrier.co.uk>. 2001-12-30 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -11644,15 +11635,15 @@ 2001-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-art.el (gnus-article-treat-fold-newsgroups): Don't - infloop. + * gnus-art.el (gnus-article-treat-fold-newsgroups): + Don't infloop. * gnus-sum.el (t): New `W D' map. * gnus-art.el (gnus-treat-fold-newsgroups): New variable. (gnus-article-treat-body-boundary): Clean up. - (gnus-body-boundary-face): Removed. - (gnus-article-goto-header): Moved here. + (gnus-body-boundary-face): Remove. + (gnus-article-goto-header): Move here. (gnus-article-goto-header): Allow better regexps. (gnus-article-treat-fold-newsgroups): New command. @@ -11667,7 +11658,7 @@ * mail-parse.el (mail-header-fold-line): New alias. (mail-header-unfold-line): Ditto. - * gnus-art.el (gnus-body-boundary-face): Renamed. + * gnus-art.el (gnus-body-boundary-face): Rename. (gnus-article-treat-body-boundary): Use it. (gnus-article-treat-body-boundary): Use an invisible header and a line of underline characters. @@ -11682,8 +11673,8 @@ (gnus-picon-transform-address): Use it. Set first to t for each address. - * gnus-art.el (gnus-with-article-headers): Move to here. Define - the macro then use it. + * gnus-art.el (gnus-with-article-headers): Move to here. + Define the macro then use it. (gnus-treatment-function-alist): Treat picons earlier. 2001-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -11704,7 +11695,7 @@ * gnus-xmas.el (gnus-xmas-group-startup-message): Use general colors. - * gnus.el (gnus-logo-color-alist): Moved here and renamed. + * gnus.el (gnus-logo-color-alist): Move here and renamed. (gnus-logo-color-style): Ditto. (gnus-logo-colors): Ditto. @@ -11718,26 +11709,26 @@ * ietf-drums.el (ietf-drums-parse-addresses): Accept a nil string. - * gnus-picon.el (gnus-treat-mail-picon): Renamed. + * gnus-picon.el (gnus-treat-mail-picon): Rename. * gnus-art.el (gnus-treat-cc-picon): New variable. - (gnus-treat-mail-picon): Renamed. + (gnus-treat-mail-picon): Rename. * gnus-picon.el: New implementation. - (gnus-picon-find-face): Renamed. + (gnus-picon-find-face): Rename. (gnus-treat-from-picon): Use it. - (gnus-picon-transform-address): Renamed. + (gnus-picon-transform-address): Rename. (gnus-treat-from-picon): Use it. - (gnus-picon-create-glyph): Renamed. + (gnus-picon-create-glyph): Rename. (gnus-picon-transform-address): Use it. (gnus-treat-cc-picon): New command. - * mm-decode.el (mm-create-image-xemacs): Separated out into + * mm-decode.el (mm-create-image-xemacs): Separate out into function. (mm-get-image): Use it. * gnus-art.el (gnus-treat-display-picons): Simplify. - (gnus-treat-from-picon): Renamed. + (gnus-treat-from-picon): Rename. * gnus-ems.el (gnus-create-image): New function. (gnus-put-image): New function. @@ -11764,7 +11755,7 @@ 2001-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus-art.el (gnus-treat-unfold-lines): New variable. - (gnus-treat-unfold-headers): Renamed. + (gnus-treat-unfold-headers): Rename. (gnus-article-treat-unfold-headers): New command and keystroke. * rfc2047.el (rfc2047-encode-message-header): Clean up. @@ -11781,7 +11772,7 @@ 2001-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-picon.el (gnus-picons-news-directories): Removed obsolete + * gnus-picon.el (gnus-picons-news-directories): Remove obsolete alias. (gnus-picons-database): Default to list. (gnus-picons-lookup-internal): Use it. @@ -11819,8 +11810,8 @@ * gnus-art.el (gnus-treatment-function-alist): Emphasize after other treatments. - * gnus-util.el (gnus-put-overlay-excluding-newlines): New - function. + * gnus-util.el (gnus-put-overlay-excluding-newlines): + New function. * gnus-art.el (gnus-article-show-hidden-text): Remove the type from the list of hidden types. @@ -11833,7 +11824,7 @@ 2001-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-art.el (gnus-ignored-headers): Added more headers. + * gnus-art.el (gnus-ignored-headers): Add more headers. 2001-12-29 Jesper Harder <harder@ifa.au.dk> @@ -11846,13 +11837,13 @@ 2001-12-28 Simon Josefsson <jas@extundo.com> - * gnus-srvr.el (gnus-browse-foreign-server): Fix typo. From - Jesper Harder <harder@ifa.au.dk>. + * gnus-srvr.el (gnus-browse-foreign-server): Fix typo. + From Jesper Harder <harder@ifa.au.dk>. 2001-12-27 Simon Josefsson <jas@extundo.com> - * gnus-sum.el (gnus-select-newsgroup): Make - `gnus-newsgroup-unseen' sorted. Make `gnus-newsgroup-unseen' + * gnus-sum.el (gnus-select-newsgroup): + Make `gnus-newsgroup-unseen' sorted. Make `gnus-newsgroup-unseen' contain all articles (instead of none) when no seen marks have been set for the group. (gnus-update-marks): Use `gnus-range-add' on a uncompressed list @@ -11860,8 +11851,8 @@ 2001-12-26 11:00:00 Jesper Harder <harder@ifa.au.dk> - * mm-util.el (mm-iso-8859-x-to-15-region): Use - insert-before-markers. + * mm-util.el (mm-iso-8859-x-to-15-region): + Use insert-before-markers. 2001-12-26 Paul Jarc <prj@po.cwru.edu> @@ -11874,8 +11865,8 @@ 2001-12-22 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-group.el (gnus-group-read-ephemeral-group): Call - gnus-group-real-name. + * gnus-group.el (gnus-group-read-ephemeral-group): + Call gnus-group-real-name. * gnus-sum.el (gnus-decode-encoded-word-methods): Backslash paren. (gnus-newsgroup-variables): Ditto. @@ -11904,8 +11895,8 @@ * nnimap.el (top-level): Don't require cl. Suggested by ShengHuo ZHU <zsh@cs.rochester.edu>. - (nnimap-close-group): Don't quote KEYLIST items. Suggested by - Brian P Templeton <bpt@tunes.org>. + (nnimap-close-group): Don't quote KEYLIST items. + Suggested by Brian P Templeton <bpt@tunes.org>. 2001-12-19 17:00:00 Paul Jarc <prj@po.cwru.edu> @@ -11946,8 +11937,8 @@ * gnus-salt.el (gnus-tree-recenter, gnus-generate-tree) (gnus-generate-tree, gnus-highlight-selected-tree) - (gnus-highlight-selected-tree, gnus-tree-highlight-article): Use - it. + (gnus-highlight-selected-tree, gnus-tree-highlight-article): + Use it. * gnus-art.el (gnus-article-set-window-start) (gnus-mm-display-part, gnus-request-article-this-buffer) @@ -12004,7 +11995,7 @@ 2001-12-13 Josh Huber <huber@alum.wpi.edu> - * gnus-cus.el (gnus-extra-topic-parameters): Added topic parameter + * gnus-cus.el (gnus-extra-topic-parameters): Add topic parameter subscribe-level * gnus-topic.el (gnus-subscribe-topics): Use it. @@ -12110,8 +12101,8 @@ 2001-12-07 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * nnrss.el (nnrss-decode-entities-unibyte-string): Use - mm-url-decode-entities-nbsp. + * nnrss.el (nnrss-decode-entities-unibyte-string): + Use mm-url-decode-entities-nbsp. * nnlistserv.el, nnultimate.el, nnwarchive.el, nnweb.el: * webmail.el, nnwfm.el: Use mm-url. @@ -12131,7 +12122,7 @@ 2001-12-06 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * nnweb.el (nnweb-replace-in-string): Removed. + * nnweb.el (nnweb-replace-in-string): Remove. * gnus-util.el (gnus-replace-in-string): New function. (gnus-mode-string-quote): Use it. @@ -12179,8 +12170,8 @@ 2001-12-01 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-sum.el (gnus-summary-save-article): Nix - gnus-display-mime-function and gnus-article-prepare-hook. + * gnus-sum.el (gnus-summary-save-article): + Nix gnus-display-mime-function and gnus-article-prepare-hook. * gnus-spec.el (gnus-parse-complex-format): Properly handle %C at the beginning of lines. @@ -12216,8 +12207,8 @@ 2001-11-29 Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> * message.el (message-newgroups-header-regexp) - (message-completion-alist, message-tab-body-function): Use - defcustom rather than defvar. + (message-completion-alist, message-tab-body-function): + Use defcustom rather than defvar. (message-tab): Mention `message-tab-body-function' in doc. Suggested by Karl Eichwalder. @@ -12252,8 +12243,8 @@ * message.el (message-mode): make-local-hook is harmless in Emacs 21. - * gnus-msg.el (gnus-configure-posting-styles): Use - make-local-hook. Add LOCAL for add-hook. + * gnus-msg.el (gnus-configure-posting-styles): + Use make-local-hook. Add LOCAL for add-hook. 2001-11-27 Per Abrahamsen <abraham@dina.kvl.dk> @@ -12419,8 +12410,8 @@ 2001-11-15 Per Abrahamsen <abraham@dina.kvl.dk> - * gnus-art.el (gnus-article-wash-status-strings): Use - `copy-sequence', not `copy-seq'. + * gnus-art.el (gnus-article-wash-status-strings): + Use `copy-sequence', not `copy-seq'. 2001-11-15 Per Abrahamsen <abraham@dina.kvl.dk> @@ -12435,7 +12426,7 @@ 2001-11-12 Simon Josefsson <jas@extundo.com> * mml1991.el (mml1991-use, mml1991-function-alist): New variables. - (mml1991-gpg-sign, mml1991-gpg-encrypt): Renamed, from + (mml1991-gpg-sign, mml1991-gpg-encrypt): Rename, from `mml1991-sign' and `mml1991-encrypt'. (mml1991-encrypt, mml1991-sign): New glue functions. (mml1991-mailcrypt-sign, mml1991-mailcrypt-encrypt): New functions. @@ -12466,8 +12457,8 @@ * message.el (top-level): Autoload sha1. (message-canlock-generate): Use sha1 instead of md5 (sha1 used by - canlock, no need to require two different hash algs). Suggested - by Ferenc Wagner <wferi@bolyai1.elte.hu>. + canlock, no need to require two different hash algs). + Suggested by Ferenc Wagner <wferi@bolyai1.elte.hu>. 2001-11-09 Pavel Janík <Pavel@Janik.cz> @@ -12493,13 +12484,13 @@ * sieve-mode.el (sieve-control-commands-face) (sieve-control-commands-face, sieve-action-commands-face) - (sieve-test-commands-face, sieve-tagged-arguments-face): New - faces. + (sieve-test-commands-face, sieve-tagged-arguments-face): + New faces. (sieve-font-lock-keywords): Use them. (sieve-mode): Only set font-lock-defaults in emacs. - * gnus-art.el (gnus-default-article-saver): Add - gnus-summary-save-body-in-file. + * gnus-art.el (gnus-default-article-saver): + Add gnus-summary-save-body-in-file. (gnus-summary-write-to-file): Fix doc. 2001-11-07 Simon Josefsson <jas@extundo.com> @@ -12588,7 +12579,7 @@ (nnimap-expunge): Don't use it. * imap.el (imap-callbacks): New variable. - (imap-remassoc): Copied from `gnus-remassoc'. + (imap-remassoc): Copy from `gnus-remassoc'. (imap-add-callback): New function. (imap-mailbox-expunge, imap-mailbox-close): Support asynchronous behavior. @@ -12633,8 +12624,8 @@ * smiley-ems.el (smiley-update-cache): Auto detect file type. - * message.el (message-forward-rmail-make-body): Use - save-window-excursion. + * message.el (message-forward-rmail-make-body): + Use save-window-excursion. (message-encode-message-body): Search with noerror. (message-setup-1): Convert compose-mail send-actions to message-send-actions. @@ -12715,8 +12706,8 @@ (mm-charset-synonym-alist): Remove windows-125[02]. Make other entries conditional on not having a coding system defined for them. - (mm-mule-charset-to-mime-charset): Use - find-coding-systems-for-charsets if defined. + (mm-mule-charset-to-mime-charset): + Use find-coding-systems-for-charsets if defined. (mm-charset-to-coding-system): Don't use mm-get-coding-system-list. Look in mm-charset-synonym-alist later. Add last resort search of coding systems. @@ -12742,8 +12733,8 @@ 2001-10-30 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-spec.el (gnus-parse-simple-format): Use - buffer-substring-no-properties. + * gnus-spec.el (gnus-parse-simple-format): + Use buffer-substring-no-properties. 2001-10-30 Katsumi Yamaoka <yamaoka@jpl.org> @@ -12846,8 +12837,8 @@ 2001-10-22 Simon Josefsson <jas@extundo.com> - * gnus-msg.el (gnus-extended-version): Include - system-configuration. + * gnus-msg.el (gnus-extended-version): + Include system-configuration. Suggested by Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Großjohann). 2001-10-22 Per Abrahamsen <abraham@dina.kvl.dk> @@ -12860,8 +12851,8 @@ 2001-10-21 Simon Josefsson <jas@extundo.com> * nnimap.el (nnimap): Defgroup. - (nnimap-strict-function, nnimap-strict-function-match): New - widget, from Per Abrahamsen <abraham@dina.kvl.dk>. + (nnimap-strict-function, nnimap-strict-function-match): + New widget, from Per Abrahamsen <abraham@dina.kvl.dk>. (nnimap-split-crosspost, nnimap-split-inbox) (nnimap-split-rule, nnimap-split-predicate) (nnimap-split-predicate): Defcustom. @@ -12907,9 +12898,9 @@ * message.el (message-do-auto-fill): New version that does not rely on text properties, by Simon Josefsson <jas@extundo.com>. - (message-setup-1): Removed the `message-field' property. + (message-setup-1): Remove the `message-field' property. - * gnus-draft.el (gnus-draft-edit-message): Removed the + * gnus-draft.el (gnus-draft-edit-message): Remove the `message-field' property. 2001-10-19 Per Abrahamsen <abraham@dina.kvl.dk> @@ -12945,8 +12936,8 @@ * message.el (message-check-news-header-syntax): Special case nnvirtual groups. - * gnus-sum.el (gnus-summary-respool-default-method): Changed - customize type to `symbol'. + * gnus-sum.el (gnus-summary-respool-default-method): + Change customize type to `symbol'. 2001-10-17 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -12968,13 +12959,13 @@ 2001-10-17 Per Abrahamsen <abraham@dina.kvl.dk> - * gnus-msg.el (gnus-post-method): Changed two instances of + * gnus-msg.el (gnus-post-method): Change two instances of `active' to `current' and one `null' to `not'. 2001-10-16 Katsumi Yamaoka <yamaoka@jpl.org> - * message.el (message-setup-fill-variables): Use - `normal-auto-fill-function' instead of `auto-fill-function'. + * message.el (message-setup-fill-variables): + Use `normal-auto-fill-function' instead of `auto-fill-function'. 2001-10-16 Simon Josefsson <jas@extundo.com> @@ -13040,8 +13031,8 @@ 2001-10-12 Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> Suggested by Oliver Scholz <epameinondas@gmx.de>. - * message.el (message-do-auto-fill): New function. Like - `do-auto-fill' but don't fill when in the message header. + * message.el (message-do-auto-fill): New function. + Like `do-auto-fill' but don't fill when in the message header. (message-setup-1): Put a text property on the message header. (message-setup-fill-variables): Use `message-do-auto-fill'. @@ -13063,8 +13054,8 @@ 2001-10-10 Katsumi Yamaoka <yamaoka@jpl.org> - * gnus-group.el (gnus-group-name-charset-group-alist): Use - `find-coding-system' for XEmacs to check whether the coding-system + * gnus-group.el (gnus-group-name-charset-group-alist): + Use `find-coding-system' for XEmacs to check whether the coding-system `utf-8' is available. 2001-10-09 Per Abrahamsen <abraham@dina.kvl.dk> @@ -13074,8 +13065,8 @@ 2001-10-09 Per Abrahamsen <abraham@dina.kvl.dk> - * message.el (message-send-news): Allow - `gnus-group-name-charset-group-alist' to affect encoding of the + * message.el (message-send-news): + Allow `gnus-group-name-charset-group-alist' to affect encoding of the "Newsgroups" and "Followup-To" headers. 2001-10-07 Per Abrahamsen <abraham@dina.kvl.dk> @@ -13096,7 +13087,7 @@ default charset for newsgroup names in accordance with USEFOR. * gnus-group.el (gnus-group-name-charset-method-alist, - gnus-group-name-charset-group-alist): Removed "*" from doc + gnus-group-name-charset-group-alist): Remove "*" from doc strings, "*" should not be used for complex variables. 2001-10-06 Simon Josefsson <jas@extundo.com> @@ -13110,18 +13101,18 @@ `gnus-article-decode-hook's except `article-decode-charset' instead of hardcoding call to one of them. - * gnus-art.el (gnus-article-decode-hook): Add - `article-decode-group-name'. + * gnus-art.el (gnus-article-decode-hook): + Add `article-decode-group-name'. (article-decode-group-name): New function, use `g-d-n'. - * gnus-group.el (gnus-group-insert-group-line): Decode - gnus-tmp-group using `g-d-n'. + * gnus-group.el (gnus-group-insert-group-line): + Decode gnus-tmp-group using `g-d-n'. * gnus-util.el (gnus-decode-newsgroups): New function. 2001-10-06 Per Abrahamsen <abraham@dina.kvl.dk> - * gnus-srvr.el (gnus-browse-foreign-server): Fixed bug non-nil + * gnus-srvr.el (gnus-browse-foreign-server): Fix bug non-nil `gnus-group-name-charset-group-alist'. 2001-10-05 Simon Josefsson <jas@extundo.com> @@ -13283,8 +13274,8 @@ 2001-09-19 Sam Steingold <sds@gnu.org> - * gnus-win.el (gnus-buffer-configuration): Respect - `gnus-bug-create-help-buffer'. + * gnus-win.el (gnus-buffer-configuration): + Respect `gnus-bug-create-help-buffer'. 2001-09-18 Simon Josefsson <jas@extundo.com> @@ -13338,7 +13329,7 @@ 2001-09-14 Simon Josefsson <jas@extundo.com> - * gnus-start.el (gnus-group-mode-hook): Moved from gnus-group + * gnus-start.el (gnus-group-mode-hook): Move from gnus-group (otherwise e.g. gnus-agentize in .gnus overrides the customized default before gnus-group is loaded and the variable set.) @@ -13369,11 +13360,11 @@ * nndiary.el (nndiary-request-accept-article-hooks): New. * nndiary.el (nndiary-request-accept-article): Use it, check message validity. - * nndiary.el (nndiary-get-new-mail): Changed default to nil. + * nndiary.el (nndiary-get-new-mail): Change default to nil. * nndiary.el (nndiary-schedule): Fix bug (misplaced condition-case): it didn't return nil on error. * gnus-diary.el: New version. - * gnus-diary.el (gnus-diary-summary-line-format): Removed %I. + * gnus-diary.el (gnus-diary-summary-line-format): Remove %I. * gnus-diary.el (gnus-diary-header-value-history): New. * gnus-diary.el (gnus-diary-narrow-to-headers): New. * gnus-diary.el (gnus-diary-add-header): New. @@ -13383,11 +13374,11 @@ 2001-09-10 TSUCHIYA Masatoshi <tsuchiya@namazu.org> - * gnus-sum.el (gnus-select-newsgroup): Make - `gnus-current-select-method' buffer-local. + * gnus-sum.el (gnus-select-newsgroup): + Make `gnus-current-select-method' buffer-local. - * gnus-art.el (gnus-request-article-this-buffer): Refer - `gnus-current-select-method' in the current summary buffer. + * gnus-art.el (gnus-request-article-this-buffer): + Refer `gnus-current-select-method' in the current summary buffer. 2001-09-10 Daniel Pittman <daniel@rimspace.net> @@ -13395,10 +13386,10 @@ 2001-09-09 Simon Josefsson <jas@extundo.com> - * mm-decode.el (mm-inline-media-tests): Add - application/x-emacs-lisp. - (mm-attachment-override-types): Add - application/{x-,}pkcs7-signature. + * mm-decode.el (mm-inline-media-tests): + Add application/x-emacs-lisp. + (mm-attachment-override-types): + Add application/{x-,}pkcs7-signature. * gnus-srvr.el (gnus-server-mode-hook, gnus-server-exit-hook) (gnus-server-line-format, gnus-server-mode-line-format) @@ -13431,8 +13422,8 @@ (nnml-request-update-info): Don't update if marks didn't change. * gnus-agent.el (gnus-agent-any-covered-gcc) - (gnus-agent-add-server, gnus-agent-remove-server): Use - gnus-agent-method-p. + (gnus-agent-add-server, gnus-agent-remove-server): + Use gnus-agent-method-p. * gnus-art.el (gnus-buttonized-mime-types): New variable. (gnus-unbuttonized-mime-type-p): Use it. @@ -13634,8 +13625,8 @@ * gnus-spec.el (gnus-compile): Don't compile gnus-version. - * gnus-group.el (gnus-update-group-mark-positions): Bind - gnus-group-update-hook to nil. + * gnus-group.el (gnus-update-group-mark-positions): + Bind gnus-group-update-hook to nil. 2001-08-24 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -13655,8 +13646,8 @@ 2001-08-24 Simon Josefsson <jas@extundo.com> - * gnus-group.el (gnus-info-clear-data): Call - nnfoo-request-set-mark to propagate marks. Fix bug: + * gnus-group.el (gnus-info-clear-data): + Call nnfoo-request-set-mark to propagate marks. Fix bug: `gnus-group-update-line' doesn't update read range unless we call `gnus-get-unread-articles-in-group' first. @@ -13732,8 +13723,8 @@ 2001-08-20 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * nnslashdot.el (nnslashdot-retrieve-headers-1): Replace - nnslashdot-*-retrieve-headers. + * nnslashdot.el (nnslashdot-retrieve-headers-1): + Replace nnslashdot-*-retrieve-headers. (nnslashdot-request-article): Fix for slashcode 2.2. (nnslashdot-make-tuple): New function. (nnslashdot-read-groups): Use it. @@ -13775,15 +13766,15 @@ * mm-view.el (mm-inline-text): Ignore vcard errors. - * gnus-art.el (gnus-ignored-headers): Added more junk headers. + * gnus-art.el (gnus-ignored-headers): Add more junk headers. * gnus-score.el (gnus-all-score-files): Use append instead of nconc. * gnus.el (gnus-splash-face): Doc fix. - * mm-decode.el (mm-mailcap-command): Use - mm-path-name-rewrite-functions. + * mm-decode.el (mm-mailcap-command): + Use mm-path-name-rewrite-functions. (mm-path-name-rewrite-functions): New variable. * gnus-spec.el (gnus-parse-complex-format): React to ?=. @@ -13797,10 +13788,10 @@ the positional spec. (gnus-parse-complex-format): React to %C. - * gnus-ems.el (gnus-char-width): Moved here. + * gnus-ems.el (gnus-char-width): Move here. - * gnus-sum.el (gnus-select-newsgroup): Set - gnus-newsgroup-articles. + * gnus-sum.el (gnus-select-newsgroup): + Set gnus-newsgroup-articles. (gnus-unseen-mark): New variable. (gnus-newsgroup-unseen): Ditto. (gnus-newsgroup-seen): Ditto. @@ -13858,15 +13849,15 @@ 2001-08-18 Simon Josefsson <jas@extundo.com> - * gnus-util.el (gnus-remassoc, gnus-update-alist-soft): Moved from + * gnus-util.el (gnus-remassoc, gnus-update-alist-soft): Move from nnimap. - * nnimap.el (nnimap-remassoc, nnimap-update-alist-soft): Moved to + * nnimap.el (nnimap-remassoc, nnimap-update-alist-soft): Move to gnus-util. (nnimap-request-update-info-internal): Use new functions. - * nnml.el (nnml-request-set-mark, nnml-request-update-info): Use - new functions. + * nnml.el (nnml-request-set-mark, nnml-request-update-info): + Use new functions. 2001-08-18 Simon Josefsson <jas@extundo.com> @@ -13963,7 +13954,7 @@ * gnus-start.el (gnus-setup-news): Push the archive server only the server list. - * mml.el (mml-menu): Changed name to "Attachments". + * mml.el (mml-menu): Change name to "Attachments". * mm-decode.el (mm-destroy-postponed-undisplay-list): Only message when there is something to destroy. @@ -13999,8 +13990,8 @@ `nnmail-split-history' if recent is > 0. (nnimap-request-update-info-internal): Update `recent' marks. (nnimap-request-set-mark): Never set `recent' marks. - (nnimap-mark-to-predicate-alist, nnimap-mark-to-flag-alist): Add - recent. + (nnimap-mark-to-predicate-alist, nnimap-mark-to-flag-alist): + Add recent. * gnus-sum.el (gnus-recent-mark): New mark. (gnus-newsgroup-recent): New variable. @@ -14013,8 +14004,8 @@ 2001-08-12 Simon Josefsson <jas@extundo.com> - * mm-bodies.el (mm-decode-content-transfer-encoding): Returns - whether successful decoding took place. Add doc. + * mm-bodies.el (mm-decode-content-transfer-encoding): + Returns whether successful decoding took place. Add doc. 2001-08-12 Simon Josefsson <jas@extundo.com> Suggested by Per Abrahamsen <abraham@dina.kvl.dk> @@ -14051,8 +14042,8 @@ 2001-08-10 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-ml.el (turn-on-gnus-mailing-list-mode): Use - gnus-group-find-parameter. Suggested by Janne Rinta-Manty + * gnus-ml.el (turn-on-gnus-mailing-list-mode): + Use gnus-group-find-parameter. Suggested by Janne Rinta-Manty <rintaman@cs.Helsinki.FI>. * mail-source.el (mail-source-movemail): The error buffer is @@ -14065,8 +14056,8 @@ 2001-08-09 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * nndraft.el (nndraft-request-group): Use - nndraft-auto-save-file-name. + * nndraft.el (nndraft-request-group): + Use nndraft-auto-save-file-name. 2001-08-09 Simon Josefsson <jas@extundo.com> @@ -14091,8 +14082,8 @@ 2001-08-09 Simon Josefsson <jas@extundo.com> - * message.el (message-get-reply-headers): Fix string. Suggested by - Christoph Conrad <cc@cli.de>. + * message.el (message-get-reply-headers): Fix string. + Suggested by Christoph Conrad <cc@cli.de>. 2001-08-08 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -14107,8 +14098,8 @@ 2001-08-04 Nuutti Kotivuori <nuutti.kotivuori@smarttrust.com> - * gnus-sum.el (gnus-summary-show-article): Call - gnus-summary-update-secondary-secondary-mark. + * gnus-sum.el (gnus-summary-show-article): + Call gnus-summary-update-secondary-secondary-mark. * gnus-sum.el (gnus-summary-edit-article-done): Ditto. * gnus-sum.el (gnus-summary-reparent-thread): Ditto. @@ -14131,8 +14122,8 @@ 2001-08-06 Florian Weimer <fw@deneb.enyo.de> - * message.el (message-indent-citation): Use - `message-yank-cited-prefix' for empty lines. + * message.el (message-indent-citation): + Use `message-yank-cited-prefix' for empty lines. 2001-08-05 Florian Weimer <fw@deneb.enyo.de> @@ -14141,8 +14132,8 @@ 2001-08-05 Nuutti Kotivuori <nuutti.kotivuori@smarttrust.com> (tiny change) - * gnus-cache.el (gnus-cache-possibly-enter-article): Use - gnus-cache-fully-p. + * gnus-cache.el (gnus-cache-possibly-enter-article): + Use gnus-cache-fully-p. 2001-08-04 Simon Josefsson <jas@extundo.com> @@ -14152,7 +14143,7 @@ 2001-08-04 Simon Josefsson <jas@extundo.com> * gnus-cache.el (gnus-cache-possibly-enter-article): Revert. - (gnus-cache-passively-or-fully-p): Removed. + (gnus-cache-passively-or-fully-p): Remove. (gnus-cache-fully-p): Fix it. * mm-view.el (mm-pkcs7-signed-magic): Support more ASN.1 lengths. @@ -14180,8 +14171,8 @@ 2001-08-04 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-art.el (gnus-mime-security-verify-or-decrypt): Insert - before remove. + * gnus-art.el (gnus-mime-security-verify-or-decrypt): + Insert before remove. (gnus-mime-security-show-details): Ditto. 2001-08-04 Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> @@ -14228,7 +14219,7 @@ 2001-08-02 Simon Josefsson <jas@extundo.com> - * smime.el (smime-extra-arguments): Removed. + * smime.el (smime-extra-arguments): Remove. (smime-call-openssl-region): Don't use it. 2001-08-02 Simon Josefsson <jas@extundo.com> @@ -14236,8 +14227,8 @@ * smime.el (smime-sign-region): Handle stderr. (smime-encrypt-region): Ditto. - * mm-view.el (mm-pkcs7-signed-magic): Make it a regexp. Don't - match the ASN.1 length bytes. + * mm-view.el (mm-pkcs7-signed-magic): Make it a regexp. + Don't match the ASN.1 length bytes. (mm-pkcs7-enveloped-magic): Ditto. (mm-view-pkcs7-get-type): Don't regexp quote. @@ -14305,8 +14296,8 @@ * smime.el (smime-call-openssl-region): Revert previous change, just pass on buf to `call-process-region'. - (smime-verify-region): Doc fix. Don't message stuff. Use - `smime-new-details-buffer'. Inserts error messages into buffer. + (smime-verify-region): Doc fix. Don't message stuff. + Use `smime-new-details-buffer'. Inserts error messages into buffer. (smime-noverify-region): Ditto. (smime-decrypt-region): Ditto. Handles stderr separately. (smime-verify-buffer, smime-noverify-buffer) @@ -14321,8 +14312,8 @@ 2001-07-30 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-art.el (gnus-mime-save-part-and-strip): Save - gnus-article-mime-handles. + * gnus-art.el (gnus-mime-save-part-and-strip): + Save gnus-article-mime-handles. 2001-07-29 Simon Josefsson <jas@extundo.com> @@ -14380,8 +14371,8 @@ * gnus.el (gnus-summary-line-format): Mention `gnus-sum-thread-*' for %B spec. - * gnus-sum.el (gnus-summary-prepare-threads): If - gnus-sum-thread-tree-root is nil, use subject instead. + * gnus-sum.el (gnus-summary-prepare-threads): + If gnus-sum-thread-tree-root is nil, use subject instead. (gnus-sum-thread-tree-root, gnus-sum-thread-tree-single-indent) (gnus-sum-thread-tree-vertical, gnus-sum-thread-tree-indent) (gnus-sum-thread-tree-leaf-with-other) @@ -14407,16 +14398,16 @@ 2001-07-27 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * nnfolder.el (nnfolder-request-accept-article): Bind - nntp-server-buffer. + * nnfolder.el (nnfolder-request-accept-article): + Bind nntp-server-buffer. * nnmail.el (nnmail-parse-active): Read from buffer instead of nntp-server-buffer. 2001-07-27 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * message.el (message-check-news-header-syntax): Use - message-post-method. + * message.el (message-check-news-header-syntax): + Use message-post-method. (message-send-news): Bind message-post-method. 2001-07-27 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -14428,8 +14419,8 @@ 2001-07-26 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * nnfolder.el (nnfolder-request-accept-article): Replace - nnfolder-request-list. + * nnfolder.el (nnfolder-request-accept-article): + Replace nnfolder-request-list. 2001-07-27 Simon Josefsson <jas@extundo.com> @@ -14444,8 +14435,8 @@ * gnus-art.el (gnus-mm-display-part): Narrow to point if eobp. - * message.el (message-set-auto-save-file-name): More - poor-system-types. + * message.el (message-set-auto-save-file-name): + More poor-system-types. * mailcap.el (mailcap-parse-mimetypes): poor-system-types. @@ -14489,8 +14480,8 @@ 2001-07-25 22:22:22 Raymond Scholz <rscholz@zonix.de> - * nnmail.el (nnmail-split-fancy-with-parent-ignore-groups): New - variable. + * nnmail.el (nnmail-split-fancy-with-parent-ignore-groups): + New variable. (nnmail-split-fancy-with-parent): Ignore certain groups. 2001-07-25 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -14574,8 +14565,8 @@ 2001-07-23 Katsumi Yamaoka <yamaoka@jpl.org> - * gnus-start.el (gnus-setup-news): Call - `gnus-check-bogus-newsgroups' just after the native server is + * gnus-start.el (gnus-setup-news): + Call `gnus-check-bogus-newsgroups' just after the native server is opened. 2001-07-23 Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> @@ -14614,8 +14605,8 @@ * mm-util.el (mm-read-coding-system): Take two arguments. - * gnus-sum.el (gnus-summary-show-article): Use - mm-read-coding-system. + * gnus-sum.el (gnus-summary-show-article): + Use mm-read-coding-system. * gnus-art.el (article-de-quoted-unreadable): (article-de-base64-unreadable, article-wash-html): @@ -14631,8 +14622,8 @@ * nntp.el (nntp-request-newgroups): Use UTC date for NEWGROUPS command. - * gnus-start.el (gnus-find-new-newsgroups): Use - `message-make-date' instead of `current-time-string'. + * gnus-start.el (gnus-find-new-newsgroups): + Use `message-make-date' instead of `current-time-string'. (gnus-ask-server-for-new-groups): Ditto. (gnus-check-first-time-used): Ditto. @@ -14757,7 +14748,7 @@ 2001-07-12 Björn Torkelsson <torkel@hpc2n.umu.se> - * gnus-srvr.el (gnus-browse-make-menu-bar): Changed one of the + * gnus-srvr.el (gnus-browse-make-menu-bar): Change one of the Browse->Next entries to Browse->Prev. 2001-07-11 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -15078,8 +15069,8 @@ 2001-06-15 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-art.el (article-strip-multiple-blank-lines): Use - delete-region instead of replace-match. + * gnus-art.el (article-strip-multiple-blank-lines): + Use delete-region instead of replace-match. 2001-06-14 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -15160,8 +15151,8 @@ 2001-06-05 Alex Schroeder <alex@gnu.org> - * mm-decode.el (mm-handle-set-external-undisplayer): Don't - generate compiler warnings. + * mm-decode.el (mm-handle-set-external-undisplayer): + Don't generate compiler warnings. 2001-06-04 Hrvoje Niksic <hniksic@arsdigita.com> @@ -15346,7 +15337,7 @@ 2001-04-25 Per Abrahamsen <abraham@dina.kvl.dk> - * mm-uu.el (mm-uu-configure-list): Fixed customize type. + * mm-uu.el (mm-uu-configure-list): Fix customize type. 2001-04-24 Hrvoje Niksic <hniksic@arsdigita.com> @@ -15416,7 +15407,7 @@ 2001-04-02 Nevin Kapur <nevin@jhu.edu> - * nnmail.el (nnmail-split-it): Added check for .* at the end of + * nnmail.el (nnmail-split-it): Add check for .* at the end of regexp in nnmail-split-fancy. 2001-04-10 Simon Josefsson <simon@josefsson.org> @@ -15545,8 +15536,8 @@ 2001-03-31 00:03:42 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-msg.el (gnus-inews-insert-draft-meta-information): Allow - lists of articles. + * gnus-msg.el (gnus-inews-insert-draft-meta-information): + Allow lists of articles. * gnus-uu.el (gnus-uu-digest-mail-forward): Mark as forwarded. @@ -15563,7 +15554,7 @@ forwarded. (gnus-summary-mail-forward): Clean up. - * gnus.el (gnus-article-mark-lists): Added forward. + * gnus.el (gnus-article-mark-lists): Add forward. * gnus-sum.el (gnus-forwarded-mark): New variable. (gnus-summary-prepare-threads): Use it. @@ -15593,14 +15584,14 @@ 2001-03-15 09:47:23 Lars Magne Ingebrigtsen <larsi@gnus.org> - * nnultimate.el (nnultimate-retrieve-headers): Understand - long-form month names. + * nnultimate.el (nnultimate-retrieve-headers): + Understand long-form month names. 2001-03-18 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> * gnus-sum.el (gnus-summary-show-all-headers): - gnus-article-show-all-headers is broken. Use - gnus-summary-toggle-header instead. + gnus-article-show-all-headers is broken. + Use gnus-summary-toggle-header instead. * mml2015.el (mml2015-gpg-extract-from): No error. @@ -15612,8 +15603,8 @@ 2001-03-17 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * message.el (message-setup-fill-variables): Use - fill-paragraph-function. + * message.el (message-setup-fill-variables): + Use fill-paragraph-function. (message-fill-paragraph): Take an argument. (message-newline-and-reformat): Take another argument. @@ -15628,7 +15619,7 @@ 2001-03-16 Simon Josefsson <simon@josefsson.org> - * nnimap.el (nnimap-dont-use-nov-p): Renamed from + * nnimap.el (nnimap-dont-use-nov-p): Rename from `nnimap-use-nov-p' (it really tested the negative). (nnimap-retrieve-headers): Use it. @@ -15669,8 +15660,8 @@ ;; 2001-03-01 Dave Love <fx@gnu.org> - * mm-util.el (mm-inhibit-file-name-handlers): Add - image-file-handler. + * mm-util.el (mm-inhibit-file-name-handlers): + Add image-file-handler. 2001-02-11 Dave Love <fx@gnu.org> @@ -15704,8 +15695,8 @@ * gnus-score.el (gnus-score-find-bnews): Print messages on illegal SCORE paths. - * mm-decode.el (mm-dissect-buffer): Call - mail-extract-address-components only if necessary. + * mm-decode.el (mm-dissect-buffer): + Call mail-extract-address-components only if necessary. 2001-03-06 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -15715,8 +15706,8 @@ 2001-03-06 13:00:00 Adrian Aichner <adrian@xemacs.org> - * gnus-score.el (gnus-score-score-files-1): Use - gnus-kill-files-directory. + * gnus-score.el (gnus-score-score-files-1): + Use gnus-kill-files-directory. 2001-03-05 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -15726,8 +15717,8 @@ * mml.el (mml-preview): Disable local map. - * gnus-sum.el (gnus-summary-make-menu-bar): Make - gnus-article-post-menu here. + * gnus-sum.el (gnus-summary-make-menu-bar): + Make gnus-article-post-menu here. * gnus-art.el (gnus-article-make-menu-bar): Make summary-menu bar if it has not been made. @@ -15824,8 +15815,8 @@ * smiley.el (gnus-smiley-display): Don't do widening. - * smiley-ems.el (gnus-smiley-display): Don't do widening. Smiley - within body. + * smiley-ems.el (gnus-smiley-display): Don't do widening. + Smiley within body. * gnus-msg.el (gnus-inews-do-gcc): Activate group anyway. @@ -15911,7 +15902,7 @@ 2001-02-14 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus.el (gnus-define-group-parameter): Improved. + * gnus.el (gnus-define-group-parameter): Improve. * gnus-sum.el (charset): Define parameter. (ignored-charsets): Ditto. @@ -15927,8 +15918,8 @@ 2001-02-13 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-sum.el (gnus-summary-read-group-1): Remove - gnus-summary-set-local-parameters. + * gnus-sum.el (gnus-summary-read-group-1): + Remove gnus-summary-set-local-parameters. (gnus-summary-setup-buffer): Put it here. 2001-02-13 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -15980,8 +15971,8 @@ (article-remove-leading-whitespace): New function. (gnus-article-make-menu-bar): Use it. - * gnus-sum.el (gnus-summary-wash-empty-map): Add - remove-leading-whitespace. + * gnus-sum.el (gnus-summary-wash-empty-map): + Add remove-leading-whitespace. (gnus-summary-wash-map): Bind strip-headers-in-body to `W a', because of conflict. @@ -16012,13 +16003,13 @@ 2001-02-08 Tommi Vainikainen <thv@iki.fi> (tiny change) - * gnus-sum.el (gnus-simplify-subject-re): Use - message-subject-re-regexp. + * gnus-sum.el (gnus-simplify-subject-re): + Use message-subject-re-regexp. 2001-02-08 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * nnmail.el (nnmail-expiry-target-group): Bind - nnmail-cache-accepted-message-ids to nil. + * nnmail.el (nnmail-expiry-target-group): + Bind nnmail-cache-accepted-message-ids to nil. * gnus-xmas.el (gnus-xmas-article-display-xface): Use binary coding system. @@ -16072,34 +16063,34 @@ 2001-02-06 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-xmas.el (gnus-xmas-article-menu-add): Add - gnus-article-commands-menu. + * gnus-xmas.el (gnus-xmas-article-menu-add): + Add gnus-article-commands-menu. * gnus-sum.el (gnus-summary-make-menu-bar): Don't share menu bar in Emacs. - * gnus-start.el (gnus-read-descriptions-file): Use - gnus-group-name-charset and gnus-group-charset-alist. + * gnus-start.el (gnus-read-descriptions-file): + Use gnus-group-name-charset and gnus-group-charset-alist. 2001-02-04 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-sum.el (gnus-summary-mark-as-processable): Understand - active region. + * gnus-sum.el (gnus-summary-mark-as-processable): + Understand active region. * gnus-start.el (gnus-group-change-level): Remove from both gnus-zombie-list and gnus-killed-list. 2001-02-04 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-start.el (gnus-subscribe-options-newsgroup-method): Add - gnus-subscribe-topics. + * gnus-start.el (gnus-subscribe-options-newsgroup-method): + Add gnus-subscribe-topics. * gnus-cus.el (gnus-extra-topic-parameters): Fix doc. 2001-02-04 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-art.el (gnus-article-make-menu-bar): Make - gnus-article-post-menu. + * gnus-art.el (gnus-article-make-menu-bar): + Make gnus-article-post-menu. * gnus-xmas.el (gnus-xmas-article-menu-add): Add post menu. @@ -16131,8 +16122,8 @@ 2001-01-31 Dave Love <fx@gnu.org> * gnus-art.el (gnus-article-x-face-command) - (gnus-treat-display-xface, gnus-treat-display-smileys): Add - :version. + (gnus-treat-display-xface, gnus-treat-display-smileys): + Add :version. 2001-01-26 Dave Love <fx@gnu.org> @@ -16170,7 +16161,7 @@ 2001-01-31 Karl Kleinpaste <karl@charcoal.com> - * nnmail.el (nnmail-remove-list-identifiers): Improved. + * nnmail.el (nnmail-remove-list-identifiers): Improve. 2001-01-31 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -16317,8 +16308,8 @@ 2001-01-18 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * message.el (message-yank-original): Understand - universal-argument. + * message.el (message-yank-original): + Understand universal-argument. 2001-01-18 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -16349,8 +16340,8 @@ 2001-01-15 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-art.el (article-display-x-face): Use - gnus-original-article-buffer. + * gnus-art.el (article-display-x-face): + Use gnus-original-article-buffer. 2001-01-15 Jack Twilley <jmt@tbe.net> @@ -16408,8 +16399,8 @@ (message-make-forward-subject-function) (message-send-mail-function, message-reply-to-function) (message-wide-reply-to-function, message-followup-to-function) - (message-distribution-function, message-auto-save-directory): Fix - :type. + (message-distribution-function, message-auto-save-directory): + Fix :type. * mml.el (mml-parse-1): Frob mml-confirmation-set when proceeding after warnings. Amend multipart warning message. @@ -16420,8 +16411,8 @@ compiling. (gnus-make-directory): Require nnmail. - * mm-decode.el (mm-inline-media-tests): Add - image/x-portable-bitmap. + * mm-decode.el (mm-inline-media-tests): + Add image/x-portable-bitmap. (mm-get-image): Grok pbm. 2001-01-10 Paul Stevenson <p.stevenson@surrey.ac.uk> @@ -16574,8 +16565,8 @@ 2000-12-30 00:17:38 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-sum.el (gnus-summary-limit-include-expunged): Really - include the expunged articles. + * gnus-sum.el (gnus-summary-limit-include-expunged): + Really include the expunged articles. * gnus-group.el (gnus-group-sort-by-server): New function. @@ -16595,7 +16586,7 @@ * gnus-cite.el (gnus-article-fill-cited-article): Add a space after the fill prefix. - * gnus-sum.el (gnus-summary-make-menu-bar): Removed "Enter + * gnus-sum.el (gnus-summary-make-menu-bar): Remove "Enter score...". * gnus-art.el (gnus-ignored-headers): Hide more headers. @@ -16612,12 +16603,12 @@ 2000-12-29 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * mm-util.el (mm-enable-multibyte): Use - default-enable-multibyte-characters. + * mm-util.el (mm-enable-multibyte): + Use default-enable-multibyte-characters. (mm-enable-multibyte-mule4): Ditto. (mm-disable-multibyte): Test XEmacs. (mm-disable-multibyte-mule4): Ditto. - (mm-with-unibyte-current-buffer): Simplified. + (mm-with-unibyte-current-buffer): Simplify. (mm-with-unibyte-current-buffer-mule4): Ditto. 2000-12-28 19:44:56 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -16672,8 +16663,8 @@ 2000-12-24 Simon Josefsson <sj@extundo.com> - * mm-bodies.el (mm-decode-content-transfer-encoding): Preserve - mailing list junk at end of part. + * mm-bodies.el (mm-decode-content-transfer-encoding): + Preserve mailing list junk at end of part. 2000-12-23 Simon Josefsson <sj@extundo.com> @@ -16768,7 +16759,7 @@ * mml.el (gnus-ems): Don't require. - * gnus.el (gnus-decode-rfc1522): Removed. + * gnus.el (gnus-decode-rfc1522): Remove. (gnus-set-text-properties): Define. 2000-12-21 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -16791,8 +16782,8 @@ 2000-12-20 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> * message.el (message-mail-user-agent): New variable. - (message-setup): Renamed to message-setup-1. Support - mail-user-agent. + (message-setup): Rename to message-setup-1. + Support mail-user-agent. (message-mail-user-agent): New function. (message-mail): Use it. (message-reply): Use it. @@ -16845,8 +16836,8 @@ 2000-12-20 03:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * mm-decode.el (mm-possibly-verify-or-decrypt): Use - mail-extract-a-c instead. Don't depend on Gnus. + * mm-decode.el (mm-possibly-verify-or-decrypt): + Use mail-extract-a-c instead. Don't depend on Gnus. * mml.el (gnus-ems): Require it. @@ -16959,11 +16950,11 @@ 2000-11-30 Dave Love <fx@gnu.org> - * message.el (message-auto-save-directory): Use - file-name-as-directory. - (message-set-auto-save-file-name): Create - message-auto-save-directory if necessary. - (message-replace-chars-in-string): Removed -- unused. + * message.el (message-auto-save-directory): + Use file-name-as-directory. + (message-set-auto-save-file-name): + Create message-auto-save-directory if necessary. + (message-replace-chars-in-string): Remove -- unused. (message-mail-alias-type): Customize. (message-headers): Remove duplicate defgroup. @@ -16990,8 +16981,8 @@ * uu-post.pbm, uu-decode.pbm: New files from XPMs. * mm-uu.el (uudecode): Require. - (uudecode-decode-region, uudecode-decode-region-external): Don't - autoload. + (uudecode-decode-region, uudecode-decode-region-external): + Don't autoload. (mm-uu-copy-to-buffer): Doc fix. (mm-uu-decode-function, mm-uu-binhex-decode-function): Doc, custom type fix. @@ -17001,7 +16992,7 @@ (mailcap): New group. (mailcap-download-directory): Customize. (mailcap-generate-unique-filename, mailcap-binary-suffixes) - (mailcap-temporary-directory): Deleted (unused). + (mailcap-temporary-directory): Delete (unused). (mailcap-unescape-mime-test): Simplify slightly. (mailcap-viewer-passes-test): Use functionp. (mailcap-command-p): Aliased to executable-find. @@ -17039,11 +17030,11 @@ * gnus-agent.el (gnus-agent-confirmation-function): Add :version. (gnus-agent-lib-file, gnus-agent-load-alist) - (gnus-agent-save-alist, gnus-agent-article-name): Use - expand-file-name. + (gnus-agent-save-alist, gnus-agent-article-name): + Use expand-file-name. - * gnus-group.el (gnus-group-name-charset-method-alist): Add - :version. + * gnus-group.el (gnus-group-name-charset-method-alist): + Add :version. (nnkiboze-score-file): Defvar when compiling. * gnus-start.el (gnus-read-newsrc-file): Add :version. @@ -17075,8 +17066,8 @@ * gnus-cache.el (gnus-cache-active-file): Don't use file-name-as-directory on directory. - (gnus-cache-file-name): Use expand-file-name, not concat. Don't - use file-name-as-directory on directory. + (gnus-cache-file-name): Use expand-file-name, not concat. + Don't use file-name-as-directory on directory. * time-date.el (timezone-make-date-arpa-standard): Autoload. (date-to-time): Use it. @@ -17098,7 +17089,7 @@ * gnus-int.el (gnus-start-news-server): Use expand-file-name, not concat. - * pop3.el (pop3-version): Deleted. + * pop3.el (pop3-version): Delete. (pop3-make-date): New function, avoiding message-make-date. (pop3-munge-message-separator): Use it. @@ -17114,12 +17105,12 @@ * message.el (tool-bar-map): Defvar when compiling. * gnus-setup.el (running-xemacs, gnus-use-installed-tm) - (gnus-tm-lisp-directory): Deleted. - (gnus-use-installed-mailcrypt, gnus-emacs-lisp-directory): Use - (featurep 'xemacs). + (gnus-tm-lisp-directory): Delete. + (gnus-use-installed-mailcrypt, gnus-emacs-lisp-directory): + Use (featurep 'xemacs). (gnus-gnus-lisp-directory, gnus-mailcrypt-lisp-directory) - (gnus-mailcrypt-lisp-directory, gnus-bbdb-lisp-directory): Remove - version numbers from file names. + (gnus-mailcrypt-lisp-directory, gnus-bbdb-lisp-directory): + Remove version numbers from file names. 2000-11-08 Dave Love <fx@gnu.org> @@ -17220,8 +17211,8 @@ * rfc2047.el (base64): Require unconditionally. (message-posting-charset): Defvar when compiling. - (rfc2047-encode-message-header, rfc2047-encodable-p): Require - message. + (rfc2047-encode-message-header, rfc2047-encodable-p): + Require message. * gnus-sum.el (nnoo): Require. (mm-uu-dissect): Autoload. @@ -17318,8 +17309,8 @@ 2000-10-09 Dave Love <fx@gnu.org> - * mail-source.el (mail-source-fetch-imap): Bind - default-enable-multibyte-characters rather than using + * mail-source.el (mail-source-fetch-imap): + Bind default-enable-multibyte-characters rather than using mm-disable-multibyte. 2000-10-05 Dave Love <fx@gnu.org> @@ -17356,8 +17347,8 @@ 2000-10-04 Dave Love <fx@gnu.org> - * smiley-ems.el (smiley-regexp-alist, smiley-update-cache): Use - pbm images. + * smiley-ems.el (smiley-regexp-alist, smiley-update-cache): + Use pbm images. * frown.pbm, smile.pbm, wry.pbm: New files. @@ -17452,7 +17443,7 @@ 2000-12-15 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> * pop3.el (pop3-movemail): Use binary. - (pop3-movemail-file-coding-system): Removed. + (pop3-movemail-file-coding-system): Remove. 2000-12-14 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -17512,8 +17503,8 @@ 2000-12-04 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * mail-source.el (mail-source-report-new-mail): Use - nnheader-run-at-time. + * mail-source.el (mail-source-report-new-mail): + Use nnheader-run-at-time. 2000-02-15 Andrew Innes <andrewi@gnu.org> @@ -17557,8 +17548,8 @@ 2000-12-01 Simon Josefsson <sj@extundo.com> - * mml-smime.el (mml-smime-verify): Don't modify MM buffer. Handle - more than one certificate inside PKCS#7 blob. Better security + * mml-smime.el (mml-smime-verify): Don't modify MM buffer. + Handle more than one certificate inside PKCS#7 blob. Better security information (clamed / actual sender, openssl output, certificates inside message). @@ -17567,8 +17558,8 @@ 2000-11-30 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-art.el (gnus-mime-security-button-line-format-alist): Add - ?d and ?D. + * gnus-art.el (gnus-mime-security-button-line-format-alist): + Add ?d and ?D. (gnus-mime-security-show-details-inline): New variable. (gnus-mime-security-show-details): Use them. (gnus-insert-mime-security-button): Ditto. @@ -17614,8 +17605,8 @@ 2000-11-22 Jan Nieuwenhuizen <janneke@gnu.org> - * nnmh.el (nnmh-request-expire-articles): Implemented - expiry-target for nnmh backend. + * nnmh.el (nnmh-request-expire-articles): + Implemented expiry-target for nnmh backend. 2000-11-30 Simon Josefsson <sj@extundo.com> @@ -17681,8 +17672,8 @@ 2000-11-22 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-xmas.el (gnus-xmas-article-display-xface): Use - insert-buffer-substring. + * gnus-xmas.el (gnus-xmas-article-display-xface): + Use insert-buffer-substring. * message.el (message-send-mail): Use buffer-substring-no-properties. (message-send-news): Ditto. @@ -17777,13 +17768,13 @@ * mml-sec.el (mml-sign-alist): Update names. (mml-encrypt-alist): Ditto. - (mml-secure-part-smime-sign): Moved to mml-smime.el + (mml-secure-part-smime-sign): Move to mml-smime.el as `mml-smime-sign-query'. - (mml-secure-part-smime-encrypt-by-file): Moved to mml-smime.el as + (mml-secure-part-smime-encrypt-by-file): Move to mml-smime.el as `mml-smime-get-file-cert'. - (mml-secure-part-smime-encrypt-by-dns): Moved to mml-smime.el as + (mml-secure-part-smime-encrypt-by-dns): Move to mml-smime.el as `mml-smime-get-dns-cert'. - (mml-secure-part-smime-encrypt): Moved to mml-smime.el as + (mml-secure-part-smime-encrypt): Move to mml-smime.el as `mml-smime-encrypt-query'. (mml-smime-sign-buffer): Use mml-smime-sign. (mml-smime-encrypt-buffer): Use mml-smime-encrypt. @@ -17793,7 +17784,7 @@ (mml-smime-sign-query): (mml-smime-get-file-cert): (mml-smime-get-dns-cert): - (mml-smime-encrypt-query): Moved from mml-sec.el. + (mml-smime-encrypt-query): Move from mml-sec.el. 2000-11-16 Simon Josefsson <sj@extundo.com> @@ -17802,8 +17793,8 @@ 2000-11-17 14:21 ShengHuo ZHU <zsh@cs.rochester.edu> - * message.el (message-setup-fill-variables): Use - message-cite-prefix-regexp. + * message.el (message-setup-fill-variables): + Use message-cite-prefix-regexp. (message-newline-and-reformat): Check the end of citation, leading WSP, break in the cite prefix. (message-fill-paragraph): New function. @@ -17844,8 +17835,8 @@ 2000-11-12 David Edmondson <dme@dme.org> - * message.el (message-font-lock-keywords): Use - message-cite-prefix-regexp. + * message.el (message-font-lock-keywords): + Use message-cite-prefix-regexp. 2000-11-15 Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> @@ -17939,15 +17930,15 @@ 2000-11-12 David Edmondson <dme@dme.org> - * message.el (message-cite-prefix-regexp): Moved from gnus-cite.el + * message.el (message-cite-prefix-regexp): Move from gnus-cite.el and replace `.' with `\w' to allow for different syntax tables (from Vladimir Volovich). - * message.el (message-newline-and-reformat): Use - `message-cite-prefix-regexp'. - * gnus-cite.el (gnus-supercite-regexp): Use - `message-cite-prefix-regexp'. - * gnus-cite.el (gnus-cite-parse): Use - `message-cite-prefix-regexp'. + * message.el (message-newline-and-reformat): + Use `message-cite-prefix-regexp'. + * gnus-cite.el (gnus-supercite-regexp): + Use `message-cite-prefix-regexp'. + * gnus-cite.el (gnus-cite-parse): + Use `message-cite-prefix-regexp'. 2000-11-12 08:52:46 ShengHuo ZHU <zsh@cs.rochester.edu> @@ -18124,8 +18115,8 @@ Verify S/MIME signature support. - * mm-decode.el (mm-inline-media-tests): Add - application/{x-,}pkcs7-signature. + * mm-decode.el (mm-inline-media-tests): + Add application/{x-,}pkcs7-signature. (mm-inlined-types): Ditto. (mm-automatic-display): Ditto. (mm-verify-function-alist): Ditto. Add name of method. @@ -18337,8 +18328,8 @@ * qp.el (quoted-printable-encode-region): Replace leading - when ultra safe. - * mml.el (mml-generate-mime-postprocess-function): Removed. - (mml-postprocess-alist): Removed. + * mml.el (mml-generate-mime-postprocess-function): Remove. + (mml-postprocess-alist): Remove. (mml-generate-mime-1): Use ultra-safe when sign. * mml2015.el (mml2015-fix-micalg): Uppercase. (mml2015-verify): Insert LF. @@ -18366,14 +18357,14 @@ 2000-10-30 08:17:46 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus.el (gnus-server-browse-hashtb): Removed. + * gnus.el (gnus-server-browse-hashtb): Remove. * gnus-group.el (gnus-group-prepare-flat-list-dead): Use gnus-active. (gnus-group-insert-group-line-info): Use simplified method. * gnus-srvr.el (gnus-browse-foreign-server): Use gnus-set-active. 2000-10-30 01:52:40 ShengHuo ZHU <zsh@cs.rochester.edu> - * gnus-util.el (gnus-union): Renamed from gnus-agent-union, and + * gnus-util.el (gnus-union): Rename from gnus-agent-union, and moved here. * gnus-agent.el (gnus-agent-fetch-headers): Use it. * gnus-group.el (gnus-group-prepare-flat): Use it. @@ -18450,9 +18441,9 @@ * mml-sec.el (mml-smime-encrypt-buffer): Support certfiles stored in buffers. - (mml-secure-dns-server): Removed. - (mml-secure-part-smime-encrypt-by-dns): Use DIG interface. Don't - write certificates to files. + (mml-secure-dns-server): Remove. + (mml-secure-part-smime-encrypt-by-dns): Use DIG interface. + Don't write certificates to files. * smime.el (smime-dns-server): New variable. (smime-mail-to-domain): diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index 3c6d96703c0..d502a3b3904 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -654,9 +654,11 @@ Use `auth-source-delete' in ELisp code instead of calling 'secrets are the only ones supported right now. :max N means to try to return at most N items (defaults to 1). -When 0 the function will return just t or nil to indicate if any -matches were found. More than N items may be returned, depending -on the search and the backend. +More than N items may be returned, depending on the search and +the backend. + +When :max is 0 the function will return just t or nil to indicate +if any matches were found. :host (X Y Z) means to match only hosts X, Y, or Z according to the match rules above. Defaults to t. @@ -757,18 +759,22 @@ must call it to obtain the actual value." (when auth-source-do-cache (auth-source-remember spec found))) - found)) + (if (zerop max) + (not (null found)) + found))) (defun auth-source-search-backends (backends spec max create delete require) - (let (matches) + (let ((max (if (zerop max) 1 max)) ; stop with 1 match if we're asked for zero + matches) (dolist (backend backends) - (when (> max (length matches)) ; when we need more matches... + (when (> max (length matches)) ; if we need more matches... (let* ((bmatches (apply (slot-value backend 'search-function) :backend backend :type (slot-value backend :type) ;; note we're overriding whatever the spec - ;; has for :require, :create, and :delete + ;; has for :max, :require, :create, and :delete + :max max :require require :create create :delete delete @@ -783,6 +789,7 @@ must call it to obtain the actual value." (setq matches (append matches bmatches)))))) matches)) +;; (auth-source-search :max 0) ;; (auth-source-search :max 1) ;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret)) ;; (auth-source-search :host "nonesuch" :type 'netrc :K 1) @@ -1524,10 +1531,10 @@ list, it matches the original pattern." (heads (if (stringp value) (list (list key value)) (mapcar (lambda (v) (list key v)) value)))) - (cl-loop + (loop for h in heads nconc - (cl-loop + (loop for tl in tails collect (append h tl)))))) @@ -1653,6 +1660,7 @@ authentication tokens: ;; (let ((auth-sources '("macos-keychain-internet:/Users/tzz/Library/Keychains/login.keychain"))) (auth-source-search :max 1)) ;; (let ((auth-sources '("macos-keychain-generic:Login"))) (auth-source-search :max 1 :host "git.gnus.org")) +;; (let ((auth-sources '("macos-keychain-generic:Login"))) (auth-source-search :max 1)) (defun* auth-source-macos-keychain-search (&rest spec diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index 1e77c2af4db..325623139fe 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -441,6 +441,39 @@ rather than relying on `lexical-binding'. `(,(progn (require 'cl) (if (fboundp 'cl-labels) 'cl-labels 'labels)) ,bindings ,@body)) (put 'gmm-labels 'lisp-indent-function 1) +(put 'gmm-labels 'edebug-form-spec '((&rest (sexp sexp &rest form)) &rest form)) + +(defun gmm-format-time-string (format-string &optional time tz) + "Use FORMAT-STRING to format the time TIME, or now if omitted. +The optional TZ specifies the time zone in a number of seconds; any +other non-nil value will be treated as 0. Note that both the format +specifiers `%Z' and `%z' will be replaced with a numeric form. " +;; FIXME: is there a smart way to replace %Z with a time zone name? + (if (and (numberp tz) (not (zerop tz))) + (let ((st 0) + (case-fold-search t) + ls nd rest) + (setq time (if time + (copy-sequence time) + (current-time))) + (if (>= (setq ls (- (cadr time) (car (current-time-zone)) (- tz))) 0) + (setcar (cdr time) ls) + (setcar (cdr time) (+ ls 65536)) + (setcar time (1- (car time)))) + (setq tz (format "%s%02d%02d" + (if (>= tz 0) "+" "-") + (/ (abs tz) 3600) + (/ (% (abs tz) 3600) 60))) + (while (string-match "%+z" format-string st) + (if (zerop (% (- (setq nd (match-end 0)) (match-beginning 0)) 2)) + (progn + (push (substring format-string st (- nd 2)) rest) + (push tz rest)) + (push (substring format-string st nd) rest)) + (setq st nd)) + (push (substring format-string st) rest) + (format-time-string (apply 'concat (nreverse rest)) time)) + (format-time-string format-string time tz))) (provide 'gmm-utils) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 7cc866b3ee5..557c6a3a4ab 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -24,9 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) (defvar tool-bar-map) @@ -256,7 +253,13 @@ This can also be a list of the above values." (regexp :value ".*")) :group 'gnus-article-signature) -(defcustom gnus-hidden-properties '(invisible t intangible t) +(defcustom gnus-hidden-properties + (if (featurep 'xemacs) + ;; `intangible' is evil, but I keep it here in case it's useful. + '(invisible t intangible t) + ;; Emacs's command loop moves point out of invisible text anyway, so + ;; `intangible' is clearly not needed there. + '(invisible t)) "Property list to use for hiding text." :type 'sexp :group 'gnus-article-hiding) @@ -1623,8 +1626,11 @@ It is a string, such as \"PGP\". If nil, ask user." :type 'string :group 'mime-security) +(defvar idna-program) + (defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error)) (mm-coding-system-p 'utf-8) + idna-program (executable-find idna-program)) "Whether IDNA decoding of headers is used when viewing messages. This requires GNU Libidn, and by default only enabled if it is found." @@ -1837,7 +1843,7 @@ Initialized from `text-mode-syntax-table.") (incf i))) i)) -(defun article-hide-headers (&optional arg delete) +(defun article-hide-headers (&optional _arg _delete) "Hide unwanted headers and possibly sort them as well." (interactive) ;; This function might be inhibited. @@ -2407,7 +2413,7 @@ long lines if and only if arg is positive." (if (and wash-face-p (memq 'face gnus-article-wash-types)) (gnus-delete-images 'face) (let ((from (message-fetch-field "from")) - face faces) + faces) (save-current-buffer (when (and wash-face-p (gnus-buffer-live-p gnus-original-article-buffer) @@ -2457,7 +2463,7 @@ long lines if and only if arg is positive." (gnus-delete-images 'xface) ;; Display X-Faces. (let ((from (message-fetch-field "from")) - x-faces face) + x-faces) (save-current-buffer (when (and wash-face-p (gnus-buffer-live-p gnus-original-article-buffer) @@ -2790,7 +2796,7 @@ summary buffer." "Find CID content in HANDLES and save it in a file in DIRECTORY. Return file name." (save-match-data - (let (file type) + (let (file) (catch 'found (dolist (handle handles) (cond @@ -3078,7 +3084,7 @@ images if any to the browser, and deletes them when exiting the group (gnus-summary-show-article))))) (defun article-hide-list-identifiers () - "Remove list identifies from the Subject header. + "Remove list identifiers from the Subject header. The `gnus-list-identifiers' variable specifies what to do." (interactive) (let ((inhibit-point-motion-hooks t) @@ -3392,7 +3398,7 @@ means show, 0 means toggle." 'hidden nil))) -(defun gnus-article-show-hidden-text (type &optional dummy) +(defun gnus-article-show-hidden-text (type &optional _dummy) "Show all hidden text of type TYPE. Originally it is hide instead of DUMMY." (let ((inhibit-read-only t) @@ -3431,7 +3437,7 @@ lines forward." gnus-article-date-headers) t)) -(defun article-date-ut (&optional type highlight date-position) +(defun article-date-ut (&optional type _highlight date-position) "Convert DATE date to TYPE in the current article. The default type is `ut'. See `gnus-article-date-headers' for possible values." @@ -3439,7 +3445,6 @@ possible values." (let* ((case-fold-search t) (inhibit-read-only t) (inhibit-point-motion-hooks t) - (first t) (visible-date (mail-fetch-field "Date")) pos date bface eface) (save-excursion @@ -3978,7 +3983,7 @@ This format is defined by the `gnus-article-time-format' variable." (set dir-var (file-name-directory result))) result)) -(defun gnus-article-archive-name (group) +(defun gnus-article-archive-name (_group) "Return the first instance of an \"Archive-name\" in the current buffer." (let ((case-fold-search t)) (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t) @@ -4210,7 +4215,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is default (or last-file default)))) -(defun gnus-plain-save-name (newsgroup headers &optional last-file) +(defun gnus-plain-save-name (newsgroup _headers &optional last-file) "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. If variable `gnus-use-long-file-name' is non-nil, it is ~/News/news.group. Otherwise, it is like ~/News/news/group/news." @@ -4223,7 +4228,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is default-directory)) gnus-article-save-directory))) -(defun gnus-sender-save-name (newsgroup headers &optional last-file) +(defun gnus-sender-save-name (_newsgroup headers &optional _last-file) "Generate file name from sender." (let ((from (mail-header-from headers))) (expand-file-name @@ -4420,6 +4425,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is (substitute-key-definition 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map) +(defvar gnus-article-send-map) + (gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map) "W" gnus-article-wide-reply-with-original) (if (featurep 'xemacs) @@ -4603,18 +4610,19 @@ commands: (forward-line line) (point))))))) -(defun gnus-article-prepare (article &optional all-headers header) +(defvar gnus-tmp-internal-hook) + +(defun gnus-article-prepare (article &optional all-headers _header) "Prepare ARTICLE in article mode buffer. ARTICLE should either be an article number or a Message-ID. If ARTICLE is an id, HEADER should be the article headers. If ALL-HEADERS is non-nil, no headers are hidden." - (save-excursion + (save-excursion ;FIXME: Shouldn't that be save-current-buffer? ;; Make sure we start in a summary buffer. (unless (derived-mode-p 'gnus-summary-mode) (set-buffer gnus-summary-buffer)) (setq gnus-summary-buffer (current-buffer)) - (let* ((gnus-article (if header (mail-header-number header) article)) - (summary-buffer (current-buffer)) + (let* ((summary-buffer (current-buffer)) (gnus-tmp-internal-hook gnus-article-internal-prepare-hook) (group gnus-newsgroup-name) result) @@ -4713,6 +4721,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-run-hooks 'gnus-article-prepare-hook) t)))))) +(defvar gnus-mime-display-attachment-buttons-in-header) + ;;;###autoload (defun gnus-article-prepare-display () "Make the current buffer look like a nice article." @@ -4728,7 +4738,10 @@ If ALL-HEADERS is non-nil, no headers are hidden." gnus-article-image-alist nil) (gnus-run-hooks 'gnus-tmp-internal-hook) (when gnus-display-mime-function - (funcall gnus-display-mime-function)))) + (funcall gnus-display-mime-function)) + ;; Add attachment buttons to the header. + (when gnus-mime-display-attachment-buttons-in-header + (gnus-mime-buttonize-attachments-in-header)))) ;;; ;;; Gnus Sticky Article Mode @@ -4833,6 +4846,16 @@ Valid specifiers include: General format specifiers can also be used. See Info node `(gnus)Formatting Variables'.") +(defvar gnus-tmp-type) +(defvar gnus-tmp-type-long) +(defvar gnus-tmp-name) +(defvar gnus-tmp-description) +(defvar gnus-tmp-id) +(defvar gnus-tmp-length) +(defvar gnus-tmp-dots) +(defvar gnus-tmp-info) +(defvar gnus-tmp-pressed-details) + (defvar gnus-mime-button-line-format-alist '((?t gnus-tmp-type ?s) (?T gnus-tmp-type-long ?s) @@ -4987,7 +5010,6 @@ and `gnus-mime-delete-part', and not provided at run-time normally." (gnus-article-edit-article `(lambda () (buffer-disable-undo) - (erase-buffer) (let ((mail-parse-charset (or gnus-article-charset ',gnus-newsgroup-charset)) (mail-parse-ignored-charsets @@ -4995,7 +5017,14 @@ and `gnus-mime-delete-part', and not provided at run-time normally." ',gnus-newsgroup-ignored-charsets)) (mbl mml-buffer-list)) (setq mml-buffer-list nil) - (insert-buffer-substring gnus-original-article-buffer) + ;; A new text must be inserted before deleting existing ones + ;; at the end so as not to move existing markers of which + ;; the insertion type is t. + (delete-region + (point-min) + (prog1 + (goto-char (point-max)) + (insert-buffer-substring gnus-original-article-buffer))) (mime-to-mml ',handles) (setq gnus-article-mime-handles nil) (let ((mbl1 mml-buffer-list)) @@ -5053,7 +5082,6 @@ If FILE is given, use it for the external part." The current article has a complicated MIME structure, giving up...")) (let* ((data (get-text-property (point) 'gnus-data)) (id (get-text-property (point) 'gnus-part)) - param (handles gnus-article-mime-handles)) (unless file (setq file @@ -5300,40 +5328,77 @@ are decompressed." Compressed files like .gz and .bz2 are decompressed." (interactive (list nil current-prefix-arg)) (gnus-article-check-buffer) - (unless handle - (setq handle (get-text-property (point) 'gnus-data))) - (when handle - (let ((b (point)) - (inhibit-read-only t) - contents charset coding-system) + (let* ((inhibit-read-only t) + (b (point)) + (btn ;; position where the MIME button exists + (if handle + (if (eq handle (get-text-property b 'gnus-data)) + b + (article-goto-body) + (or (text-property-any (point) (point-max) 'gnus-data handle) + (text-property-any (point-min) (point) 'gnus-data handle))) + (setq handle (get-text-property b 'gnus-data)) + b)) + start) + (when handle + (when (= b (prog1 + btn + (setq start (next-single-property-change btn 'gnus-data + nil (point-max)) + btn (previous-single-property-change start + 'gnus-data)))) + (setq b btn)) (if (and (not arg) (mm-handle-undisplayer handle)) (mm-remove-part handle) - (mm-with-unibyte-buffer - (mm-insert-part handle) - (setq contents - (or (mm-decompress-buffer (mm-handle-filename handle) nil t) - (buffer-string)))) (cond - ((not arg) - (unless (setq charset (mail-content-type-get - (mm-handle-type handle) 'charset)) - (unless (setq coding-system - (mm-with-unibyte-buffer - (insert contents) - (mm-find-buffer-file-coding-system))) - (setq charset gnus-newsgroup-charset)))) + ((not arg) nil) ((numberp arg) (if (mm-handle-undisplayer handle) - (mm-remove-part handle)) - (setq charset - (or (cdr (assq arg - gnus-summary-show-article-charset-alist)) - (mm-read-coding-system "Charset: ")))) + (mm-remove-part handle))) ((mm-handle-undisplayer handle) (mm-remove-part handle))) - (forward-line 2) - (mm-display-inline handle) - (goto-char b))))) + (goto-char start) + (unless (bolp) + ;; This is a header button. + (forward-line 1)) + (mm-display-inline handle)) + ;; Toggle the button appearance between `[button]...' and `[button]'. + (goto-char btn) + (let ((displayed-p (mm-handle-displayed-p handle))) + (gnus-insert-mime-button handle (get-text-property btn 'gnus-part) + (list displayed-p)) + (if (featurep 'emacs) + (delete-region + (point) + (next-single-property-change (point) 'gnus-data nil (point-max))) + (let* ((end (next-single-property-change (point) 'gnus-data)) + (annots (annotations-at (or end (point-max))))) + (delete-region (point) + (if end + (if annots (1+ end) end) + (point-max))) + (dolist (annot annots) + (set-extent-endpoints annot (point) (point))))) + (setq start (point)) + (if (search-backward "\n\n" nil t) + (progn + (goto-char start) + (unless (or displayed-p (eolp)) + ;; Add extra newline. + (insert (propertize (buffer-substring (1- start) start) + 'gnus-undeletable t)))) + ;; We're in the article header. + (delete-char -1) + (dolist (ovl (gnus-overlays-in btn (point))) + (gnus-overlay-put ovl 'gnus-button-attachment-extra t) + (gnus-overlay-put ovl 'face nil)) + (save-restriction + (message-narrow-to-field) + (let ((gnus-treatment-function-alist + '((gnus-treat-highlight-headers + gnus-article-highlight-headers)))) + (gnus-treat-article 'head))))) + (goto-char b)))) (defun gnus-mime-set-charset-parameters (handle charset) "Set CHARSET to parameters in HANDLE. @@ -5399,7 +5464,6 @@ specified charset." (interactive) (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) - (mm-user-display-methods nil) (mm-inlined-types nil) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets @@ -5635,54 +5699,106 @@ all parts." "Display HANDLE and fix MIME button." (let ((id (get-text-property (point) 'gnus-part)) (point (point)) - (inhibit-read-only t)) - (forward-line 1) - (prog1 - (let ((window (selected-window)) - (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets - (if (gnus-buffer-live-p gnus-summary-buffer) - (with-current-buffer gnus-summary-buffer - gnus-newsgroup-ignored-charsets) - nil))) - (save-excursion - (unwind-protect - (let ((win (gnus-get-buffer-window (current-buffer) t)) - (beg (point))) - (when win - (select-window win)) - (goto-char point) - (forward-line) - (if (mm-handle-displayed-p handle) - ;; This will remove the part. - (mm-display-part handle) - (save-restriction - (narrow-to-region (point) - (if (eobp) (point) (1+ (point)))) - (gnus-bind-safe-url-regexp (mm-display-part handle)) - ;; We narrow to the part itself and - ;; then call the treatment functions. - (goto-char (point-min)) - (forward-line 1) - (narrow-to-region (point) (point-max)) - (gnus-treat-article - nil id - (gnus-article-mime-total-parts) - (mm-handle-media-type handle))))) - (if (window-live-p window) - (select-window window))))) + (inhibit-read-only t) + (window (selected-window)) + (mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets + (if (gnus-buffer-live-p gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets) + nil)) + start retval) + (unwind-protect + (progn + (let ((win (gnus-get-buffer-window (current-buffer) t))) + (when win + (select-window win) + (goto-char point))) + (setq start (next-single-property-change point 'gnus-data + nil (point-max)) + point (previous-single-property-change start 'gnus-data)) + (if (mm-handle-displayed-p handle) + ;; This will remove the part. + (setq retval (mm-display-part handle)) + (let ((part (or (and (mm-inlinable-p handle) + (mm-inlined-p handle) + t) + (with-temp-buffer + (gnus-bind-safe-url-regexp + (setq retval (mm-display-part handle))) + (unless (zerop (buffer-size)) + (buffer-string)))))) + (goto-char start) + (unless (bolp) + ;; This is a header button. + (forward-line 1)) + (cond ((stringp part) + (save-restriction + (narrow-to-region (point) + (progn + (insert part) + (unless (bolp) (insert "\n")) + (point))) + (gnus-treat-article nil id + (gnus-article-mime-total-parts) + (mm-handle-media-type handle)) + (mm-handle-set-undisplayer + handle + `(lambda () + (let ((inhibit-read-only t)) + (delete-region ,(copy-marker (point-min) t) + ,(point-max-marker))))))) + (part + (mm-display-inline handle)))))) (goto-char point) - (gnus-delete-line) - (gnus-insert-mime-button - handle id (list (mm-handle-displayed-p handle))) - (goto-char point)))) + ;; Toggle the button appearance between `[button]...' and `[button]'. + (let ((displayed-p (mm-handle-displayed-p handle))) + (gnus-insert-mime-button handle id (list displayed-p)) + (if (featurep 'emacs) + (delete-region + (point) + (next-single-property-change (point) 'gnus-data nil (point-max))) + (let* ((end (next-single-property-change (point) 'gnus-data)) + (annots (annotations-at (or end (point-max))))) + (delete-region (point) + (if end + (if annots (1+ end) end) + (point-max))) + (dolist (annot annots) + (set-extent-endpoints annot (point) (point))))) + (setq start (point)) + (if (search-backward "\n\n" nil t) + (progn + (goto-char start) + (unless (or displayed-p (eolp)) + ;; Add extra newline. + (insert (propertize (buffer-substring (1- start) start) + 'gnus-undeletable t)))) + ;; We're in the article header. + (delete-char -1) + (dolist (ovl (gnus-overlays-in point (point))) + (gnus-overlay-put ovl 'gnus-button-attachment-extra t) + (gnus-overlay-put ovl 'face nil)) + (save-restriction + (message-narrow-to-field) + (let ((gnus-treatment-function-alist + '((gnus-treat-highlight-headers + gnus-article-highlight-headers)))) + (gnus-treat-article 'head))))) + (goto-char point) + (if (window-live-p window) + (select-window window))) + retval)) (defun gnus-article-goto-part (n) "Go to MIME part N." (when gnus-break-pages (widen)) + (article-goto-body) (prog1 - (let ((start (text-property-any (point-min) (point-max) 'gnus-part n)) + (let ((start (or (text-property-any (point) (point-max) 'gnus-part n) + ;; There may be header buttons. + (text-property-any (point-min) (point) 'gnus-part n))) part handle end next handles) (when start (goto-char start) @@ -5715,11 +5831,12 @@ all parts." (when gnus-break-pages (gnus-narrow-to-page)))) -(defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) +(defun gnus-insert-mime-button (handle id &optional displayed) (let ((gnus-tmp-name (or (mm-handle-filename handle) (mail-content-type-get (mm-handle-type handle) 'url) "")) + (gnus-tmp-id id) (gnus-tmp-type (mm-handle-media-type handle)) (gnus-tmp-description (or (mm-handle-description handle) "")) (gnus-tmp-dots @@ -5736,8 +5853,6 @@ all parts." (concat "; " gnus-tmp-name)))) (unless (equal gnus-tmp-description "") (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long))) - (unless (bolp) - (insert "\n")) (setq b (point)) (gnus-eval-format gnus-mime-button-line-format gnus-mime-button-line-format-alist @@ -5772,7 +5887,7 @@ all parts." "hide" "show") (aref gnus-down-mouse-3 0)))))) -(defun gnus-widget-press-button (elems el) +(defun gnus-widget-press-button (elems _el) (goto-char (widget-get elems :from)) (gnus-article-press-button)) @@ -5790,8 +5905,7 @@ all parts." ;; may change the point. So we set the window point. (set-window-point window point))) (let ((handles ihandles) - (inhibit-read-only t) - handle) + (inhibit-read-only t)) (cond (handles) ((setq handles (mm-dissect-buffer nil gnus-article-loose-mime)) (when gnus-article-emulate-mime @@ -5862,6 +5976,16 @@ If displaying \"text/html\" is discouraged \(see :group 'gnus-article-mime :type 'boolean) +(defcustom gnus-mime-display-attachment-buttons-in-header t + "Add attachment buttons in the end of the header of an article. +Since MIME attachments tend to be put at the end of an article, we may +overlook them if there is a huge body. This option offers you a copy +of all non-inlinable MIME parts as buttons shown in front of an article. +If nil, don't show those extra buttons." + :version "25.1" + :group 'gnus-article-mime + :type 'boolean) + (defun gnus-mime-display-part (handle) (cond ;; Maybe a broken MIME message. @@ -5884,14 +6008,6 @@ If displaying \"text/html\" is discouraged \(see ((and (equal (car handle) "multipart/related") (not (or gnus-mime-display-multipart-as-mixed gnus-mime-display-multipart-related-as-mixed))) - ;;;!!!We should find the start part, but we just default - ;;;!!!to the first part. - ;;(gnus-mime-display-part (cadr handle)) - ;;;!!! Most multipart/related is an HTML message plus images. - ;;;!!! Unfortunately we are unable to let W3 display those - ;;;!!! included images, so we just display it as a mixed multipart. - ;;(gnus-mime-display-mixed (cdr handle)) - ;;;!!! No, w3 can display everything just fine. (gnus-mime-display-part (cadr handle))) ((equal (car handle) "multipart/signed") (gnus-add-wash-type 'signed) @@ -5915,7 +6031,6 @@ If displaying \"text/html\" is discouraged \(see (let ((type (mm-handle-media-type handle)) (ignored gnus-ignored-mime-types) (not-attachment t) - (move nil) display text) (catch 'ignored (progn @@ -5941,9 +6056,11 @@ If displaying \"text/html\" is discouraged \(see (setq display t) (when (equal (mm-handle-media-supertype handle) "text") (setq text t))) - (let ((id (1+ (length gnus-article-mime-handle-alist))) + (let ((id (car (rassq handle gnus-article-mime-handle-alist))) beg) - (push (cons id handle) gnus-article-mime-handle-alist) + (unless id + (setq id (1+ (length gnus-article-mime-handle-alist))) + (push (cons id handle) gnus-article-mime-handle-alist)) (when (and display (equal (mm-handle-media-supertype handle) "message")) (insert-char @@ -5955,31 +6072,28 @@ If displaying \"text/html\" is discouraged \(see (not (gnus-unbuttonized-mime-type-p type)) (eq id gnus-mime-buttonized-part-id)) (gnus-insert-mime-button - handle id (list (or display (and not-attachment text)))) - (gnus-article-insert-newline) - ;; Remember modify the number of forward lines. - (setq move t)) + handle id (list (or display (and not-attachment text))))) (setq beg (point)) (cond (display - (when move - (forward-line -1) - (setq beg (point))) (let ((mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets (save-excursion (condition-case () (set-buffer gnus-summary-buffer) (error)) gnus-newsgroup-ignored-charsets))) - (gnus-bind-safe-url-regexp (mm-display-part handle t))) - (goto-char (point-max))) + (gnus-bind-safe-url-regexp (mm-display-part handle t)))) ((and text not-attachment) - (when move - (forward-line -1) - (setq beg (point))) - (gnus-article-insert-newline) - (mm-display-inline handle) - (goto-char (point-max)))) + (mm-display-inline handle))) + (goto-char (point-max)) + (if (string-match "\\`image/" type) + (gnus-article-insert-newline) + (if (prog1 + (= (skip-chars-backward "\n") -1) + (forward-char 1)) + (gnus-article-insert-newline) + (put-text-property (point) (point-max) 'gnus-undeletable t)) + (goto-char (point-max))) ;; Do highlighting. (save-excursion (save-restriction @@ -6023,7 +6137,7 @@ If displaying \"text/html\" is discouraged \(see (let* ((preferred (or preferred (mm-preferred-alternative handles))) (ihandles handles) (point (point)) - handle (inhibit-read-only t) from props begend not-pref) + handle (inhibit-read-only t) from begend not-pref) (save-window-excursion (save-restriction (when ibegend @@ -6110,7 +6224,10 @@ If displaying \"text/html\" is discouraged \(see (goto-char (point-max)) (setcdr begend (point-marker))))) (when ibegend - (goto-char point)))) + (goto-char point))) + ;; Redraw attachment buttons in the header. + (when gnus-mime-display-attachment-buttons-in-header + (gnus-mime-buttonize-attachments-in-header))) (defconst gnus-article-wash-status-strings (let ((alist '((cite "c" "Possible hidden citation text" @@ -6216,6 +6333,112 @@ Provided for backwards compatibility." (when image (gnus-add-image 'shr image)))) +(defun gnus-article-mime-handles (&optional alist id all) + (if alist + (let ((i 1) newid flat) + (dolist (handle alist flat) + (setq newid (append id (list i)) + i (1+ i)) + (if (stringp (car handle)) + (setq flat (nconc flat (gnus-article-mime-handles + (cdr handle) newid all))) + (delq (rassq handle all) all) + (setq flat (nconc flat (list (cons newid handle))))))) + (let ((flat (list nil))) + ;; Assume that elements of `gnus-article-mime-handle-alist' + ;; are in the decreasing order, but unnumbered subsidiaries + ;; in each element are in the increasing order. + (dolist (handle (reverse gnus-article-mime-handle-alist)) + (if (stringp (cadr handle)) + (setq flat (nconc flat (gnus-article-mime-handles + (cddr handle) (list (car handle)) flat))) + (delq (rassq (cdr handle) flat) flat) + (setq flat (nconc flat (list (cons (list (car handle)) + (cdr handle))))))) + (setq flat (cdr flat)) + (mapc (lambda (handle) + (if (cdar handle) + ;; This is a hidden (i.e. unnumbered) handle. + (progn + (setcar handle + (1+ (caar gnus-article-mime-handle-alist))) + (push handle gnus-article-mime-handle-alist)) + (setcar handle (caar handle)))) + flat) + flat))) + +(defun gnus-mime-buttonize-attachments-in-header (&optional interactive) + "Show attachments as buttons in the end of the header of an article. +This function toggles the display when called interactively. Note that +buttons to be added to the header are only the ones that aren't inlined +in the body. Use `gnus-header-face-alist' to highlight buttons." + (interactive (list t)) + (gnus-with-article-buffer + (let ((case-fold-search t) buttons handle type st) + (save-excursion + (save-restriction + (widen) + (article-narrow-to-head) + ;; Header buttons exist? + (while (and (not buttons) + (re-search-forward "^attachments?:[\n ]+" nil t)) + (when (get-char-property (match-end 0) + 'gnus-button-attachment-extra) + (setq buttons (match-beginning 0)))) + (widen) + (when buttons + ;; Delete header buttons. + (delete-region buttons (if (re-search-forward "^[^ ]" nil t) + (match-beginning 0) + (point-max)))) + (unless (and interactive buttons) + ;; Find buttons. + (setq buttons nil) + (dolist (button (gnus-article-mime-handles)) + (setq handle (cdr button) + type (mm-handle-media-type handle)) + (when (or (and (if (gnus-buffer-live-p gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + gnus-inhibit-images) + gnus-inhibit-images) + (string-match "\\`image/" type)) + (mm-inline-override-p handle) + (and (mm-handle-disposition handle) + (not (equal (car (mm-handle-disposition handle)) + "inline")) + (not (mm-attachment-override-p handle))) + (not (mm-automatic-display-p handle)) + (not (or (and (mm-inlinable-p handle) + (mm-inlined-p handle)) + (mm-automatic-external-display-p type)))) + (push button buttons))) + (when buttons + ;; Add header buttons. + (article-goto-body) + (forward-line -1) + (narrow-to-region (point) (point)) + (insert "Attachment" (if (cdr buttons) "s" "") ":") + (dolist (button (nreverse buttons)) + (setq st (point)) + (insert " ") + (mm-handle-set-undisplayer + (setq handle (copy-sequence (cdr button))) nil) + (gnus-insert-mime-button handle (car button)) + (skip-chars-backward "\t\n ") + (delete-region (point) (point-max)) + (when (> (current-column) (window-width)) + (goto-char st) + (insert "\n") + (end-of-line))) + (insert "\n") + (dolist (ovl (gnus-overlays-in (point-min) (point))) + (gnus-overlay-put ovl 'gnus-button-attachment-extra t) + (gnus-overlay-put ovl 'face nil)) + (let ((gnus-treatment-function-alist + '((gnus-treat-highlight-headers + gnus-article-highlight-headers)))) + (gnus-treat-article 'head))))))))) + ;;; Article savers. (defun gnus-output-to-file (file-name) @@ -6401,6 +6624,8 @@ specifies." (if header-line-format 1 0) 2))))))) +(defvar scroll-in-place) + (defun gnus-article-next-page-1 (lines) (condition-case () (let ((scroll-in-place nil) @@ -6488,7 +6713,9 @@ not have a face in `gnus-article-boring-faces'." (unless (derived-mode-p 'gnus-article-mode) (error "Command invoked outside of a Gnus article buffer"))) -(defun gnus-article-read-summary-keys (&optional arg key not-restore-window) +(defvar gnus-pick-mode) + +(defun gnus-article-read-summary-keys (&optional _arg key not-restore-window) "Read a summary buffer key sequence and execute it from the article buffer." (interactive "P") (gnus-article-check-buffer) @@ -6501,8 +6728,6 @@ not have a face in `gnus-article-boring-faces'." "An" "Ap" [?A (meta return)] [?A delete])) (nosave-in-article '("AS" "\C-d")) - (up-to-top - '("n" "Gn" "p" "Gp")) keys new-sum-point) (with-current-buffer gnus-article-current-summary (let (gnus-pick-mode) @@ -6584,7 +6809,7 @@ not have a face in `gnus-article-boring-faces'." (when (eq obuf (current-buffer)) (set-buffer in-buffer) t)) - (setq selected (gnus-summary-select-article)) + (setq selected (ignore-errors (gnus-summary-select-article))) (set-buffer obuf) (unless not-restore-window (set-window-configuration owin)) @@ -6661,6 +6886,7 @@ KEY is a string or a vector." (defvar gnus-agent-summary-mode) (defvar gnus-draft-mode) (defvar help-xref-stack-item) +(defvar help-xref-following) (defun gnus-article-describe-bindings (&optional prefix) "Show a list of all defined keys, and their definitions. @@ -7105,7 +7331,6 @@ groups." (let ((func gnus-article-edit-done-function) (buf (current-buffer)) (start (window-start)) - (p (point)) (winconf gnus-prev-winconf)) (widen) ;; Widen it in case that users narrowed the buffer. (funcall func arg) @@ -7734,7 +7959,7 @@ do the highlighting. See the documentation for those functions." (gnus-article-add-buttons) (gnus-article-add-buttons-to-head)) -(defun gnus-article-highlight-some (&optional force) +(defun gnus-article-highlight-some (&optional _force) "Highlight current article. This function calls `gnus-article-highlight-headers', `gnus-article-highlight-signature', and `gnus-article-add-buttons' to @@ -8037,9 +8262,11 @@ url is put as the `gnus-button-url' overlay property on the button." (error "Unknown news URL syntax")))) (list scheme server port group message-id articles))) +(defvar nntp-port-number) + (defun gnus-button-handle-news (url) "Fetch a news URL." - (destructuring-bind (scheme server port group message-id articles) + (destructuring-bind (_scheme server port group message-id _articles) (gnus-parse-news-url url) (cond (message-id @@ -8161,7 +8388,7 @@ url is put as the `gnus-button-url' overlay property on the button." (with-current-buffer gnus-summary-buffer (gnus-summary-refer-article message-id))) -(defun gnus-button-fetch-group (address &rest ignore) +(defun gnus-button-fetch-group (address &rest _ignore) "Fetch GROUP specified by ADDRESS." (when (string-match "\\`\\(nntp\\|news\\):\\(//\\)?\\(.*\\)\\'" address) @@ -8209,15 +8436,15 @@ url is put as the `gnus-button-url' overlay property on the button." (setq url (replace-regexp-in-string "\n" " " url)) (when (string-match "mailto:/*\\(.*\\)" url) (setq url (substring url (match-beginning 1) nil))) - (let (to args subject func) - (setq args (gnus-url-parse-query-string + (let* ((args (gnus-url-parse-query-string (if (string-match "^\\?" url) (substring url 1) (if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url) (concat "to=" (match-string 1 url) "&" (match-string 2 url)) - (concat "to=" url)))) - subject (cdr-safe (assoc "subject" args))) + (concat "to=" url))))) + (subject (cdr-safe (assoc "subject" args))) + func) (gnus-msg-mail) (while args (setq func (intern-soft (concat "message-goto-" (downcase (caar args))))) @@ -8274,7 +8501,7 @@ url is put as the `gnus-button-url' overlay property on the button." :action 'gnus-button-prev-page :button-keymap gnus-prev-page-map))) -(defun gnus-button-next-page (&optional args more-args) +(defun gnus-button-next-page (&optional _args _more-args) "Go to the next page." (interactive) (let ((win (selected-window))) @@ -8282,7 +8509,7 @@ url is put as the `gnus-button-url' overlay property on the button." (gnus-article-next-page) (select-window win))) -(defun gnus-button-prev-page (&optional args more-args) +(defun gnus-button-prev-page (&optional _args _more-args) "Go to the prev page." (interactive) (let ((win (selected-window))) @@ -8310,7 +8537,7 @@ url is put as the `gnus-button-url' overlay property on the button." :action 'gnus-button-next-page :button-keymap gnus-next-page-map))) -(defun gnus-article-button-next-page (arg) +(defun gnus-article-button-next-page (_arg) "Go to the next page." (interactive "P") (let ((win (selected-window))) @@ -8318,7 +8545,7 @@ url is put as the `gnus-button-url' overlay property on the button." (gnus-article-next-page) (select-window win))) -(defun gnus-article-button-prev-page (arg) +(defun gnus-article-button-prev-page (_arg) "Go to the prev page." (interactive "P") (let ((win (selected-window))) @@ -8369,20 +8596,31 @@ For example: (defvar gnus-inhibit-article-treatments nil) -(defun gnus-treat-article (gnus-treat-condition - &optional part-number total-parts gnus-treat-type) - (let ((gnus-treat-length (- (point-max) (point-min))) +;; Dynamic variables. +(defvar part-number) ;FIXME: Lacks a "gnus-" prefix. +(defvar total-parts) ;FIXME: Lacks a "gnus-" prefix. +(defvar gnus-treat-type) +(defvar gnus-treat-condition) +(defvar gnus-treat-length) + +(defun gnus-treat-article (condition + &optional part-num total type) + (let ((gnus-treat-condition condition) + (part-number part-num) + (total-parts total) + (gnus-treat-type type) + (gnus-treat-length (- (point-max) (point-min))) (alist gnus-treatment-function-alist) (article-goto-body-goes-to-point-min-p t) (treated-type - (or (not gnus-treat-type) + (or (not type) (catch 'found (let ((list gnus-article-treat-types)) (while list - (when (string-match (pop list) gnus-treat-type) + (when (string-match (pop list) type) (throw 'found t))))))) (highlightp (gnus-visual-p 'article-highlight 'highlight)) - val elem) + val) (gnus-run-hooks 'gnus-part-display-hook) (dolist (elem alist) (setq val @@ -8400,13 +8638,6 @@ For example: (save-restriction (funcall (cadr elem))))))) -;; Dynamic variables. -(defvar part-number) -(defvar total-parts) -(defvar gnus-treat-type) -(defvar gnus-treat-condition) -(defvar gnus-treat-length) - (defun gnus-treat-predicate (val) (cond ((null val) @@ -8655,7 +8886,7 @@ For example: (gnus-mime-security-show-details handle) (gnus-mime-security-verify-or-decrypt handle)))) -(defun gnus-insert-mime-security-button (handle &optional displayed) +(defun gnus-insert-mime-security-button (handle &optional _displayed) (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol)) (gnus-tmp-type (concat @@ -8703,7 +8934,7 @@ For example: :action 'gnus-widget-press-button :button-keymap gnus-mime-security-button-map :help-echo - (lambda (widget) + (lambda (_widget) ;; Needed to properly clear the message due to a bug in ;; wid-edit (XEmacs only). (when (boundp 'help-echo-owns-message) diff --git a/lisp/gnus/gnus-bcklg.el b/lisp/gnus/gnus-bcklg.el index b26f367a79b..e0c457a8829 100644 --- a/lisp/gnus/gnus-bcklg.el +++ b/lisp/gnus/gnus-bcklg.el @@ -61,7 +61,7 @@ (defun gnus-backlog-enter-article (group number buffer) (when (and (numberp number) - (not (string-match "^nnvirtual" group))) + (not (gnus-virtual-group-p group))) (gnus-backlog-setup) (let ((ident (intern (concat group ":" (int-to-string number)) gnus-backlog-hashtb)) @@ -126,7 +126,7 @@ (defun gnus-backlog-request-article (group number &optional buffer) (when (and (numberp number) - (not (string-match "^nnvirtual" group))) + (not (gnus-virtual-group-p group))) (gnus-backlog-setup) (let ((ident (intern (concat group ":" (int-to-string number)) gnus-backlog-hashtb)) diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index b9426906e2c..e26c78b65c5 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -251,7 +251,7 @@ So the cdr of each bookmark is an alist too.") (interactive) (save-excursion (save-window-excursion - ;; Avoir warnings? + ;; Avoid warnings? ;; (message "Saving Gnus bookmarks to file %s..." gnus-bookmark-default-file) (set-buffer (get-buffer-create " *Gnus bookmarks*")) (erase-buffer) diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index 54798a892e0..2e8b2dbbe9f 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -24,10 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'gnus) diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index 790a17e10eb..d8ee35d3e97 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -1204,7 +1204,8 @@ When enabled, it automatically turns on `font-lock-mode'." nil ;; init-value "" ;; lighter nil ;; keymap - (when (eq major-mode 'message-mode) + (when (eq major-mode 'message-mode) ;FIXME: Use derived-mode-p. + ;; FIXME: Use font-lock-add-keywords! (let ((defaults (car (if (featurep 'xemacs) (get 'message-mode 'font-lock-defaults) font-lock-defaults))) @@ -1233,8 +1234,10 @@ When enabled, it automatically turns on `font-lock-mode'." font-lock-keywords nil)) (setq font-lock-set-defaults nil)) (font-lock-set-defaults) - (cond ((symbol-value 'font-lock-mode) - (font-lock-fontify-buffer)) + (cond (font-lock-mode + (if (fboundp 'font-lock-flush) + (font-lock-flush) + (font-lock-fontify-buffer))) (gnus-message-citation-mode (font-lock-mode 1))))) diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el new file mode 100644 index 00000000000..f965f989b71 --- /dev/null +++ b/lisp/gnus/gnus-cloud.el @@ -0,0 +1,343 @@ +;;; gnus-cloud.el --- storing and retrieving data via IMAP + +;; Copyright (C) 2014-2015 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> +;; Keywords: mail + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'parse-time) +(require 'nnimap) + +(defgroup gnus-cloud nil + "Syncing Gnus data via IMAP." + :version "25.1" + :group 'gnus) + +(defcustom gnus-cloud-synced-files + '(;;"~/.authinfo" + "~/.authinfo.gpg" + "~/.gnus.el" + (:directory "~/News" :match ".*.SCORE\\'")) + "List of file regexps that should be kept up-to-date via the cloud." + :group 'gnus-cloud + ;; FIXME this type does not match the default. Nor does the documentation. + :type '(repeat regexp)) + +(defvar gnus-cloud-group-name "*Emacs Cloud*") +(defvar gnus-cloud-covered-servers nil) + +(defvar gnus-cloud-version 1) +(defvar gnus-cloud-sequence 1) + +(defvar gnus-cloud-method nil + "The IMAP select method used to store the cloud data.") + +(defun gnus-cloud-make-chunk (elems) + (with-temp-buffer + (insert (format "Version %s\n" gnus-cloud-version)) + (insert (gnus-cloud-insert-data elems)) + (buffer-string))) + +(defun gnus-cloud-insert-data (elems) + (mm-with-unibyte-buffer + (dolist (elem elems) + (cond + ((eq (plist-get elem :type) :file) + (let (length data) + (mm-with-unibyte-buffer + (insert-file-contents-literally (plist-get elem :file-name)) + (setq length (buffer-size) + data (buffer-string))) + (insert (format "(:type :file :file-name %S :timestamp %S :length %d)\n" + (plist-get elem :file-name) + (plist-get elem :timestamp) + length)) + (insert data) + (insert "\n"))) + ((eq (plist-get elem :type) :data) + (insert (format "(:type :data :name %S :length %d)\n" + (plist-get elem :name) + (with-current-buffer (plist-get elem :buffer) + (buffer-size)))) + (insert-buffer-substring (plist-get elem :buffer)) + (insert "\n")) + ((eq (plist-get elem :type) :delete) + (insert (format "(:type :delete :file-name %S)\n" + (plist-get elem :file-name)))))) + (gnus-cloud-encode-data) + (buffer-string))) + +(defun gnus-cloud-encode-data () + (call-process-region (point-min) (point-max) "gzip" + t (current-buffer) nil + "-c") + (base64-encode-region (point-min) (point-max))) + +(defun gnus-cloud-decode-data () + (base64-decode-region (point-min) (point-max)) + (call-process-region (point-min) (point-max) "gunzip" + t (current-buffer) nil + "-c")) + +(defun gnus-cloud-parse-chunk () + (save-excursion + (goto-char (point-min)) + (unless (looking-at "Version \\([0-9]+\\)") + (error "Not a valid Cloud chunk in the current buffer")) + (forward-line 1) + (let ((version (string-to-number (match-string 1))) + (data (buffer-substring (point) (point-max)))) + (mm-with-unibyte-buffer + (insert data) + (cond + ((= version 1) + (gnus-cloud-decode-data) + (goto-char (point-min)) + (gnus-cloud-parse-version-1)) + (t + (error "Unsupported Cloud chunk version %s" version))))))) + +(defun gnus-cloud-parse-version-1 () + (let ((elems nil)) + (while (not (eobp)) + (while (and (not (eobp)) + (not (looking-at "(:type"))) + (forward-line 1)) + (unless (eobp) + (let ((spec (ignore-errors (read (current-buffer)))) + length) + (when (and (consp spec) + (memq (plist-get spec :type) '(:file :data :delete))) + (setq length (plist-get spec :length)) + (push (append spec + (list + :contents (buffer-substring (1+ (point)) + (+ (point) 1 length)))) + elems) + (goto-char (+ (point) 1 length)))))) + (nreverse elems))) + +(defun gnus-cloud-update-data (elems) + (dolist (elem elems) + (let ((type (plist-get elem :type))) + (cond + ((eq type :data) + ) + ((eq type :delete) + (gnus-cloud-delete-file (plist-get elem :file-name)) + ) + ((eq type :file) + (gnus-cloud-update-file elem)) + (t + (message "Unknown type %s; ignoring" type)))))) + +(defun gnus-cloud-update-file (elem) + (let ((file-name (plist-get elem :file-name)) + (date (plist-get elem :timestamp)) + (contents (plist-get elem :contents))) + (unless (gnus-cloud-file-covered-p file-name) + (message "%s isn't covered by the cloud; ignoring" file-name)) + (when (or (not (file-exists-p file-name)) + (and (file-exists-p file-name) + (mm-with-unibyte-buffer + (insert-file-contents-literally file-name) + (not (equal (buffer-string) contents))))) + (gnus-cloud-replace-file file-name date contents)))) + +(defun gnus-cloud-replace-file (file-name date new-contents) + (mm-with-unibyte-buffer + (insert new-contents) + (when (file-exists-p file-name) + (rename-file file-name (car (find-backup-file-name file-name)))) + (write-region (point-min) (point-max) file-name) + (set-file-times file-name (parse-iso8601-time-string date)))) + +(defun gnus-cloud-delete-file (file-name) + (unless (gnus-cloud-file-covered-p file-name) + (message "%s isn't covered by the cloud; ignoring" file-name)) + (when (file-exists-p file-name) + (rename-file file-name (car (find-backup-file-name file-name))))) + +(defun gnus-cloud-file-covered-p (file-name) + (let ((matched nil)) + (dolist (elem gnus-cloud-synced-files) + (cond + ((stringp elem) + (when (equal elem file-name) + (setq matched t))) + ((consp elem) + (when (and (equal (directory-file-name (plist-get elem :directory)) + (directory-file-name (file-name-directory file-name))) + (string-match (plist-get elem :match) + (file-name-nondirectory file-name))) + (setq matched t))))) + matched)) + +(defun gnus-cloud-all-files () + (let ((files nil)) + (dolist (elem gnus-cloud-synced-files) + (cond + ((stringp elem) + (push elem files)) + ((consp elem) + (dolist (file (directory-files (plist-get elem :directory) + nil + (plist-get elem :match))) + (push (format "%s/%s" + (directory-file-name (plist-get elem :directory)) + file) + files))))) + (nreverse files))) + +(defvar gnus-cloud-file-timestamps nil) + +(defun gnus-cloud-files-to-upload (&optional full) + (let ((files nil) + timestamp) + (dolist (file (gnus-cloud-all-files)) + (if (file-exists-p file) + (when (setq timestamp (gnus-cloud-file-new-p file full)) + (push `(:type :file :file-name ,file :timestamp ,timestamp) files)) + (when (assoc file gnus-cloud-file-timestamps) + (push `(:type :delete :file-name ,file) files)))) + (nreverse files))) + +(defun gnus-cloud-file-new-p (file full) + (let ((timestamp (format-time-string + "%FT%T%z" (nth 5 (file-attributes file)))) + (old (cadr (assoc file gnus-cloud-file-timestamps)))) + (when (or full + (null old) + (string< old timestamp)) + timestamp))) + +(declare-function gnus-activate-group "gnus-start" + (group &optional scan dont-check method dont-sub-check)) +(declare-function gnus-subscribe-group "gnus-start" + (group &optional previous method)) + +(defun gnus-cloud-ensure-cloud-group () + (let ((method (if (stringp gnus-cloud-method) + (gnus-server-to-method gnus-cloud-method) + gnus-cloud-method))) + (unless (or (gnus-active gnus-cloud-group-name) + (gnus-activate-group gnus-cloud-group-name nil nil + gnus-cloud-method)) + (and (gnus-request-create-group gnus-cloud-group-name gnus-cloud-method) + (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method) + (gnus-subscribe-group gnus-cloud-group-name))))) + +(defun gnus-cloud-upload-data (&optional full) + (gnus-cloud-ensure-cloud-group) + (with-temp-buffer + (let ((elems (gnus-cloud-files-to-upload full))) + (insert (format "Subject: (sequence: %d type: %s)\n" + gnus-cloud-sequence + (if full :full :partial))) + (insert "From: nobody@invalid.com\n") + (insert "\n") + (insert (gnus-cloud-make-chunk elems)) + (when (gnus-request-accept-article gnus-cloud-group-name gnus-cloud-method + t t) + (setq gnus-cloud-sequence (1+ gnus-cloud-sequence)) + (gnus-cloud-add-timestamps elems))))) + +(defun gnus-cloud-add-timestamps (elems) + (dolist (elem elems) + (let* ((file-name (plist-get elem :file-name)) + (old (assoc file-name gnus-cloud-file-timestamps))) + (when old + (setq gnus-cloud-file-timestamps + (delq old gnus-cloud-file-timestamps))) + (push (list file-name (plist-get elem :timestamp)) + gnus-cloud-file-timestamps)))) + +(defun gnus-cloud-available-chunks () + (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method) + (let* ((group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method)) + (active (gnus-active group)) + headers head) + (when (gnus-retrieve-headers (gnus-uncompress-range active) group) + (with-current-buffer nntp-server-buffer + (goto-char (point-min)) + (while (and (not (eobp)) + (setq head (nnheader-parse-head))) + (push head headers)))) + (sort (nreverse headers) + (lambda (h1 h2) + (> (gnus-cloud-chunk-sequence (mail-header-subject h1)) + (gnus-cloud-chunk-sequence (mail-header-subject h2))))))) + +(defun gnus-cloud-chunk-sequence (string) + (if (string-match "sequence: \\([0-9]+\\)" string) + (string-to-number (match-string 1 string)) + 0)) + +(defun gnus-cloud-prune-old-chunks (headers) + (let ((headers (reverse headers)) + (found nil)) + (while (and headers + (not found)) + (when (string-match "type: :full" (mail-header-subject (car headers))) + (setq found t)) + (pop headers)) + ;; All the chunks that are older than the newest :full chunk can be + ;; deleted. + (when headers + (gnus-request-expire-articles + (mapcar (lambda (h) + (mail-header-number h)) + (nreverse headers)) + (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method))))) + +(defun gnus-cloud-download-data () + (let ((articles nil) + chunks) + (dolist (header (gnus-cloud-available-chunks)) + (when (> (gnus-cloud-chunk-sequence (mail-header-subject header)) + gnus-cloud-sequence) + (push (mail-header-number header) articles))) + (when articles + (nnimap-request-articles (nreverse articles) gnus-cloud-group-name) + (with-current-buffer nntp-server-buffer + (goto-char (point-min)) + (while (re-search-forward "^Version " nil t) + (beginning-of-line) + (push (gnus-cloud-parse-chunk) chunks) + (forward-line 1)))))) + +(defun gnus-cloud-server-p (server) + (member server gnus-cloud-covered-servers)) + +(defun gnus-cloud-collect-full-newsrc () + (let ((infos nil)) + (dolist (info (cdr gnus-newsrc-alist)) + (when (gnus-cloud-server-p + (gnus-method-to-server + (gnus-find-method-for-group (gnus-info-group info)))) + (push info infos))) + )) + +(provide 'gnus-cloud) + +;;; gnus-cloud.el ends here diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el index a49854193fe..424f2c09e59 100644 --- a/lisp/gnus/gnus-delay.el +++ b/lisp/gnus/gnus-delay.el @@ -98,7 +98,7 @@ DELAY is a string, giving the length of the time. Possible values are: (setq hour (string-to-number (match-string 1 delay)) minute (string-to-number (match-string 2 delay))) ;; Use current time, except... - (setq deadline (apply 'vector (decode-time (current-time)))) + (setq deadline (apply 'vector (decode-time))) ;; ... for minute and hour. (aset deadline 1 minute) (aset deadline 2 hour) @@ -153,7 +153,7 @@ DELAY is a string, giving the length of the time. Possible values are: (when (gnus-group-entry group) (gnus-activate-group group) (add-hook 'message-send-hook - (lambda () (message-remove-header gnus-delay-header))) + (lambda () (message-remove-header gnus-delay-header)) t) (setq articles (nndraft-articles)) (while (setq article (pop articles)) (gnus-request-head article group) diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index ae3d703c48e..ca14dd0b6db 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -24,10 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) @@ -44,6 +40,24 @@ :group 'gnus-fun :type 'directory) +(defcustom gnus-x-face-omit-files nil + "Regexp to match faces in `gnus-x-face-directory' to be omitted." + :version "25.1" + :group 'gnus-fun + :type 'string) + +(defcustom gnus-face-directory (expand-file-name "faces" gnus-directory) + "*Directory where Face PNG files are stored." + :version "25.1" + :group 'gnus-fun + :type 'directory) + +(defcustom gnus-face-omit-files nil + "Regexp to match faces in `gnus-face-directory' to be omitted." + :version "25.1" + :group 'gnus-fun + :type 'string) + (defcustom gnus-convert-pbm-to-x-face-command "pbmtoxbm %s | compface" "Command for converting a PBM to an X-Face." :version "22.1" @@ -86,35 +100,57 @@ PNG format." nil shell-command-switch command))) ;;;###autoload -(defun gnus-random-x-face () - "Return X-Face header data chosen randomly from `gnus-x-face-directory'." - (interactive) - (when (file-exists-p gnus-x-face-directory) - (let* ((files (directory-files gnus-x-face-directory t "\\.pbm$")) - (file (nth (random (length files)) files))) +(defun gnus--random-face-with-type (dir ext omit fun) + "Return file from DIR with extension EXT, omitting matches of OMIT, processed by FUN." + (when (file-exists-p dir) + (let* ((files + (remove nil (mapcar + (lambda (f) (unless (string-match (or omit "^$") f) f)) + (directory-files dir t ext)))) + (file (nth (random (length files)) files))) (when file - (gnus-shell-command-to-string - (format gnus-convert-pbm-to-x-face-command - (shell-quote-argument file))))))) + (funcall fun file))))) +;;;###autoload (autoload 'message-goto-eoh "message" nil t) +(autoload 'message-insert-header "message" nil t) + +(defun gnus--insert-random-face-with-type (fun type) + "Get a random face using FUN and insert it as a header TYPE. + +For instance, to insert an X-Face use `gnus-random-x-face' as FUN + and \"X-Face\" as TYPE." + (let ((data (funcall fun))) + (save-excursion + (if data + (progn (message-goto-eoh) + (insert type ": " data "\n")) + (message + "No face returned by the function %s." (symbol-name fun)))))) + + + +;;;###autoload +(defun gnus-random-x-face () + "Return X-Face header data chosen randomly from `gnus-x-face-directory'. + +Files matching `gnus-x-face-omit-files' are not considered." + (interactive) + (gnus--random-face-with-type gnus-x-face-directory "\\.pbm$" gnus-x-face-omit-files + (lambda (file) + (gnus-shell-command-to-string + (format gnus-convert-pbm-to-x-face-command + (shell-quote-argument file)))))) ;;;###autoload (defun gnus-insert-random-x-face-header () "Insert a random X-Face header from `gnus-x-face-directory'." (interactive) - (let ((data (gnus-random-x-face))) - (save-excursion - (message-goto-eoh) - (if data - (insert "X-Face: " data) - (message - "No face returned by `gnus-random-x-face'. Does %s/*.pbm exist?" - gnus-x-face-directory))))) + (gnus--insert-random-face-with-type 'gnus-random-x-face 'X-Face)) ;;;###autoload (defun gnus-x-face-from-file (file) - "Insert an X-Face header based on an image file. + "Insert an X-Face header based on an image FILE. Depending on `gnus-convert-image-to-x-face-command' it may accept different input formats." @@ -126,7 +162,7 @@ different input formats." ;;;###autoload (defun gnus-face-from-file (file) - "Return a Face header based on an image file. + "Return a Face header based on an image FILE. Depending on `gnus-convert-image-to-face-command' it may accept different input formats." @@ -191,6 +227,21 @@ FILE should be a PNG file that's 48x48 and smaller than or equal to (buffer-size))) (gnus-face-encode))) +;;;###autoload +(defun gnus-random-face () + "Return randomly chosen Face from `gnus-face-directory'. + +Files matching `gnus-face-omit-files' are not considered." + (interactive) + (gnus--random-face-with-type gnus-face-directory "\\.png$" + gnus-face-omit-files + 'gnus-convert-png-to-face)) + +;;;###autoload +(defun gnus-insert-random-face-header () + "Insert a random Face header from `gnus-face-directory'." + (gnus--insert-random-face-with-type 'gnus-random-face 'Face)) + (defface gnus-x-face '((t (:foreground "black" :background "white"))) "Face to show X-Face. The colors from this face are used as the foreground and background diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 8e1cd182215..e22138b7028 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -24,10 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (defvar tool-bar-mode) @@ -2463,7 +2459,7 @@ the bug number, and browsing the URL must return mbox output." (let ((coding-system-for-write 'binary) (coding-system-for-read 'binary)) (with-temp-file tmpfile - (set-buffer-multibyte nil) + (mm-disable-multibyte) (dolist (id ids) (url-insert-file-contents (format mbox-url id))) (goto-char (point-min)) @@ -4079,7 +4075,9 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." (gnus-group-remove-mark group) ;; Bypass any previous denials from the server. (gnus-remove-denial (setq method (gnus-find-method-for-group group))) - (if (gnus-activate-group group (if dont-scan nil 'scan) nil method) + (if (or (and (not dont-scan) + (gnus-request-group-scan group (gnus-get-info group))) + (gnus-activate-group group (if dont-scan nil 'scan) nil method)) (let ((info (gnus-get-info group)) (active (gnus-active group))) (when info @@ -4316,6 +4314,11 @@ The hook `gnus-suspend-gnus-hook' is called before actually suspending." (gnus-kill-buffer buf))) (setq gnus-backlog-articles nil) (gnus-kill-gnus-frames) + ;; Closing all the backends is useful (for instance) when when the + ;; IP addresses have changed and you need to reconnect. + (dolist (elem gnus-opened-servers) + (gnus-close-server (car elem)) + (setcar (cdr elem) 'closed)) (when group-buf (bury-buffer group-buf) (delete-windows-on group-buf t)))) diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index 4c2496dc8fd..b706de7430e 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -28,10 +28,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'gnus-art) diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index e85a2e63d7a..dc423d85d19 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -38,6 +38,7 @@ (require 'gmm-utils) (require 'mm-decode) (require 'gnus-sum) +(require 'gnus-art) (eval-when-compile (require 'cl)) @@ -140,12 +141,13 @@ (defmethod gnus-icalendar-event:start ((event gnus-icalendar-event)) (format-time-string "%Y-%m-%d %H:%M" (gnus-icalendar-event:start-time event))) -(defun gnus-icalendar-event--decode-datefield (ical field) - (let* ((date (icalendar--get-event-property ical field)) - (date-props (icalendar--get-event-property-attributes ical field)) - (tz (plist-get date-props 'TZID))) - - (date-to-time (timezone-make-date-arpa-standard date nil tz)))) +(defun gnus-icalendar-event--decode-datefield (event field zone-map) + (let* ((dtdate (icalendar--get-event-property event field)) + (dtdate-zone (icalendar--find-time-zone + (icalendar--get-event-property-attributes + event field) zone-map)) + (dtdate-dec (icalendar--decode-isodatetime dtdate nil dtdate-zone))) + (apply 'encode-time dtdate-dec))) (defun gnus-icalendar-event--find-attendee (ical name-or-email) (let* ((event (car (icalendar--all-events ical))) @@ -170,7 +172,9 @@ (caddr event)))) (gmm-labels ((attendee-role (prop) (plist-get (cadr prop) 'ROLE)) - (attendee-name (prop) (plist-get (cadr prop) 'CN)) + (attendee-name (prop) + (or (plist-get (cadr prop) 'CN) + (replace-regexp-in-string "^.*MAILTO:" "" (caddr prop)))) (attendees-by-type (type) (gnus-remove-if-not (lambda (p) (string= (attendee-role p) type)) @@ -201,10 +205,11 @@ ("REQ-PARTICIPANT" 'required) ("OPT-PARTICIPANT" 'optional) (_ 'non-participant))) + (zone-map (icalendar--convert-all-timezones ical)) (args (list :method method :organizer organizer - :start-time (gnus-icalendar-event--decode-datefield event 'DTSTART) - :end-time (gnus-icalendar-event--decode-datefield event 'DTEND) + :start-time (gnus-icalendar-event--decode-datefield event 'DTSTART zone-map) + :end-time (gnus-icalendar-event--decode-datefield event 'DTEND zone-map) :rsvp (string= (plist-get (cadr attendee) 'RSVP) "TRUE") :participation-type participation-type :req-participants (car attendee-names) @@ -452,7 +457,6 @@ Return nil for non-recurring EVENT." "Not replied yet")) (props `(("ICAL_EVENT" . "t") ("ID" . ,uid) - ("DT" . ,(gnus-icalendar-event:org-timestamp event)) ("ORGANIZER" . ,(gnus-icalendar-event:organizer event)) ("LOCATION" . ,(gnus-icalendar-event:location event)) ("PARTICIPATION_TYPE" . ,(symbol-name (gnus-icalendar-event:participation-type event))) @@ -470,7 +474,9 @@ Return nil for non-recurring EVENT." (when description (save-restriction (narrow-to-region (point) (point)) - (insert description) + (insert (gnus-icalendar-event:org-timestamp event) + "\n\n" + description) (indent-region (point-min) (point-max) 2) (fill-region (point-min) (point-max)))) @@ -551,20 +557,31 @@ is searched." (when description (save-restriction (narrow-to-region (point) (point)) - (insert "\n" (replace-regexp-in-string "[\n]+$" "\n" description) "\n") + (insert "\n" + (gnus-icalendar-event:org-timestamp event) + "\n\n" + (replace-regexp-in-string "[\n]+$" "\n" description) + "\n") (indent-region (point-min) (point-max) (1+ entry-outline-level)) (fill-region (point-min) (point-max)))) ;; update entry properties - (org-entry-put event-pos "DT" (gnus-icalendar-event:org-timestamp event)) - (org-entry-put event-pos "ORGANIZER" organizer) - (org-entry-put event-pos "LOCATION" location) - (org-entry-put event-pos "PARTICIPATION_TYPE" (symbol-name participation-type)) - (org-entry-put event-pos "REQ_PARTICIPANTS" (gnus-icalendar--format-participant-list req-participants)) - (org-entry-put event-pos "OPT_PARTICIPANTS" (gnus-icalendar--format-participant-list opt-participants)) - (org-entry-put event-pos "RRULE" recur) - (when reply-status (org-entry-put event-pos "REPLY" - (capitalize (symbol-name reply-status)))) + (gmm-labels + ((update-org-entry (position property value) + (if (or (null value) + (string= value "")) + (org-entry-delete position property) + (org-entry-put position property value)))) + + (update-org-entry event-pos "ORGANIZER" organizer) + (update-org-entry event-pos "LOCATION" location) + (update-org-entry event-pos "PARTICIPATION_TYPE" (symbol-name participation-type)) + (update-org-entry event-pos "REQ_PARTICIPANTS" (gnus-icalendar--format-participant-list req-participants)) + (update-org-entry event-pos "OPT_PARTICIPANTS" (gnus-icalendar--format-participant-list opt-participants)) + (update-org-entry event-pos "RRULE" recur) + (update-org-entry event-pos "REPLY" + (if reply-status (capitalize (symbol-name reply-status)) + "Not replied yet"))) (save-buffer))))))))) @@ -661,8 +678,9 @@ Gnus will only offer you the Accept/Tentative/Decline buttons for calendar events if any of your identities matches at least one RSVP participant. -Your identity is guessed automatically from the variables `user-full-name', -`user-mail-address', and `gnus-ignored-from-addresses'. +Your identity is guessed automatically from the variables +`user-full-name', `user-mail-address', +`gnus-ignored-from-addresses' and `message-alternative-emails'. If you need even more aliases you can define them here. It really only makes sense to define names or email addresses." @@ -688,6 +706,7 @@ These will be used to retrieve the RSVP information from ical events." (list user-full-name (regexp-quote user-mail-address) ; NOTE: these can be lists gnus-ignored-from-addresses ; already regexp-quoted + message-alternative-emails ; (mapcar #'regexp-quote gnus-icalendar-additional-identities))))) ;; TODO: make the template customizable diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index 487b85f581d..dd938ce0758 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -439,6 +439,14 @@ If it is down, start it up (again)." (funcall (gnus-get-function gnus-command-method func) (gnus-group-real-name group) (nth 1 gnus-command-method))))) +(defun gnus-request-group-scan (group info) + "Request that GROUP get a complete rescan." + (let ((gnus-command-method (gnus-find-method-for-group group)) + (func 'request-group-description)) + (when (gnus-check-backend-function func group) + (funcall (gnus-get-function gnus-command-method func) + (gnus-group-real-name group) (nth 1 gnus-command-method) info)))) + (defun gnus-close-group (group) "Request the GROUP be closed." (let ((gnus-command-method (inline (gnus-find-method-for-group group)))) diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el index 0b42bc23d3d..56166f2fca2 100644 --- a/lisp/gnus/gnus-mlspl.el +++ b/lisp/gnus/gnus-mlspl.el @@ -146,20 +146,27 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns: (any \"\\\\(foo@nowhere\\\\.gov\\\\|foo@localhost\\\\|foo-redist@home\\\\)\" - \"bugs-foo\" - \"rambling-foo\" \"mail.foo\")) \"mail.others\")" - (let* ((newsrc (cdr gnus-newsrc-alist)) - split) - (dolist (info newsrc) - (let ((group (gnus-info-group info)) - (params (gnus-info-params info))) - ;; For all GROUPs that match the specified GROUPS - (when (or (not groups) - (and (listp groups) - (memq group groups)) - (and (stringp groups) - (string-match groups group))) - (let ((split-spec (assoc 'split-spec params)) group-clean) - ;; Remove backend from group name - (setq group-clean (string-match ":" group)) + (let ((group-names (if (and (listp groups) + (not (null groups))) + groups + (delete-dups + (delq nil + (mapcar + (lambda (info) + (let ((group (gnus-info-group info))) + (if (or (not groups) + (and (stringp groups) + (string-match groups group))) + group))) + (append gnus-newsrc-alist gnus-parameters)))))) + split) + (dolist (group group-names) + (let ((params (gnus-group-find-parameter group))) + ;; Skip groups without param (or nonexistent) + (when (not (null params)) + (let ((split-spec (assoc 'split-spec params)) group-clean) + ;; Remove backend from group name + (setq group-clean (string-match ":" group)) (setq group-clean (if group-clean (substring group (1+ group-clean)) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 3a7302fb786..6c80c0daca6 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1726,7 +1726,20 @@ this is a reply." (var (or gnus-outgoing-message-group gnus-message-archive-group)) (gcc-self-val (and group (not (gnus-virtual-group-p group)) - (gnus-group-find-parameter group 'gcc-self))) + (gnus-group-find-parameter group 'gcc-self t))) + (gcc-self-get (lambda (gcc-self-val group) + (if (stringp gcc-self-val) + (if (string-match " " gcc-self-val) + (concat "\"" gcc-self-val "\"") + gcc-self-val) + ;; In nndoc groups, we use the parent group name + ;; instead of the current group. + (let ((group (or (gnus-group-find-parameter + gnus-newsgroup-name 'parent-group) + group))) + (if (string-match " " group) + (concat "\"" group "\"") + group))))) result (groups (cond @@ -1777,19 +1790,11 @@ this is a reply." (if gcc-self-val ;; Use the `gcc-self' param value instead. (progn - (insert - (if (stringp gcc-self-val) - (if (string-match " " gcc-self-val) - (concat "\"" gcc-self-val "\"") - gcc-self-val) - ;; In nndoc groups, we use the parent group name - ;; instead of the current group. - (let ((group (or (gnus-group-find-parameter - gnus-newsgroup-name 'parent-group) - group))) - (if (string-match " " group) - (concat "\"" group "\"") - group)))) + (insert (if (listp gcc-self-val) + (mapconcat (lambda (val) + (funcall gcc-self-get val group)) + gcc-self-val ", ") + (funcall gcc-self-get gcc-self-val group))) (if (not (eq gcc-self-val 'none)) (insert "\n") (gnus-delete-line))) @@ -1826,7 +1831,7 @@ this is a reply." (with-current-buffer gnus-summary-buffer gnus-posting-styles) gnus-posting-styles)) - style match attribute value v results + style match attribute value v results matched-string filep name address element) ;; If the group has a posting-style parameter, add it at the end with a ;; regexp matching everything, to be sure it takes precedence over all @@ -1846,7 +1851,9 @@ this is a reply." (when (cond ((stringp match) ;; Regexp string match on the group name. - (string-match match group)) + (when (string-match match group) + (setq matched-string group) + t)) ((eq match 'header) ;; Obsolete format of header match. (and (gnus-buffer-live-p gnus-article-copy) @@ -1875,7 +1882,8 @@ this is a reply." (nnheader-narrow-to-headers) (let ((header (message-fetch-field (nth 1 match)))) (and header - (string-match (nth 2 match) header))))))) + (string-match (nth 2 match) header) + (setq matched-string header))))))) (t ;; This is a form to be evalled. (eval match))))) @@ -1896,10 +1904,11 @@ this is a reply." (setq v (cond ((stringp value) - (if (and (stringp match) + (if (and matched-string (gnus-string-match-p "\\\\[&[:digit:]]" value) (match-beginning 1)) - (gnus-match-substitute-replacement value nil nil group) + (gnus-match-substitute-replacement value nil nil + matched-string) value)) ((or (symbolp value) (functionp value)) diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el index 05f97095e37..2941cc46e4a 100644 --- a/lisp/gnus/gnus-notifications.el +++ b/lisp/gnus/gnus-notifications.el @@ -92,9 +92,9 @@ Return a notification id if any, or t on success." :body subject :actions '("read" "Read") :on-action 'gnus-notifications-action - :app-icon (or photo-file - (gnus-funcall-no-warning - 'image-search-load-path "gnus/gnus.png")) + :app-icon (gnus-funcall-no-warning + 'image-search-load-path "gnus/gnus.png") + :image-path photo-file :app-name "Gnus" :category "email.arrived" :timeout gnus-notifications-timeout) @@ -102,6 +102,9 @@ Return a notification id if any, or t on success." ;; Don't return an id t)) +(declare-function gravatar-retrieve-synchronously "gravatar.el" + (mail-address)) + (defun gnus-notifications-get-photo (mail-address) "Get photo for mail address." (let ((google-photo (when (and gnus-notifications-use-google-contacts diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el index 47a1d6d147a..62b18b40453 100644 --- a/lisp/gnus/gnus-picon.el +++ b/lisp/gnus/gnus-picon.el @@ -37,10 +37,6 @@ ;; ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'gnus) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 7dab242425d..9cfca1290c5 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -176,6 +176,7 @@ nnmairix groups are specifically excluded because they are ephemeral." (make-obsolete-variable 'gnus-registry-max-track-groups nil "23.4") (make-obsolete-variable 'gnus-registry-entry-caching nil "23.4") (make-obsolete-variable 'gnus-registry-trim-articles-without-groups nil "23.4") +(make-obsolete-variable 'gnus-registry-max-pruned-entries nil "24.4") (defcustom gnus-registry-track-extra '(subject sender recipient) "Whether the registry should track extra data about a message. @@ -231,7 +232,7 @@ the Bit Bucket." (defcustom gnus-registry-cache-file (nnheader-concat (or gnus-dribble-directory gnus-home-directory "~/") - ".gnus.registry.eioio") + ".gnus.registry.eieio") "File where the Gnus registry will be stored." :group 'gnus-registry :type 'file) @@ -242,12 +243,38 @@ the Bit Bucket." :type '(radio (const :format "Unlimited " nil) (integer :format "Maximum number: %v"))) -(defcustom gnus-registry-max-pruned-entries nil - "Maximum number of pruned entries in the registry, nil for unlimited." - :version "24.1" +(defcustom gnus-registry-prune-factor 0.1 + "When pruning, try to prune back to this factor less than the maximum size. + +In order to prevent constant pruning, we prune back to a number +somewhat less than the maximum size. This option controls +exactly how much less. For example, given a maximum size of +50000 and a prune factor of 0.1, the pruning process will try to +cut the registry back to \(- 50000 \(* 50000 0.1\)\) -> 45000 +entries. The pruning process is constrained by the presence of +\"precious\" entries." + :version "24.4" :group 'gnus-registry - :type '(radio (const :format "Unlimited " nil) - (integer :format "Maximum number: %v"))) + :type 'float) + +(defcustom gnus-registry-default-sort-function + #'gnus-registry-sort-by-creation-time + "Sort function to use when pruning the registry. + +Entries which sort to the front of the list will be pruned +first. + +This can slow pruning down. Set to nil to perform no sorting." + :version "24.4" + :group 'gnus-registry + :type 'symbol) + +(defun gnus-registry-sort-by-creation-time (l r) + "Sort older entries to front of list." + ;; Pruning starts from the front of the list. + (time-less-p + (cadr (assq 'creation-time r)) + (cadr (assq 'creation-time l)))) (defun gnus-registry-fixup-registry (db) (when db @@ -255,14 +282,12 @@ the Bit Bucket." (oset db :precious (append gnus-registry-extra-entries-precious '())) - (oset db :max-hard + (oset db :max-size (or gnus-registry-max-entries most-positive-fixnum)) (oset db :prune-factor - 0.1) - (oset db :max-soft - (or gnus-registry-max-pruned-entries - most-positive-fixnum)) + (or gnus-registry-prune-factor + 0.1)) (oset db :tracked (append gnus-registry-track-extra '(mark group keyword))) @@ -278,8 +303,8 @@ the Bit Bucket." "Gnus Registry" :file (or file gnus-registry-cache-file) ;; these parameters are set in `gnus-registry-fixup-registry' - :max-hard most-positive-fixnum - :max-soft most-positive-fixnum + :max-size most-positive-fixnum + :version registry-db-version :precious nil :tracked nil))) @@ -295,22 +320,27 @@ This is not required after changing `gnus-registry-cache-file'." (gnus-message 4 "Remaking the Gnus registry") (setq gnus-registry-db (gnus-registry-make-db)))) -(defun gnus-registry-read () - "Read the registry cache file." +(defun gnus-registry-load () + "Load the registry from the cache file." (interactive) (let ((file gnus-registry-cache-file)) (condition-case nil - (progn - (gnus-message 5 "Reading Gnus registry from %s..." file) - (setq gnus-registry-db - (gnus-registry-fixup-registry - (condition-case nil - (with-no-warnings - (eieio-persistent-read file 'registry-db)) - ;; Older EIEIO versions do not check the class name. - ('wrong-number-of-arguments - (eieio-persistent-read file))))) - (gnus-message 5 "Reading Gnus registry from %s...done" file)) + (gnus-registry-read file) + (file-error + ;; Fix previous mis-naming of the registry file. + (let ((old-file-name + (concat (file-name-sans-extension + gnus-registry-cache-file) + ".eioio"))) + (if (and (file-exists-p old-file-name) + (yes-or-no-p + (format "Rename registry file from %s to %s? " + old-file-name file))) + (progn + (gnus-registry-read old-file-name) + (oset gnus-registry-db :file file) + (gnus-message 1 "Registry filename changed to %s" file)) + (gnus-registry-remake-db t)))) (error (gnus-message 1 @@ -318,6 +348,19 @@ This is not required after changing `gnus-registry-cache-file'." file) (gnus-registry-remake-db t))))) +(defun gnus-registry-read (file) + "Do the actual reading of the registry persistence file." + (gnus-message 5 "Reading Gnus registry from %s..." file) + (setq gnus-registry-db + (gnus-registry-fixup-registry + (condition-case nil + (with-no-warnings + (eieio-persistent-read file 'registry-db)) + ;; Older EIEIO versions do not check the class name. + ('wrong-number-of-arguments + (eieio-persistent-read file))))) + (gnus-message 5 "Reading Gnus registry from %s...done" file)) + (defun gnus-registry-save (&optional file db) "Save the registry cache file." (interactive) @@ -325,7 +368,8 @@ This is not required after changing `gnus-registry-cache-file'." (db (or db gnus-registry-db))) (gnus-message 5 "Saving Gnus registry (%d entries) to %s..." (registry-size db) file) - (registry-prune db) + (registry-prune + db gnus-registry-default-sort-function) ;; TODO: call (gnus-string-remove-all-properties v) on all elements? (eieio-persistent-save db file) (gnus-message 5 "Saving Gnus registry (size %d) to %s...done" @@ -1032,7 +1076,8 @@ only the last one's marks are returned." "Just like `registry-insert' but tries to prune on error." (when (registry-full db) (message "Trying to prune the registry because it's full") - (registry-prune db)) + (registry-prune + db gnus-registry-default-sort-function)) (registry-insert db id entry) entry) @@ -1090,7 +1135,7 @@ only the last one's marks are returned." (gnus-message 5 "Initializing the registry") (gnus-registry-install-hooks) (gnus-registry-install-shortcuts) - (gnus-registry-read)) + (gnus-registry-load)) ;; FIXME: Why autoload this function? ;;;###autoload @@ -1104,7 +1149,7 @@ only the last one's marks are returned." (add-hook 'nnmail-spool-hook 'gnus-registry-spool-action) (add-hook 'gnus-save-newsrc-hook 'gnus-registry-save) - (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read) + (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-load) (add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)) @@ -1117,7 +1162,7 @@ only the last one's marks are returned." (remove-hook 'nnmail-spool-hook 'gnus-registry-spool-action) (remove-hook 'gnus-save-newsrc-hook 'gnus-registry-save) - (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read) + (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-load) (remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids) (setq gnus-registry-enabled nil)) diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el index f5a8c0920d4..035a5901e69 100644 --- a/lisp/gnus/gnus-spec.el +++ b/lisp/gnus/gnus-spec.el @@ -24,9 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) (defvar gnus-newsrc-file-version) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 8c617b70867..d32f7cad3db 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -45,7 +45,7 @@ :group 'gnus-server :type 'hook) -(defcustom gnus-server-line-format " {%(%h:%w%)} %s%a\n" +(defcustom gnus-server-line-format " {%(%h:%w%)} %s%a%c\n" "Format of server lines. It works along the same lines as a normal formatting string, with some simple extensions. @@ -78,6 +78,16 @@ If nil, a faster, but more primitive, buffer is used instead." ;;; Internal variables. +(defvar gnus-tmp-how) +(defvar gnus-tmp-name) +(defvar gnus-tmp-where) +(defvar gnus-tmp-status) +(defvar gnus-tmp-agent) +(defvar gnus-tmp-cloud) +(defvar gnus-tmp-news-server) +(defvar gnus-tmp-news-method) +(defvar gnus-tmp-user-defined) + (defvar gnus-inserted-opened-servers nil) (defvar gnus-server-line-format-alist @@ -85,7 +95,8 @@ If nil, a faster, but more primitive, buffer is used instead." (?n gnus-tmp-name ?s) (?w gnus-tmp-where ?s) (?s gnus-tmp-status ?s) - (?a gnus-tmp-agent ?s))) + (?a gnus-tmp-agent ?s) + (?c gnus-tmp-cloud ?s))) (defvar gnus-server-mode-line-format-alist `((?S gnus-tmp-news-server ?s) @@ -127,6 +138,7 @@ If nil, a faster, but more primitive, buffer is used instead." ["Close" gnus-server-close-server t] ["Offline" gnus-server-offline-server t] ["Deny" gnus-server-deny-server t] + ["Toggle Cloud" gnus-server-toggle-cloud-server t] "---" ["Open All" gnus-server-open-all-servers t] ["Close All" gnus-server-close-all-servers t] @@ -172,6 +184,8 @@ If nil, a faster, but more primitive, buffer is used instead." "z" gnus-server-compact-server + "i" gnus-server-toggle-cloud-server + "\C-c\C-i" gnus-info-find-node "\C-c\C-b" gnus-bug)) @@ -185,6 +199,13 @@ If nil, a faster, but more primitive, buffer is used instead." (put 'gnus-server-agent-face 'face-alias 'gnus-server-agent) (put 'gnus-server-agent-face 'obsolete-face "22.1") +(defface gnus-server-cloud + '((((class color) (background light)) (:foreground "ForestGreen" :bold t)) + (((class color) (background dark)) (:foreground "PaleGreen" :bold t)) + (t (:bold t))) + "Face used for displaying AGENTIZED servers" + :group 'gnus-server-visual) + (defface gnus-server-opened '((((class color) (background light)) (:foreground "Green3" :bold t)) (((class color) (background dark)) (:foreground "Green1" :bold t)) @@ -228,6 +249,7 @@ If nil, a faster, but more primitive, buffer is used instead." (defvar gnus-server-font-lock-keywords '(("(\\(agent\\))" 1 'gnus-server-agent) + ("(\\(cloud\\))" 1 'gnus-server-cloud) ("(\\(opened\\))" 1 'gnus-server-opened) ("(\\(closed\\))" 1 'gnus-server-closed) ("(\\(offline\\))" 1 'gnus-server-offline) @@ -264,8 +286,9 @@ The following commands are available: '(gnus-server-font-lock-keywords t))) (gnus-run-mode-hooks 'gnus-server-mode-hook)) -(defun gnus-server-insert-server-line (gnus-tmp-name method) - (let* ((gnus-tmp-how (car method)) +(defun gnus-server-insert-server-line (name method) + (let* ((gnus-tmp-name name) + (gnus-tmp-how (car method)) (gnus-tmp-where (nth 1 method)) (elem (assoc method gnus-opened-servers)) (gnus-tmp-status @@ -282,6 +305,9 @@ The following commands are available: (gnus-tmp-agent (if (and gnus-agent (gnus-agent-method-p method)) " (agent)" + "")) + (gnus-tmp-cloud (if (gnus-cloud-server-p gnus-tmp-name) + " (cloud)" ""))) (beginning-of-line) (gnus-add-text-properties @@ -1084,6 +1110,27 @@ Requesting compaction of %s... (this may take a long time)" (let ((original (get-buffer gnus-original-article-buffer))) (and original (gnus-kill-buffer original)))))) +(defun gnus-server-toggle-cloud-server () + "Make the server under point be replicated in the Emacs Cloud." + (interactive) + (let ((server (gnus-server-server-name))) + (unless server + (error "No server on the current line")) + + (unless (gnus-method-option-p server 'cloud) + (error "The server under point doesn't support cloudiness")) + + (if (gnus-cloud-server-p server) + (setq gnus-cloud-covered-servers + (delete server gnus-cloud-covered-servers)) + (push server gnus-cloud-covered-servers)) + + (gnus-server-update-server server) + (gnus-message 1 (if (gnus-cloud-server-p server) + "Replication of %s in the cloud will start" + "Replication of %s in the cloud will stop") + server))) + (provide 'gnus-srvr) ;;; gnus-srvr.el ends here diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 496e5775bb6..aa2568d5559 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -30,6 +30,7 @@ (require 'gnus-spec) (require 'gnus-range) (require 'gnus-util) +(require 'gnus-cloud) (autoload 'message-make-date "message") (autoload 'gnus-agent-read-servers-validate "gnus-agent") (autoload 'gnus-agent-save-local "gnus-agent") @@ -441,6 +442,15 @@ See also `gnus-before-startup-hook'." :group 'gnus-newsrc :type 'hook) +(defcustom gnus-save-newsrc-file-check-timestamp nil + "Check the modification time of the newsrc.eld file before saving it. +When the newsrc.eld file is updated by multiple machines, +checking the file's modification time is a good way to avoid +overwriting updated data." + :version "25.1" + :group 'gnus-newsrc + :type 'boolean) + (defcustom gnus-save-newsrc-hook nil "A hook called before saving any of the newsrc files." :group 'gnus-newsrc @@ -888,6 +898,11 @@ If REGEXP is given, lines that match it will be deleted." (setq buffer-save-without-query t) (erase-buffer) (setq buffer-file-name dribble-file) + ;; The buffer may be shrunk a lot when deleting old entries. + ;; It caused the auto-saving to stop. + (if (featurep 'emacs) + (set (make-local-variable 'auto-save-include-big-deletions) t) + (set (make-local-variable 'disable-auto-save-when-buffer-shrinks) nil)) (auto-save-mode t) (buffer-disable-undo) (bury-buffer (current-buffer)) @@ -1461,7 +1476,7 @@ newsgroup." "Check whether a group has been activated or not. If SCAN, request a scan of that group as well. If METHOD, use that select method instead of determining the method based on the -group name. If DONT-CHECK, don't check check whether the group +group name. If DONT-CHECK, don't check whether the group actually exists. If DONT-SUB-CHECK or DONT-CHECK, don't let the backend check whether the group actually exists." (let ((method (or method (inline (gnus-find-method-for-group group)))) @@ -2777,6 +2792,7 @@ If FORCE is non-nil, the .newsrc file is read." 'msdos-long-file-names (lambda () t)))) +(defvar gnus-save-newsrc-file-last-timestamp nil) (defun gnus-save-newsrc-file (&optional force) "Save .newsrc file." ;; Note: We cannot save .newsrc file if all newsgroups are removed @@ -2815,12 +2831,30 @@ If FORCE is non-nil, the .newsrc file is read." (erase-buffer) (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) + ;; check timestamp of `gnus-current-startup-file'.eld against + ;; `gnus-save-newsrc-file-last-timestamp' + (when gnus-save-newsrc-file-check-timestamp + (let* ((checkfile (concat gnus-current-startup-file ".eld")) + (mtime (nth 5 (file-attributes checkfile)))) + (when (and gnus-save-newsrc-file-last-timestamp + (time-less-p gnus-save-newsrc-file-last-timestamp + mtime)) + (unless (y-or-n-p + (format "%s was updated externally after %s, save?" + checkfile + (format-time-string + "%c" + gnus-save-newsrc-file-last-timestamp))) + (error "Couldn't save %s: updated externally" checkfile))))) + (if gnus-save-startup-file-via-temp-buffer (let ((coding-system-for-write gnus-ding-file-coding-system) (standard-output (current-buffer))) (gnus-gnus-to-quick-newsrc-format) (gnus-run-hooks 'gnus-save-quick-newsrc-hook) - (save-buffer)) + (save-buffer) + (setq gnus-save-newsrc-file-last-timestamp + (nth 5 (file-attributes buffer-file-name)))) (let ((coding-system-for-write gnus-ding-file-coding-system) (version-control gnus-backup-startup-file) (startup-file (concat gnus-current-startup-file ".eld")) @@ -2855,7 +2889,9 @@ If FORCE is non-nil, the .newsrc file is read." ;; Replace the existing startup file with the temp file. (rename-file working-file startup-file t) - (gnus-set-file-modes startup-file setmodes))) + (gnus-set-file-modes startup-file setmodes) + (setq gnus-save-newsrc-file-last-timestamp + (nth 5 (file-attributes startup-file))))) (condition-case nil (delete-file working-file) (file-error nil))))) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 134fbd6fcff..efe7a4d3d65 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -24,9 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) (eval-when-compile @@ -2188,6 +2185,7 @@ increase the score of each group you read." (gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map) "w" gnus-article-decode-mime-words "c" gnus-article-decode-charset + "h" gnus-mime-buttonize-attachments-in-header "v" gnus-mime-view-all-parts "b" gnus-article-view-part) @@ -2394,6 +2392,8 @@ increase the score of each group you read." ["QP" gnus-article-de-quoted-unreadable t] ["Base64" gnus-article-de-base64-unreadable t] ["View MIME buttons" gnus-summary-display-buttonized t] + ["View MIME buttons in header" + gnus-mime-buttonize-attachments-in-header t] ["View all" gnus-mime-view-all-parts t] ["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t] ["Encrypt body" gnus-article-encrypt-body @@ -7334,6 +7334,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-group-is-exiting-without-update-p t) (quit-config (gnus-group-quit-config group))) (when (or no-questions + (gnus-ephemeral-group-p group) gnus-expert-user (gnus-y-or-n-p "Discard changes to this group and exit? ")) (gnus-async-halt-prefetch) @@ -9085,6 +9086,41 @@ non-numeric or nil fetch the number specified by the (gnus-summary-limit-include-thread id))) (gnus-summary-show-thread)) +(defun gnus-summary-open-group-with-article (message-id) + "Open a group containing the article with the given MESSAGE-ID." + (interactive "sMessage-ID: ") + (require 'nndoc) + (with-temp-buffer + ;; Prepare a dummy article + (erase-buffer) + (insert "From nobody Tue Sep 13 22:05:34 2011\n\n") + + ;; Prepare pretty modelines for summary and article buffers + (let ((gnus-summary-mode-line-format "Found %G") + (gnus-article-mode-line-format + ;; Group names just get in the way here, especially the + ;; abbreviated ones + (if (string-match "%[gG]" gnus-article-mode-line-format) + (concat (substring gnus-article-mode-line-format + 0 (match-beginning 0)) + (substring gnus-article-mode-line-format (match-end 0))) + gnus-article-mode-line-format))) + + ;; Build an ephemeral group containing the dummy article (hidden) + (gnus-group-read-ephemeral-group + message-id + `(nndoc ,message-id + (nndoc-address ,(current-buffer)) + (nndoc-article-type mbox)) + :activate + (cons (current-buffer) gnus-current-window-configuration) + (not :request-only) + '(-1) ; :select-articles + (not :parameters) + 0)) ; :number + ;; Fetch the desired article + (gnus-summary-refer-article message-id))) + (defun gnus-summary-refer-article (message-id) "Fetch an article specified by MESSAGE-ID." (interactive "sMessage-ID: ") @@ -9298,7 +9334,7 @@ Obeys the standard process/prefix convention." ((gnus-group-read-ephemeral-group (setq vgroup (format "nnvirtual:%s-%s" gnus-newsgroup-name - (format-time-string "%Y%m%dT%H%M%S" (current-time)))) + (format-time-string "%Y%m%dT%H%M%S"))) `(nnvirtual ,vgroup (nnvirtual-component-groups ,groups)) t (cons (current-buffer) 'summary))) @@ -9748,6 +9784,8 @@ If ARG is a negative number, turn header display off." (declare-function article-narrow-to-head "gnus-art" ()) (declare-function gnus-article-hidden-text-p "gnus-art" (type)) (declare-function gnus-delete-wash-type "gnus-art" (type)) +(declare-function gnus-mime-buttonize-attachments-in-header + "gnus-art" (&optional interactive)) (defun gnus-summary-toggle-header (&optional arg) "Show the headers if they are hidden, or hide them if they are shown. @@ -9779,7 +9817,10 @@ If ARG is a negative number, hide the unwanted header lines." (gnus-treat-hide-boring-headers nil)) (gnus-delete-wash-type 'headers) (gnus-treat-article 'head)) - (gnus-treat-article 'head)) + (gnus-treat-article 'head) + ;; Add attachment buttons to the header. + (when gnus-mime-display-attachment-buttons-in-header + (gnus-mime-buttonize-attachments-in-header))) (widen) (if window (set-window-start window (goto-char (point-min)))) @@ -9829,6 +9870,7 @@ installed for this command to work." (if (not (and (condition-case nil (require 'idna) (file-error)) (mm-coding-system-p 'utf-8) + (symbol-value 'idna-program) (executable-find (symbol-value 'idna-program)))) (gnus-message 5 "GNU Libidn not installed properly (`idn' or `idna.el' missing)") @@ -10404,13 +10446,19 @@ This will be the case if the article has both been mailed and posted." (when (and (not (memq article es)) (gnus-data-find article)) (gnus-summary-mark-article article gnus-canceled-mark) - (run-hook-with-args 'gnus-summary-article-expire-hook - 'delete - (gnus-data-header - (assoc article (gnus-data-list nil))) - gnus-newsgroup-name - nil - nil))))))) + (run-hook-with-args + 'gnus-summary-article-expire-hook + 'delete + (gnus-data-header (assoc article (gnus-data-list nil))) + gnus-newsgroup-name + (cond + ((stringp nnmail-expiry-target) nnmail-expiry-target) + ((eq nnmail-expiry-target 'delete) nil) + (t + (let ((rescall (funcall nnmail-expiry-target + gnus-newsgroup-name))) + (if (stringp rescall) rescall nil)))) + nil))))))) (gnus-message 6 "Expiring articles...done"))))) (defun gnus-summary-expire-articles-now () @@ -10573,7 +10621,7 @@ groups." (let ((lines (count-lines (point) (point-max))) (length (- (point-max) (point))) (case-fold-search t) - (body (copy-marker (point)))) + (body (point-marker))) (goto-char (point-min)) (when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t) (delete-region (match-beginning 1) (match-end 1)) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index d0df070bcdb..7bacaba286d 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -32,9 +32,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) @@ -316,14 +313,10 @@ Symbols are also allowed; their print names are used instead." ;; Every version of Emacs Gnus supports has built-in float-time. ;; The featurep test silences an irritating compiler warning. -(eval-and-compile +(defalias 'gnus-float-time (if (or (featurep 'emacs) (fboundp 'float-time)) - (defalias 'gnus-float-time 'float-time) - (defun gnus-float-time (&optional time) - "Convert time value TIME to a floating point number. -TIME defaults to the current time." - (time-to-seconds (or time (current-time)))))) + 'float-time 'time-to-seconds)) ;;; Keymap macros. @@ -392,19 +385,20 @@ TIME defaults to the current time." (defun gnus-seconds-today () "Return the number of seconds passed today." - (let ((now (decode-time (current-time)))) + (let ((now (decode-time))) (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)))) (defun gnus-seconds-month () "Return the number of seconds passed this month." - (let ((now (decode-time (current-time)))) + (let ((now (decode-time))) (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600) (* (- (car (nthcdr 3 now)) 1) 3600 24)))) (defun gnus-seconds-year () "Return the number of seconds passed this year." - (let ((now (decode-time (current-time))) - (days (format-time-string "%j" (current-time)))) + (let* ((current (current-time)) + (now (decode-time current)) + (days (format-time-string "%j" current))) (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600) (* (- (string-to-number days) 1) 3600 24)))) @@ -1913,17 +1907,25 @@ Sizes are in pixels." image))) image))) +(eval-when-compile (require 'gmm-utils)) (defun gnus-recursive-directory-files (dir) - "Return all regular files below DIR." - (let (files) - (dolist (file (directory-files dir t)) - (when (and (not (member (file-name-nondirectory file) '("." ".."))) - (file-readable-p file)) - (cond - ((file-regular-p file) - (push file files)) - ((file-directory-p file) - (setq files (append (gnus-recursive-directory-files file) files)))))) + "Return all regular files below DIR. +The first found will be returned if a file has hard or symbolic links." + (let (files attr attrs) + (gmm-labels + ((fn (directory) + (dolist (file (directory-files directory t)) + (setq attr (file-attributes (file-truename file))) + (when (and (not (member attr attrs)) + (not (member (file-name-nondirectory file) + '("." ".."))) + (file-readable-p file)) + (push attr attrs) + (cond ((file-regular-p file) + (push file files)) + ((file-directory-p file) + (fn file))))))) + (fn dir)) files)) (defun gnus-list-memq-of-list (elements list) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index e43b48fd6f6..30c89f5906f 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -29,10 +29,6 @@ (eval '(run-hooks 'gnus-load-hook)) -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'wid-edit) (require 'mm-util) @@ -309,6 +305,7 @@ be set in `.emacs' instead." (unless (featurep 'gnus-xmas) (defalias 'gnus-make-overlay 'make-overlay) + (defalias 'gnus-copy-overlay 'copy-overlay) (defalias 'gnus-delete-overlay 'delete-overlay) (defalias 'gnus-overlay-get 'overlay-get) (defalias 'gnus-overlay-put 'overlay-put) @@ -316,6 +313,7 @@ be set in `.emacs' instead." (defalias 'gnus-overlay-buffer 'overlay-buffer) (defalias 'gnus-overlay-start 'overlay-start) (defalias 'gnus-overlay-end 'overlay-end) + (defalias 'gnus-overlays-at 'overlays-at) (defalias 'gnus-overlays-in 'overlays-in) (defalias 'gnus-extent-detached-p 'ignore) (defalias 'gnus-extent-start-open 'ignore) @@ -1615,7 +1613,7 @@ slower." :type 'string) (defcustom gnus-valid-select-methods - '(("nntp" post address prompt-address physical-address) + '(("nntp" post address prompt-address physical-address cloud) ("nnspool" post address) ("nnvirtual" post-mail virtual prompt-address) ("nnmbox" mail respool address) @@ -1632,7 +1630,7 @@ slower." ("nnrss" none global) ("nnagent" post-mail) ("nnimap" post-mail address prompt-address physical-address respool - server-marks) + server-marks cloud) ("nnmaildir" mail respool address server-marks) ("nnnil" none)) "*An alist of valid select methods. @@ -2704,7 +2702,10 @@ such as a mark that says whether an article is stored in the cache gnus-newsrc-last-checked-date gnus-newsrc-alist gnus-server-alist gnus-killed-list gnus-zombie-list - gnus-topic-topology gnus-topic-alist) + gnus-topic-topology gnus-topic-alist + gnus-cloud-sequence + gnus-cloud-covered-servers + gnus-cloud-file-timestamps) "Gnus variables saved in the quick startup file.") (defvar gnus-newsrc-alist nil diff --git a/lisp/gnus/gravatar.el b/lisp/gnus/gravatar.el index e55780acc6f..fc536495a0b 100644 --- a/lisp/gnus/gravatar.el +++ b/lisp/gnus/gravatar.el @@ -138,9 +138,7 @@ You can provide a list of argument to pass to CB in CBARGS." "Retrieve MAIL-ADDRESS gravatar and returns it." (let ((url (gravatar-build-url mail-address))) (if (gravatar-cache-expired url) - (with-current-buffer (if (featurep 'xemacs) - (url-retrieve url) - (url-retrieve-synchronously url)) + (with-current-buffer (url-retrieve-synchronously url) (when gravatar-automatic-caching (url-store-in-cache (current-buffer))) (let ((data (gravatar-data->image))) diff --git a/lisp/gnus/ietf-drums.el b/lisp/gnus/ietf-drums.el index 734ce676c00..e681ecfb3d6 100644 --- a/lisp/gnus/ietf-drums.el +++ b/lisp/gnus/ietf-drums.el @@ -206,7 +206,6 @@ backslash and doublequote.") (1+ (point)) (progn (forward-sexp 1) (1- (point)))))))) (t - (message "Unknown symbol: %c" c) (forward-char 1)))) ;; If we found no display-name, then we look for comments. (if display-name diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index 45512590677..eb05d714aba 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -24,10 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (require 'format-spec) (eval-when-compile (require 'cl) diff --git a/lisp/gnus/mailcap.el b/lisp/gnus/mailcap.el index 772024b5dce..01d8587f06a 100644 --- a/lisp/gnus/mailcap.el +++ b/lisp/gnus/mailcap.el @@ -153,6 +153,10 @@ This is a compatibility function for different Emacsen." (type . "application/zip") ("copiousoutput")) ("pdf" + (viewer . doc-view-mode) + (type . "application/pdf") + (test . (eq window-system 'x))) + ("pdf" (viewer . "gv -safer %s") (type . "application/pdf") (test . window-system) @@ -216,10 +220,6 @@ This is a compatibility function for different Emacsen." (test . (fboundp 'vm-mode)) (type . "message/rfc822")) ("rfc-*822" - (viewer . w3-mode) - (test . (fboundp 'w3-mode)) - (type . "message/rfc822")) - ("rfc-*822" (viewer . view-mode) (type . "message/rfc822"))) ("image" @@ -253,10 +253,6 @@ This is a compatibility function for different Emacsen." ("needsx11"))) ("text" ("plain" - (viewer . w3-mode) - (test . (fboundp 'w3-mode)) - (type . "text/plain")) - ("plain" (viewer . view-mode) (test . (fboundp 'view-mode)) (type . "text/plain")) @@ -267,10 +263,6 @@ This is a compatibility function for different Emacsen." (viewer . enriched-decode) (test . (fboundp 'enriched-decode)) (type . "text/enriched")) - ("html" - (viewer . mm-w3-prepare-buffer) - (test . (fboundp 'w3-prepare-buffer)) - (type . "text/html")) ("dns" (viewer . dns-mode) (test . (fboundp 'dns-mode)) @@ -1072,6 +1064,18 @@ If FORCE, re-parse even if already parsed." common-mime-info))))) commands)) +(defun mailcap-view-mime (type) + "View the data in the current buffer that has MIME type TYPE. +`mailcap-mime-data' determines the method to use." + (let ((method (mailcap-mime-info type))) + (if (stringp method) + (shell-command-on-region (point-min) (point-max) + ;; Use stdin as the "%s". + (format method "-") + (current-buffer) + t) + (funcall method)))) + (provide 'mailcap) ;;; mailcap.el ends here diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index c37b9397529..de7e9bab8ec 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -28,9 +28,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) @@ -50,6 +47,7 @@ (require 'mml) (require 'rfc822) (require 'format-spec) +(require 'dired) (autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/ @@ -606,7 +604,8 @@ Done before generating the new subject of a forward." regexp)) (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" - "*All headers that match this regexp will be deleted when forwarding a message." + "*All headers that match this regexp will be deleted when forwarding a message. +This may also be a list of regexps." :version "21.1" :group 'message-forwarding :type '(repeat :value-to-internal (lambda (widget value) @@ -616,6 +615,19 @@ Done before generating the new subject of a forward." (widget-editable-list-match widget value))) regexp)) +(defcustom message-forward-included-headers nil + "If non-nil, delete non-matching headers when forwarding a message. +Only headers that match this regexp will be included. This +variable should be a regexp or a list of regexps." + :version "25.1" + :group 'message-forwarding + :type '(repeat :value-to-internal (lambda (widget value) + (custom-split-regexp-maybe value)) + :match (lambda (widget value) + (or (stringp value) + (widget-editable-list-match widget value))) + regexp)) + (defcustom message-ignored-cited-headers "." "*Delete these headers from the messages you yank." :group 'message-insertion @@ -970,8 +982,8 @@ configuration. See the variable `gnus-cite-attribution-suffix'." (defcustom message-citation-line-format "On %a, %b %d %Y, %N wrote:\n" "Format of the \"Whomever writes:\" line. -The string is formatted using `format-spec'. The following -constructs are replaced: +The string is formatted using `format-spec'. The following constructs +are replaced: %f The full From, e.g. \"John Doe <john.doe@example.invalid>\". %n The mail address, e.g. \"john.doe@example.invalid\". @@ -979,11 +991,14 @@ constructs are replaced: back to the mail address. %F The first name if present, e.g.: \"John\". %L The last name if present, e.g.: \"Doe\". + %Z, %z The time zone in the numeric form, e.g.:\"+0000\". All other format specifiers are passed to `format-time-string' -which is called using the date from the article your replying to. -Extracting the first (%F) and last name (%L) is done -heuristically, so you should always check it yourself. +which is called using the date from the article your replying to, but +the date in the formatted string will be expressed in the author's +time zone as much as possible. +Extracting the first (%F) and last name (%L) is done heuristically, +so you should always check it yourself. Please also read the note in the documentation of `message-citation-line-function'." @@ -1741,13 +1756,17 @@ no, only reply back to the author." :type '(radio (const :format "%v " nil) (string :format "FQDN: %v"))) -(defcustom message-use-idna (and (condition-case nil (require 'idna) - (file-error)) - (mm-coding-system-p 'utf-8) - (executable-find idna-program) - (string= (idna-to-ascii "räksmörgås") - "xn--rksmrgs-5wao1o") - t) +(defcustom message-use-idna + (and (or (mm-coding-system-p 'utf-8) + (condition-case nil + (let (mucs-ignore-version-incompatibilities) + (require 'un-define)) + (error))) + (condition-case nil (require 'idna) (file-error)) + idna-program + (executable-find idna-program) + (string= (idna-to-ascii "räksmörgås") "xn--rksmrgs-5wao1o") + t) "Whether to encode non-ASCII in domain names into ASCII according to IDNA. GNU Libidn, and in particular the elisp package \"idna.el\" and the external program \"idn\", must be installed for this @@ -1904,7 +1923,45 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." "cat\\|com\\|coop\\|edu\\|gov\\|" "info\\|int\\|jobs\\|" "mil\\|mobi\\|museum\\|name\\|net\\|" - "org\\|pro\\|tel\\|travel\\|uucp\\)") + "org\\|pro\\|tel\\|travel\\|uucp\\|" + ;; ICANN-era generic top-level domains + "academy\\|actor\\|agency\\|airforce\\|archi\\|associates\\|axa\\|" + "bar\\|bargains\\|bayern\\|beer\\|berlin\\|best\\|bid\\|bike\\|" + "biz\\|black\\|blackfriday\\|blue\\|boutique\\|build\\|builders\\|" + "buzz\\|cab\\|camera\\|camp\\|capital\\|cards\\|care\\|career\\|" + "careers\\|cash\\|catering\\|center\\|ceo\\|cheap\\|christmas\\|" + "church\\|citic\\|cleaning\\|clinic\\|clothing\\|club\\|codes\\|" + "coffee\\|college\\|cologne\\|com\\|community\\|company\\|computer\\|" + "construction\\|contractors\\|cooking\\|cool\\|country\\|creditcard\\|" + "cruises\\|dance\\|dating\\|democrat\\|dental\\|desi\\|design\\|" + "diamonds\\|directory\\|discount\\|domains\\|education\\|email\\|" + "engineering\\|enterprises\\|equipment\\|estate\\|eus\\|events\\|" + "exchange\\|expert\\|exposed\\|fail\\|farm\\|feedback\\|finance\\|" + "financial\\|fish\\|fishing\\|fitness\\|flights\\|florist\\|foo\\|" + "foundation\\|frogans\\|fund\\|furniture\\|futbol\\|gal\\|" + "gallery\\|gift\\|glass\\|globo\\|gmo\\|gop\\|graphics\\|gratis\\|" + "gripe\\|guide\\|guitars\\|guru\\|hamburg\\|haus\\|hiphop\\|" + "holdings\\|holiday\\|homes\\|horse\\|house\\|immobilien\\|" + "industries\\|info\\|ink\\|institute\\|insure\\|international\\|" + "investments\\|jetzt\\|juegos\\|kaufen\\|kim\\|kitchen\\|kiwi\\|" + "koeln\\|kred\\|land\\|lat\\|latino\\|lease\\|life\\|lighting\\|" + "limited\\|limo\\|link\\|loans\\|london\\|luxe\\|luxury\\|" + "management\\|mango\\|marketing\\|media\\|meet\\|menu\\|miami\\|" + "moda\\|moe\\|monash\\|moscow\\|motorcycles\\|nagoya\\|name\\|" + "net\\|neustar\\|ninja\\|nyc\\|okinawa\\|onl\\|org\\|paris\\|" + "partners\\|parts\\|photo\\|photography\\|photos\\|pics\\|" + "pictures\\|pink\\|plumbing\\|pro\\|productions\\|properties\\|" + "pub\\|qpon\\|quebec\\|recipes\\|red\\|reisen\\|ren\\|rentals\\|" + "repair\\|report\\|rest\\|reviews\\|rich\\|rocks\\|rodeo\\|" + "ruhr\\|ryukyu\\|saarland\\|schule\\|scot\\|services\\|sexy\\|" + "shiksha\\|shoes\\|singles\\|social\\|sohu\\|solar\\|solutions\\|" + "soy\\|supplies\\|supply\\|support\\|surgery\\|systems\\|tattoo\\|" + "tax\\|technology\\|tienda\\|tips\\|today\\|tokyo\\|tools\\|" + "town\\|toys\\|trade\\|training\\|university\\|uno\\|vacations\\|" + "vegas\\|ventures\\|viajes\\|villas\\|vision\\|vodka\\|vote\\|" + "voting\\|voto\\|voyage\\|wang\\|watch\\|webcam\\|wed\\|wien\\|" + "wiki\\|works\\|wtc\\|wtf\\|xyz\\|yachts\\|yokohama\\|you\\|" + "zone\\)") ;; http://en.wikipedia.org/wiki/List_of_Internet_top-level_domains ;; http://en.wikipedia.org/wiki/GTLD ;; `approved, but not yet in operation': .xxx @@ -2249,7 +2306,7 @@ Leading \"Re: \" is not stripped by this function. Use the function ((not (string-match (concat "^[ \t]*" (regexp-quote new-subject) - " \t]*$") + "[ \t]*$") old-subject)) ; yes, it really is a new subject ;; delete eventual Re: prefix (setq old-subject @@ -2451,6 +2508,7 @@ With prefix-argument just set Follow-Up, don't cross-post." "Remove HEADER in the narrowed buffer. If IS-REGEXP, HEADER is a regular expression. If FIRST, only remove the first instance of the header. +If REVERSE, remove headers that doesn't match HEADER. Return the number of headers removed." (goto-char (point-min)) (let ((regexp (if is-regexp header (concat "^" (regexp-quote header) ":"))) @@ -3515,15 +3573,16 @@ Message buffers and is not meant to be called directly." (goto-char (point-max)) ;; Insert the signature. (unless (bolp) - (insert "\n")) + (newline)) (when message-signature-insert-empty-line - (insert "\n")) - (insert "-- \n") + (newline)) + (insert "-- ") + (newline) (if (eq signature t) (insert-file-contents signature-file) (insert signature)) (goto-char (point-max)) - (or (bolp) (insert "\n"))))) + (or (bolp) (newline))))) (defun message-insert-importance-high () "Insert header to mark message as important." @@ -3907,9 +3966,13 @@ This function uses `mail-citation-hook' if that is non-nil." (defvar gnus-extract-address-components) (autoload 'format-spec "format-spec") +(autoload 'gnus-date-get-time "gnus-util") -(defun message-insert-formatted-citation-line (&optional from date) +(defun message-insert-formatted-citation-line (&optional from date tz) "Function that inserts a formatted citation line. +The optional FROM, and DATE are strings containing the contents of +the From header and the Date header respectively. The optional TZ +is a number of seconds, overrides the time zone of DATE. See `message-citation-line-format'." ;; The optional args are for testing/debugging. They will disappear later. @@ -3917,7 +3980,7 @@ See `message-citation-line-format'." ;; (with-temp-buffer ;; (message-insert-formatted-citation-line ;; "John Doe <john.doe@example.invalid>" - ;; (current-time)) + ;; (message-make-date)) ;; (buffer-string)) (when (or message-reply-headers (and from date)) (unless from @@ -3934,28 +3997,43 @@ See `message-citation-line-format'." (net (car (cdr data))) (name-or-net (or (car data) (car (cdr data)) from)) - (replydate - (or - date - ;; We need Gnus functionality if the user wants date or time from - ;; the original article: - (when (string-match "%[^fnNFL]" message-citation-line-format) - (autoload 'gnus-date-get-time "gnus-util") - (gnus-date-get-time (mail-header-date message-reply-headers))))) + (time + (when (string-match "%[^fnNFL]" message-citation-line-format) + (cond ((numberp (car-safe date)) date) ;; backward compatibility + (date (gnus-date-get-time date)) + (t + (gnus-date-get-time + (setq date (mail-header-date message-reply-headers))))))) + (tz (or tz + (when (stringp date) + (nth 8 (parse-time-string date))))) (flist (let ((i ?A) lst) (when (stringp name) ;; Guess first name and last name: - (let* ((names (delq nil (mapcar (lambda (x) - (if (string-match "\\`\\(\\w\\|[-.]\\)+\\'" x) x nil)) - (split-string name "[ \t]+")))) - (count (length names))) - (cond ((= count 1) (setq fname (car names) - lname "")) - ((or (= count 2) (= count 3)) (setq fname (car names) - lname (mapconcat 'identity (cdr names) " "))) - ((> count 3) (setq fname (mapconcat 'identity (butlast names (- count 2)) " ") - lname (mapconcat 'identity (nthcdr 2 names) " "))) ) + (let* ((names (delq + nil + (mapcar + (lambda (x) + (if (string-match "\\`\\(\\w\\|[-.]\\)+\\'" + x) + x + nil)) + (split-string name "[ \t]+")))) + (count (length names))) + (cond ((= count 1) + (setq fname (car names) + lname "")) + ((or (= count 2) (= count 3)) + (setq fname (car names) + lname (mapconcat 'identity (cdr names) " "))) + ((> count 3) + (setq fname (mapconcat 'identity + (butlast names (- count 2)) + " ") + lname (mapconcat 'identity + (nthcdr 2 names) + " ")))) (when (string-match "\\(.*\\),\\'" fname) (let ((newlname (match-string 1 fname))) (setq fname lname lname newlname))))) @@ -3985,7 +4063,7 @@ See `message-citation-line-format'." (>= i ?a))) (push i lst) (push (condition-case nil - (format-time-string (format "%%%c" i) replydate) + (gmm-format-time-string (format "%%%c" i) time tz) (error (format ">%c<" i))) lst)) (setq i (1+ i))) @@ -5514,7 +5592,7 @@ If NOW, use that time instead." "Make date string for the Expires header. Expiry in DAYS days. In posting styles use `(\"Expires\" (make-expires-date 30))'." - (let* ((cur (decode-time (current-time))) + (let* ((cur (decode-time)) (nday (+ days (nth 3 cur)))) (setf (nth 3 cur) nday) (message-make-date (apply 'encode-time cur)))) @@ -5771,7 +5849,7 @@ give as trustworthy answer as possible." (defun message-make-fqdn () "Return user's fully qualified domain name." - (let* ((system-name (system-name)) + (let* ((sysname (system-name)) (user-mail (message-user-mail-address)) (user-domain (if (and user-mail @@ -5785,10 +5863,10 @@ give as trustworthy answer as possible." (not (string-match message-bogus-system-names message-user-fqdn))) ;; `message-user-fqdn' seems to be valid message-user-fqdn) - ((and (string-match message-valid-fqdn-regexp system-name) - (not (string-match message-bogus-system-names system-name))) + ((and (string-match message-valid-fqdn-regexp sysname) + (not (string-match message-bogus-system-names sysname))) ;; `system-name' returned the right result. - system-name) + sysname) ;; Try `mail-host-address'. ((and (boundp 'mail-host-address) (stringp mail-host-address) @@ -5803,7 +5881,7 @@ give as trustworthy answer as possible." user-domain) ;; Default to this bogus thing. (t - (concat system-name + (concat sysname ".i-did-not-set--mail-host-address--so-tickle-me"))))) (defun message-make-domain () @@ -7374,17 +7452,25 @@ Optional DIGEST will use digest to forward." (message-remove-ignored-headers b e))) (defun message-remove-ignored-headers (b e) - (when message-forward-ignored-headers + (when (or message-forward-ignored-headers + message-forward-included-headers) (save-restriction (narrow-to-region b e) (goto-char b) (narrow-to-region (point) (or (search-forward "\n\n" nil t) (point))) - (let ((ignored (if (stringp message-forward-ignored-headers) - (list message-forward-ignored-headers) - message-forward-ignored-headers))) - (dolist (elem ignored) - (message-remove-header elem t)))))) + (when message-forward-ignored-headers + (let ((ignored (if (stringp message-forward-ignored-headers) + (list message-forward-ignored-headers) + message-forward-ignored-headers))) + (dolist (elem ignored) + (message-remove-header elem t)))) + (when message-forward-included-headers + (message-remove-header + (if (listp message-forward-included-headers) + (regexp-opt message-forward-included-headers) + message-forward-included-headers) + t nil t))))) (defun message-forward-make-body-mime (forward-buffer &optional beg end) (let ((b (point))) @@ -7432,8 +7518,7 @@ Optional DIGEST will use digest to forward." (goto-char (point-max)))) (setq e (point)) (insert "<#/mml>\n") - (when (and (not message-forward-decoded-p) - message-forward-ignored-headers) + (when (not message-forward-decoded-p) (message-remove-ignored-headers b e)))) (defun message-forward-make-body-digest-plain (forward-buffer) @@ -8421,6 +8506,17 @@ Used in `message-simplify-recipients'." (message-fetch-field hdr) t)) ", ")))) +;;; multipart/related and HTML support. + +(defun message-make-html-message-with-image-files (files) + (interactive (list (dired-get-marked-files nil current-prefix-arg))) + (message-mail) + (message-goto-body) + (insert "<#part type=text/html>\n\n") + (dolist (file files) + (insert (format "<img src=%S>\n\n" file))) + (message-goto-to)) + (when (featurep 'xemacs) (require 'messagexmas) (message-xmas-redefine)) diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index a6ec26e6ccb..4a25c1486a8 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el @@ -23,10 +23,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (require 'mm-util) (require 'rfc2047) (require 'mm-encode) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index a4fa56bc03d..f03b9c9b484 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -23,10 +23,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (require 'mail-parse) (require 'mm-bodies) (eval-when-compile (require 'cl)) @@ -124,7 +120,6 @@ ((executable-find "w3m") 'gnus-w3m) ((executable-find "links") 'links) ((executable-find "lynx") 'lynx) - ((locate-library "w3") 'w3) ((locate-library "html2text") 'html2text) (t nil)) "Render of HTML contents. @@ -136,13 +131,11 @@ The defined renderer types are: `w3m-standalone': use plain w3m; `links': use links; `lynx': use lynx; -`w3': use Emacs/W3; `html2text': use html2text; nil : use external viewer (default web browser)." :version "24.1" :type '(choice (const shr) (const gnus-w3m) - (const w3) (const w3m :tag "emacs-w3m") (const w3m-standalone :tag "standalone w3m" ) (const links) @@ -153,9 +146,9 @@ nil : use external viewer (default web browser)." :group 'mime-display) (defcustom mm-inline-text-html-with-images nil - "If non-nil, Gnus will allow retrieving images in HTML contents with -the <img> tags. It has no effect on Emacs/w3. See also the -documentation for the `mm-w3m-safe-url-regexp' variable." + "If non-nil, Gnus will allow retrieving images in HTML that has <img> tags. +See also the documentation for the `mm-w3m-safe-url-regexp' +variable." :version "22.1" :type 'boolean :group 'mime-display) @@ -654,7 +647,7 @@ MIME-Version header before proceeding." (unless from (setq from (mail-fetch-field "from"))) ;; FIXME: In some circumstances, this code is running within - ;; an unibyte macro. mail-extract-address-components + ;; a unibyte macro. mail-extract-address-components ;; creates unibyte buffers. This `if', though not a perfect ;; solution, avoids most of them. (if from @@ -828,7 +821,6 @@ external if displayed external." 'inline) ((and (mm-inlinable-p ehandle) (mm-inlined-p ehandle)) - (forward-line 1) (mm-display-inline handle) 'inline) ((or method @@ -841,18 +833,18 @@ external if displayed external." 'inline) (setq external (and method ;; If nil, we always use "save". - (stringp method) ;; 'mailcap-save-binary-file (or (eq mm-enable-external t) (and (eq mm-enable-external 'ask) (y-or-n-p (concat "Display part (" type - ") using external program" - ;; Can non-string method ever happen? + ") " (if (stringp method) (concat - " \"" (format method filename) "\"") - "") + "using external program \"" + (format method filename) "\"") + (format + "by calling `%s' on the contents)" method)) "? ")))))) (if external (mm-display-external @@ -893,7 +885,15 @@ external if displayed external." (mm-handle-media-type handle) t)))) (unwind-protect (if method - (funcall method) + (progn + (when (and (boundp 'gnus-summary-buffer) + (bufferp gnus-summary-buffer) + (buffer-name gnus-summary-buffer)) + ;; So that we pop back to the right place, sortof. + (switch-to-buffer gnus-summary-buffer) + (switch-to-buffer mm)) + (delete-other-windows) + (funcall method)) (mm-save-part handle)) (when (and (not non-viewer) method) @@ -1822,6 +1822,7 @@ If RECURSIVE, search recursively." ;; Require since we bind its variables. (require 'shr) (let ((article-buffer (current-buffer)) + (shr-width fill-column) (shr-content-function (lambda (id) (let ((handle (mm-get-content-id id))) (when handle @@ -1875,7 +1876,7 @@ If RECURSIVE, search recursively." handle `(lambda () (let ((inhibit-read-only t)) - (delete-region ,(point-min-marker) + (delete-region ,(copy-marker (point-min) t) ,(point-max-marker)))))))) (defvar shr-map) diff --git a/lisp/gnus/mm-extern.el b/lisp/gnus/mm-extern.el index 2fb75725799..1ddcf0df556 100644 --- a/lisp/gnus/mm-extern.el +++ b/lisp/gnus/mm-extern.el @@ -24,10 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'mm-util) diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index b2cbf1a3fa2..6d5f2a34c79 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -21,7 +21,7 @@ ;;; Commentary: -;; Some codes are stolen from w3 and url packages. Some are moved from +;; Some code is stolen from w3 and url packages. Some are moved from ;; nnweb. ;; TODO: Support POST, cookie. @@ -264,8 +264,6 @@ This is taken from RFC 2396.") (require 'url-parse) (require 'url-vars)) (error nil)) - ;; w3-4.0pre0.46 or earlier version. - (require 'w3-vars) (require 'url))) ;;;###autoload @@ -416,13 +414,51 @@ spaces. Die Die Die." (autoload 'mml-compute-boundary "mml") +(defun mm-url-encode-multipart-form-data (pairs &optional boundary) + "Return PAIRS encoded in multipart/form-data." + ;; RFC1867 + ;; Get a good boundary + (unless boundary + (setq boundary (mml-compute-boundary '()))) + (concat + ;; Start with the boundary + "--" boundary "\r\n" + ;; Create name value pairs + (mapconcat + 'identity + ;; Delete any returned items that are empty + (delq nil + (mapcar (lambda (data) + (cond ((equal (car data) "file") + ;; For each pair + (format + ;; Encode the name + "Content-Disposition: form-data; name=%S; filename=%S\r\nContent-Type: text/plain; charset=utf-8\r\nContent-Transfer-Encoding: binary\r\n\r\n%s" + (cdr (assoc "name" (cdr data))) (cdr (assoc "filename" (cdr data))) + (cond ((stringp (cdr (assoc "filedata" (cdr data)))) + (cdr (assoc "filedata" (cdr data)))) + ((integerp (cdr (assoc "filedata" (cdr data)))) + (number-to-string (cdr (assoc "filedata" (cdr data)))))))) + ((equal (car data) "submit") + "Content-Disposition: form-data; name=\"submit\"\r\n\r\nSubmit\r\n") + (t + (format + "Content-Disposition: form-data;name=%S\r\n\r\n%s\r\n" + (car data) (concat (mm-url-form-encode-xwfu (cdr data))) + )))) + pairs)) + ;; use the boundary as a separator + (concat "\r\n--" boundary "\r\n")) + ;; put a boundary at the end. + "--" boundary "--\r\n")) + (defun mm-url-remove-markup () "Remove all HTML markup, leaving just plain text." (goto-char (point-min)) (while (search-forward "<!--" nil t) (delete-region (match-beginning 0) - (or (search-forward "-->" nil t) - (point-max)))) + (or (search-forward "-->" nil t) + (point-max)))) (goto-char (point-min)) (while (re-search-forward "<[^>]+>" nil t) (replace-match "" t t))) diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index c0aeec40488..b2e0ee66d9c 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -23,10 +23,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'mail-prsvr) @@ -1247,6 +1243,7 @@ evaluating FORMS but it is no longer done. So, some programs assuming it if any may malfunction." (if (featurep 'xemacs) `(progn ,@forms) + (message "Warning: Using brain-dead macro `mm-with-unibyte-current-buffer'!") (let ((multibyte (make-symbol "multibyte"))) `(let ((,multibyte enable-multibyte-characters)) (when ,multibyte @@ -1257,6 +1254,7 @@ it if any may malfunction." (set-buffer-multibyte t))))))) (put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0) (put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body)) +(make-obsolete 'mm-with-unibyte-current-buffer nil "25.1") (defun mm-find-charset-region (b e) "Return a list of Emacs charsets in the region B to E." diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index a38504af36c..fa48ee97bcd 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -673,22 +673,34 @@ value of `mm-uu-text-plain-type'." (goto-char text-start) (re-search-forward "." start-point t))) (push - (mm-make-handle (mm-uu-copy-to-buffer text-start start-point) - mm-uu-text-plain-type) + (mm-make-handle + (mm-uu-copy-to-buffer + text-start + ;; A start-separator is likely accompanied by + ;; a leading newline. + (if (and (eq (char-before start-point) ?\n) + (eq (char-before (1- start-point)) ?\n)) + (1- start-point) + start-point)) + mm-uu-text-plain-type) result)) (push (funcall (mm-uu-function-extract entry)) result) (goto-char (setq text-start end-point)))) (when result - (if (and (> (point-max) (1+ text-start)) - (save-excursion - (goto-char text-start) - (re-search-forward "." nil t))) - (push - (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max)) - mm-uu-text-plain-type) - result)) + (goto-char text-start) + (when (re-search-forward "." nil t) + (push (mm-make-handle + (mm-uu-copy-to-buffer + ;; An end-separator is likely accompanied by + ;; a trailing newline. + (if (eq (char-after text-start) ?\n) + (1+ text-start) + text-start) + (point-max)) + mm-uu-text-plain-type) + result)) (setq result (cons "multipart/mixed" (nreverse result)))) result))) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index d7fe57b1a41..4b520edf1e2 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -22,9 +22,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) (require 'mail-parse) (require 'mailcap) @@ -51,7 +48,6 @@ (defvar mm-text-html-renderer-alist '((shr . mm-shr) - (w3 . mm-inline-text-html-render-with-w3) (w3m . mm-inline-text-html-render-with-w3m) (w3m-standalone . mm-inline-text-html-render-with-w3m-standalone) (gnus-w3m . gnus-article-html) @@ -100,19 +96,19 @@ (- (nth 3 edges) (nth 1 edges))))))) image)) b) - (insert "\n\n") + (insert "\n") (mm-handle-set-undisplayer handle `(lambda () (let ((b ,b) (inhibit-read-only t)) (remove-images b b) - (delete-region b (+ b 2))))))) + (delete-region b (1+ b))))))) (defun mm-inline-image-xemacs (handle) (when (featurep 'xemacs) - (insert "\n\n") - (forward-char -2) + (insert "\n") + (forward-char -1) (let ((annot (make-annotation (mm-get-image handle) nil 'text)) (inhibit-read-only t)) (mm-handle-set-undisplayer @@ -121,7 +117,7 @@ (let ((b ,(point-marker)) (inhibit-read-only t)) (delete-annotation ,annot) - (delete-region (- b 2) b)))) + (delete-region (1- b) b)))) (set-extent-property annot 'mm t) (set-extent-property annot 'duplicable t)))) @@ -130,91 +126,6 @@ (defalias 'mm-inline-image 'mm-inline-image-xemacs) (defalias 'mm-inline-image 'mm-inline-image-emacs))) -;; External. -(declare-function w3-do-setup "ext:w3" ()) -(declare-function w3-region "ext:w3-display" (st nd)) -(declare-function w3-prepare-buffer "ext:w3-display" (&rest args)) - -(defvar mm-w3-setup nil) -(defun mm-setup-w3 () - (unless mm-w3-setup - (require 'w3) - (w3-do-setup) - (require 'url) - (require 'w3-vars) - (require 'url-vars) - (setq mm-w3-setup t))) - -(defun mm-inline-text-html-render-with-w3 (handle) - (mm-setup-w3) - (let ((text (mm-get-part handle)) - (b (point)) - (url-standalone-mode t) - (url-gateway-unplugged t) - (w3-honor-stylesheets nil) - (url-current-object - (url-generic-parse-url (format "cid:%s" (mm-handle-id handle)))) - (width (window-width)) - (charset (mail-content-type-get - (mm-handle-type handle) 'charset))) - (save-excursion - (insert (if charset (mm-decode-string text charset) text)) - (save-restriction - (narrow-to-region b (point)) - (unless charset - (goto-char (point-min)) - (when (or (and (boundp 'w3-meta-content-type-charset-regexp) - (re-search-forward - w3-meta-content-type-charset-regexp nil t)) - (and (boundp 'w3-meta-charset-content-type-regexp) - (re-search-forward - w3-meta-charset-content-type-regexp nil t))) - (setq charset - (let ((bsubstr (buffer-substring-no-properties - (match-beginning 2) - (match-end 2)))) - (if (fboundp 'w3-coding-system-for-mime-charset) - (w3-coding-system-for-mime-charset bsubstr) - (mm-charset-to-coding-system bsubstr nil t)))) - (delete-region (point-min) (point-max)) - (insert (mm-decode-string text charset)))) - (save-window-excursion - (save-restriction - (let ((w3-strict-width width) - ;; Don't let w3 set the global version of - ;; this variable. - (fill-column fill-column)) - (if (or debug-on-error debug-on-quit) - (w3-region (point-min) (point-max)) - (condition-case () - (w3-region (point-min) (point-max)) - (error - (delete-region (point-min) (point-max)) - (let ((b (point)) - (charset (mail-content-type-get - (mm-handle-type handle) 'charset))) - (if (or (eq charset 'gnus-decoded) - (eq mail-parse-charset 'gnus-decoded)) - (save-restriction - (narrow-to-region (point) (point)) - (mm-insert-part handle) - (goto-char (point-max))) - (insert (mm-decode-string (mm-get-part handle) - charset)))) - (message - "Error while rendering html; showing as text/plain"))))))) - (mm-handle-set-undisplayer - handle - `(lambda () - (let ((inhibit-read-only t)) - ,@(if (functionp 'remove-specifier) - '((dolist (prop '(background background-pixmap foreground)) - (remove-specifier - (face-property 'default prop) - (current-buffer))))) - (delete-region ,(point-min-marker) - ,(point-max-marker))))))))) - (defvar mm-w3m-setup nil "Whether gnus-article-mode has been setup to use emacs-w3m.") @@ -306,7 +217,7 @@ handle `(lambda () (let ((inhibit-read-only t)) - (delete-region ,(point-min-marker) + (delete-region ,(copy-marker (point-min) t) ,(point-max-marker))))))))) (defvar mm-w3m-standalone-supports-m17n-p (if (featurep 'mule) 'undecided) @@ -480,7 +391,7 @@ handle `(lambda () (let ((inhibit-read-only t)) - (delete-region ,(point-min-marker) + (delete-region ,(copy-marker (point-min) t) ,(point-max-marker)))))))) (defun mm-insert-inline (handle text) @@ -493,19 +404,12 @@ handle `(lambda () (let ((inhibit-read-only t)) - (delete-region ,(copy-marker b) - ,(copy-marker (point)))))))) + (delete-region ,(copy-marker b t) + ,(point-marker))))))) (defun mm-inline-audio (handle) (message "Not implemented")) -(defun mm-w3-prepare-buffer () - (require 'w3) - (let ((url-standalone-mode t) - (url-gateway-unplugged t) - (w3-honor-stylesheets nil)) - (w3-prepare-buffer))) - (defun mm-view-message () (mm-enable-multibyte) (let (handles) @@ -609,16 +513,20 @@ If MODE is not set, try to find mode automatically." (set (make-local-variable 'enable-local-variables) nil) (with-demoted-errors (if mode - (funcall mode) + (save-window-excursion + (switch-to-buffer (current-buffer)) + (funcall mode)) (let ((auto-mode-alist (delq (rassq 'doc-view-mode-maybe auto-mode-alist) (copy-sequence auto-mode-alist)))) (set-auto-mode))) ;; The mode function might have already turned on font-lock. ;; Do not fontify if the guess mode is fundamental. - (unless (or (symbol-value 'font-lock-mode) + (unless (or font-lock-mode (eq major-mode 'fundamental-mode)) - (font-lock-fontify-buffer)))) + (if (fboundp 'font-lock-ensure) + (font-lock-ensure) + (font-lock-fontify-buffer))))) ;; By default, XEmacs font-lock uses non-duplicable text ;; properties. This code forces all the text properties ;; to be copied along with the text. diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index abc5601a2bc..58d3b4680b9 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -24,10 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'smime) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 26d67cef6e3..2a3b228097a 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -22,16 +22,13 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (require 'mm-util) (require 'mm-bodies) (require 'mm-encode) (require 'mm-decode) (require 'mml-sec) (eval-when-compile (require 'cl)) +(eval-when-compile (require 'url)) (eval-when-compile (when (featurep 'xemacs) (require 'easy-mmode))) ; for `define-minor-mode' @@ -465,6 +462,9 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (defvar mml-multipart-number 0) (defvar mml-inhibit-compute-boundary nil) +(declare-function libxml-parse-html-region "xml.c" + (start end &optional base-url)) + (defun mml-generate-mime (&optional multipart-type) "Generate a MIME message based on the current MML document. MULTIPART-TYPE defaults to \"mixed\", but can also @@ -474,19 +474,69 @@ be \"related\" or \"alternate\"." (options message-options)) (if (not cont) nil + (when (and (consp (car cont)) + (= (length cont) 1) + (fboundp 'libxml-parse-html-region) + (equal (cdr (assq 'type (car cont))) "text/html")) + (setq cont (mml-expand-html-into-multipart-related (car cont)))) (prog1 (mm-with-multibyte-buffer (setq message-options options) - (if (and (consp (car cont)) - (= (length cont) 1)) - (mml-generate-mime-1 (car cont)) + (cond + ((and (consp (car cont)) + (= (length cont) 1)) + (mml-generate-mime-1 (car cont))) + ((eq (car cont) 'multipart) + (mml-generate-mime-1 cont)) + (t (mml-generate-mime-1 (nconc (list 'multipart (cons 'type (or multipart-type "mixed"))) - cont))) + cont)))) (setq options message-options) (buffer-string)) (setq message-options options))))) +(defun mml-expand-html-into-multipart-related (cont) + (let ((new-parts nil) + (cid 1)) + (mm-with-multibyte-buffer + (insert (cdr (assq 'contents cont))) + (goto-char (point-min)) + (with-syntax-table mml-syntax-table + (while (re-search-forward "<img\\b" nil t) + (goto-char (match-beginning 0)) + (let* ((start (point)) + (img (nth 2 + (nth 2 + (libxml-parse-html-region + (point) (progn (forward-sexp) (point)))))) + (end (point)) + (parsed (url-generic-parse-url (cdr (assq 'src (cadr img)))))) + (when (and (null (url-type parsed)) + (url-filename parsed) + (file-exists-p (url-filename parsed))) + (goto-char start) + (when (search-forward (url-filename parsed) end t) + (let ((cid (format "fsf.%d" cid))) + (replace-match (concat "cid:" cid) t t) + (push (list cid (url-filename parsed)) new-parts)) + (setq cid (1+ cid))))))) + ;; We have local images that we want to include. + (if (not new-parts) + (list cont) + (setcdr (assq 'contents cont) (buffer-string)) + (setq cont + (nconc (list 'multipart (cons 'type "related")) + (list cont))) + (dolist (new-part (nreverse new-parts)) + (setq cont + (nconc cont + (list `(part (type . "image/png") + (filename . ,(nth 1 new-part)) + (id . ,(concat "<" (nth 0 new-part) + ">"))))))) + cont)))) + (defun mml-generate-mime-1 (cont) (let ((mm-use-ultra-safe-encoding (or mm-use-ultra-safe-encoding (assq 'sign cont)))) diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index a731df803fa..47d4407f689 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el @@ -26,9 +26,6 @@ ;;; Code: (eval-and-compile - ;; For Emacs <22.2 and XEmacs. - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))) - (if (locate-library "password-cache") (require 'password-cache) (require 'password))) diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index a5438f7b1c7..5104cea5abb 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -28,9 +28,6 @@ ;;; Code: (eval-and-compile - ;; For Emacs <22.2 and XEmacs. - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))) - (if (locate-library "password-cache") (require 'password-cache) (require 'password))) @@ -51,12 +48,10 @@ ;; Then mml1991 would not need to require mml2015, and mml1991-use ;; could be removed. (defvar mml2015-use (or - (condition-case nil - (progn - (require 'epg-config) - (epg-check-configuration (epg-configuration)) - 'epg) - (error)) + (progn + (ignore-errors (require 'epg-config)) + (and (fboundp 'epg-check-configuration) + 'epg)) (progn (let ((abs-file (locate-library "pgg"))) ;; Don't load PGG if it is marked as obsolete diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el index cfae4df7867..0af547dfa1b 100644 --- a/lisp/gnus/nndraft.el +++ b/lisp/gnus/nndraft.el @@ -24,10 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (require 'nnheader) (require 'nnmail) (require 'gnus-start) diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index b716d3276be..2901d294242 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -28,10 +28,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (require 'nnheader) (require 'message) (require 'nnmail) diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index d237e02965f..2ce5cb8af5f 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -26,9 +26,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) (defvar nnmail-extra-headers) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 8ed5143b243..8e81abcf9c0 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -26,10 +26,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-and-compile (require 'nnheader) ;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for @@ -170,14 +166,21 @@ textual parts.") (nnimap-find-process-buffer nntp-server-buffer)) (defun nnimap-header-parameters () - (format "(UID RFC822.SIZE BODYSTRUCTURE %s)" - (format + (let (params) + (push "UID" params) + (push "RFC822.SIZE" params) + (when (nnimap-capability "X-GM-EXT-1") + (push "X-GM-LABELS" params)) + (push "BODYSTRUCTURE" params) + (push (format (if (nnimap-ver4-p) "BODY.PEEK[HEADER.FIELDS %s]" "RFC822.HEADER.LINES %s") (append '(Subject From Date Message-Id References In-Reply-To Xref) - nnmail-extra-headers)))) + nnmail-extra-headers)) + params) + (format "%s" (nreverse params)))) (deffoo nnimap-retrieve-headers (articles &optional group server fetch-old) (when group @@ -201,7 +204,7 @@ textual parts.") (defun nnimap-transform-headers () (goto-char (point-min)) - (let (article lines size string) + (let (article lines size string labels) (block nil (while (not (eobp)) (while (not (looking-at "\\* [0-9]+ FETCH")) @@ -236,6 +239,9 @@ textual parts.") t) (match-string 1))) (beginning-of-line) + (when (search-forward "X-GM-LABELS" (line-end-position) t) + (setq labels (ignore-errors (read (current-buffer))))) + (beginning-of-line) (when (search-forward "BODYSTRUCTURE" (line-end-position) t) (let ((structure (ignore-errors (read (current-buffer))))) @@ -255,6 +261,8 @@ textual parts.") (insert (format "Chars: %s\n" size))) (when lines (insert (format "Lines: %s\n" lines))) + (when labels + (insert (format "X-GM-LABELS: %s\n" labels))) ;; Most servers have a blank line after the headers, but ;; Davmail doesn't. (unless (re-search-forward "^\r$\\|^)\r?$" nil t) @@ -409,6 +417,7 @@ textual parts.") "*nnimap*" (current-buffer) nnimap-address (nnimap-map-port (car ports)) :type nnimap-stream + :warn-unless-encrypted t :return-list t :shell-command nnimap-shell-program :capability-command "1 CAPABILITY\r\n" @@ -628,6 +637,26 @@ textual parts.") (nnheader-ms-strip-cr) (cons group article))))))) +(deffoo nnimap-request-articles (articles &optional group server) + (when group + (setq group (nnimap-decode-gnus-group group))) + (with-current-buffer nntp-server-buffer + (let ((result (nnimap-change-group group server))) + (when result + (erase-buffer) + (with-current-buffer (nnimap-buffer) + (erase-buffer) + (when (nnimap-command + (if (nnimap-ver4-p) + "UID FETCH %s BODY.PEEK[]" + "UID FETCH %s RFC822.PEEK") + (nnimap-article-ranges (gnus-compress-sequence articles))) + (let ((buffer (current-buffer))) + (with-current-buffer nntp-server-buffer + (nnheader-insert-buffer-substring buffer) + (nnheader-ms-strip-cr))) + t)))))) + (defun nnimap-get-whole-article (article &optional command) (let ((result (nnimap-command @@ -775,43 +804,55 @@ textual parts.") articles active marks high low) (with-current-buffer nntp-server-buffer (when result - (if (and dont-check - (setq active (nth 2 (assoc group nnimap-current-infos)))) - (insert (format "211 %d %d %d %S\n" - (- (cdr active) (car active)) - (car active) - (cdr active) - group)) - (with-current-buffer (nnimap-buffer) - (erase-buffer) - (let ((group-sequence - (nnimap-send-command "SELECT %S" (utf7-encode group t))) - (flag-sequence - (nnimap-send-command "UID FETCH 1:* FLAGS"))) - (setf (nnimap-group nnimap-object) group) - (nnimap-wait-for-response flag-sequence) - (setq marks - (nnimap-flags-to-marks - (nnimap-parse-flags - (list (list group-sequence flag-sequence - 1 group "SELECT"))))) - (when (and info - marks) - (nnimap-update-infos marks (list info)) - (nnimap-store-info info (gnus-active (gnus-info-group info)))) - (goto-char (point-max)) - (let ((uidnext (nth 5 (car marks)))) - (setq high (or (if uidnext - (1- uidnext) - (nth 3 (car marks))) - 0) - low (or (nth 4 (car marks)) uidnext 1))))) - (erase-buffer) - (insert - (format - "211 %d %d %d %S\n" (1+ (- high low)) low high group))) + (when (or (not dont-check) + (not (setq active + (nth 2 (assoc group nnimap-current-infos))))) + (let ((sequences (nnimap-retrieve-group-data-early + server (list info)))) + (nnimap-finish-retrieve-group-infos server (list info) sequences + t) + (setq active (nth 2 (assoc group nnimap-current-infos))))) + (insert (format "211 %d %d %d %S\n" + (- (cdr active) (car active)) + (car active) + (cdr active) + group)) t)))) +(deffoo nnimap-request-scan-group (group &optional server info) + (setq group (nnimap-decode-gnus-group group)) + (let (marks high low) + (with-current-buffer (nnimap-buffer) + (erase-buffer) + (let ((group-sequence + (nnimap-send-command "SELECT %S" (utf7-encode group t))) + (flag-sequence + (nnimap-send-command "UID FETCH 1:* FLAGS"))) + (setf (nnimap-group nnimap-object) group) + (nnimap-wait-for-response flag-sequence) + (setq marks + (nnimap-flags-to-marks + (nnimap-parse-flags + (list (list group-sequence flag-sequence + 1 group "SELECT"))))) + (when (and info + marks) + (nnimap-update-infos marks (list info)) + (nnimap-store-info info (gnus-active (gnus-info-group info)))) + (goto-char (point-max)) + (let ((uidnext (nth 5 (car marks)))) + (setq high (or (if uidnext + (1- uidnext) + (nth 3 (car marks))) + 0) + low (or (nth 4 (car marks)) uidnext 1))))) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (insert + (format + "211 %d %d %d %S\n" (1+ (- high low)) low high group)) + t))) + (deffoo nnimap-request-create-group (group &optional server args) (setq group (nnimap-decode-gnus-group group)) (when (nnimap-change-group nil server) @@ -970,10 +1011,10 @@ textual parts.") (setq target nil)) (nnheader-message 7 "Expiring article %s:%d" group article)) (when target - (push article deleted-articles)))))))) + (push article deleted-articles)))))) + (setq deleted-articles (nreverse deleted-articles)))) ;; Change back to the current group again. (nnimap-change-group group server) - (setq deleted-articles (nreverse deleted-articles)) (nnimap-delete-article (gnus-compress-sequence deleted-articles)) deleted-articles)) @@ -1105,8 +1146,11 @@ If LIMIT, first try to limit the search to the N last articles." (setq group (caar (nnmail-article-group + ;; We don't really care about the article number, because + ;; that's determined by the IMAP server later. So just + ;; return the group name. `(lambda (group) - (nnml-active-number group ,server)))))) + (list (list group))))))) (setq group (nnimap-decode-gnus-group group)) (when (nnimap-change-group nil server) (nnmail-check-syntax) @@ -1354,7 +1398,8 @@ If LIMIT, first try to limit the search to the N last articles." command (nth 2 quirk)))) -(deffoo nnimap-finish-retrieve-group-infos (server infos sequences) +(deffoo nnimap-finish-retrieve-group-infos (server infos sequences + &optional dont-insert) (when (and sequences (nnimap-change-group nil server t) ;; Check that the process is still alive. @@ -1374,19 +1419,20 @@ If LIMIT, first try to limit the search to the N last articles." (nnimap-parse-flags (nreverse sequences))) infos) - ;; Finally, just return something resembling an active file in - ;; the nntp buffer, so that the agent can save the info, too. - (with-current-buffer nntp-server-buffer - (erase-buffer) - (dolist (info infos) - (let* ((group (gnus-info-group info)) - (active (gnus-active group))) - (when active - (insert (format "%S %d %d y\n" - (decode-coding-string - (gnus-group-real-name group) 'utf-8) - (cdr active) - (car active))))))))))) + (unless dont-insert + ;; Finally, just return something resembling an active file in + ;; the nntp buffer, so that the agent can save the info, too. + (with-current-buffer nntp-server-buffer + (erase-buffer) + (dolist (info infos) + (let* ((group (gnus-info-group info)) + (active (gnus-active group))) + (when active + (insert (format "%S %d %d y\n" + (decode-coding-string + (gnus-group-real-name group) 'utf-8) + (cdr active) + (car active)))))))))))) (defun nnimap-update-infos (flags infos) (dolist (info infos) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 87a46071e1c..6d111e89e80 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -171,10 +171,6 @@ ;;; Setup: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (require 'nnoo) (require 'gnus-group) (require 'message) @@ -288,6 +284,8 @@ is `(valuefunc member)'." (eval-when-compile (autoload 'nnimap-buffer "nnimap") (autoload 'nnimap-command "nnimap") + (autoload 'nnimap-capability "nnimap") + (autoload 'nnimap-wait-for-line "nnimap") (autoload 'nnimap-change-group "nnimap") (autoload 'nnimap-make-thread-query "nnimap") (autoload 'gnus-registry-action "gnus-registry") @@ -972,33 +970,52 @@ details on the language and supported extensions." (catch 'found (mapcar #'(lambda (group) - (let (artlist) - (condition-case () - (when (nnimap-change-group - (gnus-group-short-name group) server) - (with-current-buffer (nnimap-buffer) - (message "Searching %s..." group) - (let ((arts 0) - (result (nnimap-command "UID SEARCH %s" - (if (string= criteria "") - qstring - (nnir-imap-make-query - criteria qstring))))) - (mapc - (lambda (artnum) - (let ((artn (string-to-number artnum))) - (when (> artn 0) - (push (vector group artn 100) - artlist) - (when (assq 'shortcut query) - (throw 'found (list artlist))) - (setq arts (1+ arts))))) - (and (car result) - (cdr (assoc "SEARCH" (cdr result))))) - (message "Searching %s... %d matches" group arts))) - (message "Searching %s...done" group)) - (quit nil)) - (nreverse artlist))) + (let (artlist) + (condition-case () + (when (nnimap-change-group + (gnus-group-short-name group) server) + (with-current-buffer (nnimap-buffer) + (message "Searching %s..." group) + (let* ((arts 0) + (literal+ (nnimap-capability "LITERAL+")) + (search (split-string + (if (string= criteria "") + qstring + (nnir-imap-make-query + criteria qstring)) + "\n")) + (coding (upcase + (replace-regexp-in-string + "-\\(unix\\|dos\\|mac\\)" "" + (symbol-name + (cdr default-process-coding-system))))) + call result) + (setq call (nnimap-send-command + "UID SEARCH CHARSET %s %s" coding (pop search))) + (while search ; Non-ascii search terms + (unless literal+ + (nnimap-wait-for-line "^\\+\\(.*\\)\n")) + (process-send-string (get-buffer-process (current-buffer)) (pop search)) + (process-send-string (get-buffer-process (current-buffer)) + (if (nnimap-newlinep nnimap-object) + "\n" + "\r\n"))) + (setq result (nnimap-get-response call)) + (mapc + (lambda (artnum) + (let ((artn (string-to-number artnum))) + (when (> artn 0) + (push (vector group artn 100) + artlist) + (when (assq 'shortcut query) + (throw 'found (list artlist))) + (setq arts (1+ arts))))) + (and (car result) + (cdr (assoc "SEARCH" (cdr result))))) + (message "Searching %s... %d matches" group arts))) + (message "Searching %s...done" group)) + (quit nil)) + (nreverse artlist))) groups)))))) (defun nnir-imap-make-query (criteria qstring) @@ -1052,25 +1069,30 @@ In future the following will be added to the language: (defun nnir-imap-expr-to-imap (criteria expr) "Convert EXPR into an IMAP search expression on CRITERIA" ;; What sort of expression is this, eh? - (cond - ;; Simple string term - ((stringp expr) - (format "%s %S" criteria expr)) - ;; Trivial term: and - ((eq expr 'and) nil) - ;; Composite term: or expression - ((eq (car-safe expr) 'or) - (format "OR %s %s" - (nnir-imap-expr-to-imap criteria (second expr)) - (nnir-imap-expr-to-imap criteria (third expr)))) - ;; Composite term: just the fax, mam - ((eq (car-safe expr) 'not) - (format "NOT (%s)" (nnir-imap-query-to-imap criteria (rest expr)))) - ;; Composite term: just expand it all. - ((and (not (null expr)) (listp expr)) - (format "(%s)" (nnir-imap-query-to-imap criteria expr))) - ;; Complex value, give up for now. - (t (error "Unhandled input: %S" expr)))) + (let ((literal+ (nnimap-capability "LITERAL+"))) + (cond + ;; Simple string term + ((stringp expr) + (format "%s %S" criteria expr)) + ;; Trivial term: and + ((eq expr 'and) nil) + ;; Composite term: or expression + ((eq (car-safe expr) 'or) + (format "OR %s %s" + (nnir-imap-expr-to-imap criteria (second expr)) + (nnir-imap-expr-to-imap criteria (third expr)))) + ;; Composite term: just the fax, mam + ((eq (car-safe expr) 'not) + (format "NOT (%s)" (nnir-imap-query-to-imap criteria (rest expr)))) + ;; Composite term: non-ascii search term + ((numberp (car-safe expr)) + (format "%s {%d%s}\n%s" criteria (car expr) + (if literal+ "+" "") (second expr))) + ;; Composite term: just expand it all. + ((and (not (null expr)) (listp expr)) + (format "(%s)" (nnir-imap-query-to-imap criteria expr))) + ;; Complex value, give up for now. + (t (error "Unhandled input: %S" expr))))) (defun nnir-imap-parse-query (string) @@ -1112,6 +1134,11 @@ that the search language can then understand and use." ((eq term 'and) 'and) ;; negated term ((eq term 'not) (list 'not (nnir-imap-next-expr))) + ;; non-ascii search string + ((and (stringp term) + (not (= (string-bytes term) + (length term)))) + (list (string-bytes term) term)) ;; generic term (t term)))) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 41da89b56a8..62fcc2d8bd5 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -24,10 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'gnus) ; for macro gnus-kill-buffer, at least diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 7d33e511baa..21fa5b37aa4 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -59,10 +59,6 @@ ) ] -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (require 'nnheader) (require 'gnus) (require 'gnus-util) diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el index 5a01ce8c25c..96b40e5b845 100644 --- a/lisp/gnus/nnmairix.el +++ b/lisp/gnus/nnmairix.el @@ -417,7 +417,7 @@ Other back ends might or might not work.") (nnoo-define-basics nnmairix) -(gnus-declare-backend "nnmairix" 'mail 'address) +(gnus-declare-backend "nnmairix" 'mail 'address 'virtual) (deffoo nnmairix-open-server (server &optional definitions) ;; just set server variables diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 2d943a40351..ac9c5ffab2c 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -24,10 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'gnus) @@ -398,8 +394,8 @@ otherwise return nil." nnrss-compatible-encoding-alist))))) (mm-coding-system-p 'utf-8))) -(declare-function w3-parse-buffer "ext:w3-parse" (&optional buff)) - +(declare-function libxml-parse-html-region "xml.c" + (start end &optional base-url)) (defun nnrss-fetch (url &optional local) "Fetch URL and put it in a the expected Lisp structure." (mm-with-unibyte-buffer @@ -426,22 +422,14 @@ otherwise return nil." (mm-enable-multibyte)))) (goto-char (point-min)) - ;; Because xml-parse-region can't deal with anything that isn't - ;; xml and w3-parse-buffer can't deal with some xml, we have to - ;; parse with xml-parse-region first and, if that fails, parse - ;; with w3-parse-buffer. Yuck. Eventually, someone should find out - ;; why w3-parse-buffer fails to parse some well-formed xml and - ;; fix it. - (condition-case err1 (setq xmlform (xml-parse-region (point-min) (point-max))) (error (condition-case err2 - (setq htmlform (caddar (w3-parse-buffer - (current-buffer)))) + (setq htmlform (libxml-parse-html-region (point-min) (point-max))) (error (message "\ -nnrss: %s: Not valid XML %s and w3-parse doesn't work %s" +nnrss: %s: Not valid XML %s and libxml-parse-html-region doesn't work %s" url err1 err2))))) (if htmlform htmlform @@ -599,7 +587,7 @@ which RSS 2.0 allows." (defun nnrss-no-cache (url) "") -(defun nnrss-insert-w3 (url) +(defun nnrss-insert (url) (mm-with-unibyte-current-buffer (condition-case err (mm-url-insert url) @@ -614,8 +602,6 @@ which RSS 2.0 allows." (mm-url-decode-entities-nbsp) (buffer-string)))) -(defalias 'nnrss-insert 'nnrss-insert-w3) - (defun nnrss-mime-encode-string (string) (mm-with-multibyte-buffer (insert string) @@ -880,8 +866,7 @@ Careful with this on large documents!" (defun nnrss-extract-hrefs (data) "Recursively extract hrefs from a page's source. -DATA should be the output of `xml-parse-region' or -`w3-parse-buffer'." +DATA should be the output of `xml-parse-region'." (mapcar (lambda (ahref) (cdr (assoc 'href (cadr ahref)))) (nnrss-find-el 'a data))) diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index c00425b364f..0891dba0387 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -25,9 +25,7 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. (eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))) ;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for ;; `make-network-stream'. (unless (fboundp 'open-protocol-stream) @@ -1221,14 +1219,17 @@ If SEND-IF-FORCE, only send authinfo to the server if the nntp-authinfo-user user)) (unless (member user '(nil "")) (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user) - (when t ;???Should check if AUTHINFO succeeded - (nntp-send-command - "^2.*\r?\n" "AUTHINFO PASS" - (or passwd - nntp-authinfo-password - (setq nntp-authinfo-password - (read-passwd (format "NNTP (%s@%s) password: " - user nntp-address)))))))))) + (let ((result + (nntp-send-command + "^2.*\r?\n" "AUTHINFO PASS" + (or passwd + nntp-authinfo-password + (setq nntp-authinfo-password + (read-passwd (format "NNTP (%s@%s) password: " + user nntp-address))))))) + (if (not result) + (signal 'nntp-authinfo-rejected "Password rejected") + result)))))) ;;; Internal functions. diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el index 40e033f581a..a3d950aa2b5 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -99,7 +99,7 @@ component group will show up when you enter the virtual group.") (let ((vbuf (nnheader-set-temp-buffer (get-buffer-create " *virtual headers*"))) (carticles (nnvirtual-partition-sequence articles)) - (system-name (system-name)) + (sysname (system-name)) cgroup carticle article result prefix) (while carticles (setq cgroup (caar carticles)) @@ -151,7 +151,7 @@ component group will show up when you enter the virtual group.") ;; and clean up the xrefs. (princ article nntp-server-buffer) (nnvirtual-update-xref-header cgroup carticle - prefix system-name) + prefix sysname) (forward-line 1)) ) @@ -378,7 +378,7 @@ component group will show up when you enter the virtual group.") (mapc 'nnheader-insert-nov headers)))) -(defun nnvirtual-update-xref-header (group article prefix system-name) +(defun nnvirtual-update-xref-header (group article prefix sysname) "Edit current NOV header in current buffer to have an xref to the component group, and also server prefix any existing xref lines." ;; Move to beginning of Xref field, creating a slot if needed. (beginning-of-line) @@ -393,7 +393,7 @@ component group will show up when you enter the virtual group.") (forward-char -1) (delete-char 1)) - (insert "Xref: " system-name " " group ":") + (insert "Xref: " sysname " " group ":") (princ article (current-buffer)) (insert " ") diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index 66e8cb649f7..f53e314d1d8 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -22,8 +22,6 @@ ;;; Commentary: -;; Note: You need to have `w3' installed for some functions to work. - ;;; Code: (eval-when-compile (require 'cl)) @@ -38,7 +36,6 @@ (eval-and-compile (ignore-errors (require 'url))) -(autoload 'w3-parse-buffer "w3-parse") (nnoo-declare nnweb) @@ -441,7 +438,7 @@ Valid types include `google', `dejanews', and `gmane'.") t) (defun nnweb-google-identity (url) - "Return an unique identifier based on URL." + "Return a unique identifier based on URL." (if (string-match "selm=\\([^ &>]+\\)" url) (match-string 1 url) url)) @@ -527,7 +524,7 @@ Valid types include `google', `dejanews', and `gmane'.") url)) ;;; -;;; General web/w3 interface utility functions +;;; General web interface utility functions ;;; (defun nnweb-insert-html (parse) diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el index 34eb90ac863..4d9dfdaf2aa 100644 --- a/lisp/gnus/pop3.el +++ b/lisp/gnus/pop3.el @@ -561,6 +561,7 @@ Returns the process associated with the connection." 'tls) (t (or pop3-stream-type 'network))) + :warn-unless-encrypted t :capability-command "CAPA\r\n" :end-of-command "^\\(-ERR\\|+OK\\).*\n" :end-of-capability "^\\.\r?\n\\|^-ERR" diff --git a/lisp/gnus/registry.el b/lisp/gnus/registry.el index f636e8b36fc..55b83a8e889 100644 --- a/lisp/gnus/registry.el +++ b/lisp/gnus/registry.el @@ -25,11 +25,11 @@ ;; This library provides a general-purpose EIEIO-based registry ;; database with persistence, initialized with these fields: -;; version: a float, 0.1 currently (don't change it) +;; version: a float -;; max-hard: an integer, default 5000000 +;; max-size: an integer, default most-positive-fixnum -;; max-soft: an integer, default 50000 +;; prune-factor: a float between 0 and 1, default 0.1 ;; precious: a list of symbols @@ -57,14 +57,15 @@ ;; Note that whether a field has one or many pieces of data, the data ;; is always a list of values. -;; The user decides which fields are "precious", F2 for example. At -;; PRUNE TIME (when the :prune-function is called), the registry will -;; trim any entries without the F2 field until the size is :max-soft -;; or less. No entries with the F2 field will be removed at PRUNE -;; TIME. +;; The user decides which fields are "precious", F2 for example. When +;; the registry is pruned, any entries without the F2 field will be +;; removed until the size is :max-size * :prune-factor _less_ than the +;; maximum database size. No entries with the F2 field will be removed +;; at PRUNE TIME, which means it may not be possible to prune back all +;; the way to the target size. -;; When an entry is inserted, the registry will reject new entries -;; if they bring it over the max-hard limit, even if they have the F2 +;; When an entry is inserted, the registry will reject new entries if +;; they bring it over the :max-size limit, even if they have the F2 ;; field. ;; The user decides which fields are "tracked", F1 for example. Any @@ -82,28 +83,32 @@ (require 'eieio) (require 'eieio-base) +;; The version number needs to be kept outside of the class definition +;; itself. The persistent-save process does *not* write to file any +;; slot values that are equal to the default :initform value. If a +;; database object is at the most recent version, therefore, its +;; version number will not be written to file. That makes it +;; difficult to know when a database needs to be upgraded. +(defvar registry-db-version 0.2 + "The current version of the registry format.") + (defclass registry-db (eieio-persistent) ((version :initarg :version - :initform 0.1 - :type float - :custom float + :initform nil + :type (or null float) :documentation "The registry version.") - (max-hard :initarg :max-hard - :initform 5000000 + (max-size :initarg :max-size + ;; :initform most-positive-fixnum ;; see below :type integer :custom integer - :documentation "Never accept more than this many elements.") - (max-soft :initarg :max-soft - :initform 50000 - :type integer - :custom integer - :documentation "Prune as much as possible to get to this size.") + :documentation "The maximum number of registry entries.") (prune-factor :initarg :prune-factor :initform 0.1 :type float :custom float - :documentation "At the max-hard limit, prune size * this entries.") + :documentation "Prune to \(:max-size * :prune-factor\) less + than the :max-size limit. Should be a float between 0 and 1.") (tracked :initarg :tracked :initform nil :type t @@ -118,6 +123,25 @@ (data :initarg :data :type hash-table :documentation "The data hashtable."))) +;; Do this separately, since defclass doesn't allow expressions in :initform. +(oset-default 'registry-db max-size most-positive-fixnum) + +(defmethod initialize-instance :BEFORE ((this registry-db) slots) + "Check whether a registry object needs to be upgraded." + ;; Hardcoded upgrade routines. Version 0.1 to 0.2 requires the + ;; :max-soft slot to disappear, and the :max-hard slot to be renamed + ;; :max-size. + (let ((current-version + (and (plist-member slots :version) + (plist-get slots :version)))) + (when (or (null current-version) + (eql current-version 0.1)) + (setq slots + (plist-put slots :max-size (plist-get slots :max-hard))) + (setq slots + (plist-put slots :version registry-db-version)) + (cl-remf slots :max-hard) + (cl-remf slots :max-soft)))) (defmethod initialize-instance :AFTER ((this registry-db) slots) "Set value of data slot of THIS after initialization." @@ -255,7 +279,7 @@ This is the key count of the :data slot." (defmethod registry-full ((db registry-db)) "Checks if registry-db THIS is full." (>= (registry-size db) - (oref db :max-hard))) + (oref db :max-size))) (defmethod registry-insert ((db registry-db) key entry) "Insert ENTRY under KEY into the registry-db THIS. @@ -267,7 +291,7 @@ Errors out if the key exists already." (assert (not (registry-full db)) nil - "registry max-hard size limit reached") + "registry max-size limit reached") ;; store the entry (puthash key entry (oref db :data)) @@ -300,58 +324,51 @@ Errors out if the key exists already." (registry-lookup-secondary-value db tr val value-keys)))) (oref db :data)))))) -(defmethod registry-prune ((db registry-db) &optional sortfun) - "Prunes the registry-db object THIS. -Removes only entries without the :precious keys if it can, -then removes oldest entries first. -Returns the number of deleted entries. -If SORTFUN is given, tries to keep entries that sort *higher*. -SORTFUN is passed only the two keys so it must look them up directly." - (dolist (collector '(registry-prune-soft-candidates - registry-prune-hard-candidates)) - (let* ((size (registry-size db)) - (collected (funcall collector db)) - (limit (nth 0 collected)) - (candidates (nth 1 collected)) - ;; sort the candidates if SORTFUN was given - (candidates (if sortfun (sort candidates sortfun) candidates)) - (candidates-count (length candidates)) - ;; are we over max-soft? - (prune-needed (> size limit))) - - ;; while we have more candidates than we need to remove... - (while (and (> candidates-count (- size limit)) candidates) - (decf candidates-count) - (setq candidates (cdr candidates))) - - (registry-delete db candidates nil) - (length candidates)))) - -(defmethod registry-prune-soft-candidates ((db registry-db)) - "Collects pruning candidates from the registry-db object THIS. -Proposes only entries without the :precious keys." +(defmethod registry-prune ((db registry-db) &optional sortfunc) + "Prunes the registry-db object DB. + +Attempts to prune the number of entries down to \(* +:max-size :prune-factor\) less than the max-size limit, so +pruning doesn't need to happen on every save. Removes only +entries without the :precious keys, so it may not be possible to +reach the target limit. + +Entries to be pruned are first sorted using SORTFUNC. Entries +from the front of the list are deleted first. + +Returns the number of deleted entries." + (let ((size (registry-size db)) + (target-size (- (oref db :max-size) + (* (oref db :max-size) + (oref db :prune-factor)))) + candidates) + (if (> size target-size) + (progn + (setq candidates + (registry-collect-prune-candidates + db (- size target-size) sortfunc)) + (length (registry-delete db candidates nil))) + 0))) + +(defmethod registry-collect-prune-candidates ((db registry-db) limit sortfunc) + "Collects pruning candidates from the registry-db object DB. + +Proposes only entries without the :precious keys, and attempts to +return LIMIT such candidates. If SORTFUNC is provided, sort +entries first and return candidates from beginning of list." (let* ((precious (oref db :precious)) (precious-p (lambda (entry-key) (cdr (memq (car entry-key) precious)))) (data (oref db :data)) - (limit (oref db :max-soft)) - (candidates (loop for k being the hash-keys of data - using (hash-values v) - when (notany precious-p v) - collect k))) - (list limit candidates))) - -(defmethod registry-prune-hard-candidates ((db registry-db)) - "Collects pruning candidates from the registry-db object THIS. -Proposes any entries over the max-hard limit minus size * prune-factor." - (let* ((data (oref db :data)) - ;; prune to (size * prune-factor) below the max-hard limit so - ;; we're not pruning all the time - (limit (max 0 (- (oref db :max-hard) - (* (registry-size db) (oref db :prune-factor))))) - (candidates (loop for k being the hash-keys of data - collect k))) - (list limit candidates))) + (candidates (cl-loop for k being the hash-keys of data + using (hash-values v) + when (notany precious-p v) + collect (cons k v)))) + ;; We want the full entries for sorting, but should only return a + ;; list of entry keys. + (when sortfunc + (setq candidates (sort candidates sortfunc))) + (delq nil (cl-subseq (mapcar #'car candidates) 0 limit)))) (provide 'registry) ;;; registry.el ends here diff --git a/lisp/gnus/rfc1843.el b/lisp/gnus/rfc1843.el index 09cdba3c69c..cab2f4e751c 100644 --- a/lisp/gnus/rfc1843.el +++ b/lisp/gnus/rfc1843.el @@ -31,10 +31,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'mm-util) diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el index e4eca0285cc..72f22e76b8f 100644 --- a/lisp/gnus/sieve-manage.el +++ b/lisp/gnus/sieve-manage.el @@ -71,10 +71,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (if (locate-library "password-cache") (require 'password-cache) (require 'password)) diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index b3feb7f746b..6f043df6121 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -118,9 +118,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (require 'dig) (if (locate-library "password-cache") diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 8177288f076..500f34139be 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -38,10 +38,6 @@ ;;{{{ compilation directives and autoloads/requires -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'message) ;for the message-fetch-field functions diff --git a/lisp/help-fns.el b/lisp/help-fns.el index e4890e08d51..c0d63935035 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -183,8 +183,7 @@ OBJECT should be a symbol associated with a function, variable, or face; alternatively, it can be a function definition. If TYPE is `defvar', search for a variable definition. If TYPE is `defface', search for a face definition. -If TYPE is the value returned by `symbol-function' for a function symbol, - search for a function definition. +If TYPE is not a symbol, search for a function definition. The return value is the absolute name of a readable file where OBJECT is defined. If several such files exist, preference is given to a file @@ -194,9 +193,10 @@ suitable file is found, return nil." (let* ((autoloaded (autoloadp type)) (file-name (or (and autoloaded (nth 1 type)) (symbol-file - object (if (memq type (list 'defvar 'defface)) - type - 'defun))))) + ;; FIXME: Why do we have this weird "If TYPE is the + ;; value returned by `symbol-function' for a function + ;; symbol" exception? + object (or (if (symbolp type) type) 'defun))))) (cond (autoloaded ;; An autoloaded function: Locate the file since `symbol-function' @@ -430,6 +430,40 @@ FILE is the file where FUNCTION was probably defined." (setq load-hist (cdr load-hist))) found)) +(defun help-fns--interactive-only (function) + "Insert some help blurb if FUNCTION should only be used interactively." + ;; Ignore lambda constructs, keyboard macros, etc. + (and (symbolp function) + (not (eq (car-safe (symbol-function function)) 'macro)) + (let* ((interactive-only + (or (get function 'interactive-only) + (if (boundp 'byte-compile-interactive-only-functions) + (memq function + byte-compile-interactive-only-functions))))) + (when interactive-only + (insert "\nThis function is for interactive use only" + ;; Cf byte-compile-form. + (cond ((stringp interactive-only) + (format ";\nin Lisp code %s" interactive-only)) + ((and (symbolp 'interactive-only) + (not (eq interactive-only t))) + (format ";\nin Lisp code use `%s' instead." + interactive-only)) + (t ".")) + "\n"))))) + +(defun help-fns-short-filename (filename) + (let* ((abbrev (abbreviate-file-name filename)) + (short abbrev)) + (dolist (dir load-path) + (let ((rel (file-relative-name filename dir))) + (if (< (length rel) (length short)) + (setq short rel))) + (let ((rel (file-relative-name abbrev dir))) + (if (< (length rel) (length short)) + (setq short rel)))) + short)) + ;;;###autoload (defun describe-function-1 (function) (let* ((advised (and (symbolp function) @@ -521,7 +555,7 @@ FILE is the file where FUNCTION was probably defined." ;; but that's completely wrong when the user used load-file. (princ (if (eq file-name 'C-source) "C source code" - (file-name-nondirectory file-name))) + (help-fns-short-filename file-name))) (princ "'") ;; Make a hyperlink to the library. (with-current-buffer standard-output @@ -542,7 +576,7 @@ FILE is the file where FUNCTION was probably defined." help-enable-auto-load (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" doc-raw) - (load (cadr real-def) t)) + (autoload-do-load real-def)) (substitute-command-keys doc-raw)))) (help-fns--key-bindings function) @@ -554,6 +588,7 @@ FILE is the file where FUNCTION was probably defined." ;; Add defaults to `help-fns-describe-function-functions'. (add-hook 'help-fns-describe-function-functions #'help-fns--obsolete) +(add-hook 'help-fns-describe-function-functions #'help-fns--interactive-only) (add-hook 'help-fns-describe-function-functions #'help-fns--parent-mode) (add-hook 'help-fns-describe-function-functions #'help-fns--compiler-macro) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index dd2030706b2..c62ddc3dcd0 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -191,7 +191,7 @@ The format is (FUNCTION ARGS...).") (define-button-type 'help-function-def :supertype 'help-xref - 'help-function (lambda (fun file) + 'help-function (lambda (fun file &optional type) (require 'find-func) (when (eq file 'C-source) (setq file @@ -199,7 +199,7 @@ The format is (FUNCTION ARGS...).") ;; Don't use find-function-noselect because it follows ;; aliases (which fails for built-in functions). (let ((location - (find-function-search-for-symbol fun nil file))) + (find-function-search-for-symbol fun type file))) (pop-to-buffer (car location)) (if (cdr location) (goto-char (cdr location)) diff --git a/lisp/help.el b/lisp/help.el index 80eb308f67b..bf724252d5a 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -47,6 +47,9 @@ (defvar help-window-point-marker (make-marker) "Marker to override default `window-point' in help windows.") +(defvar help-window-old-frame nil + "Frame selected at the time `with-help-window' is invoked.") + (defvar help-map (let ((map (make-sparse-keymap))) (define-key map (char-to-string help-char) 'help-for-help) @@ -297,10 +300,11 @@ If that doesn't give a function, return nil." (interactive) (view-help-file "COPYING")) +;; Maybe this command should just be removed. (defun describe-gnu-project () - "Display info on the GNU project." + "Browse online information on the GNU project." (interactive) - (view-help-file "THE-GNU-PROJECT")) + (browse-url "http://www.gnu.org/gnu/thegnuproject.html")) (define-obsolete-function-alias 'describe-project 'describe-gnu-project "22.2") @@ -448,25 +452,32 @@ is specified by the variable `message-log-max'." (info "(efaq)Packages that do not come with Emacs")) (defun view-lossage () - "Display last 300 input keystrokes. + "Display last few input keystrokes and the commands run. To record all your input, use `open-dribble-file'." (interactive) (help-setup-xref (list #'view-lossage) (called-interactively-p 'interactive)) (with-help-window (help-buffer) + (princ " ") (princ (mapconcat (lambda (key) - (if (or (integerp key) (symbolp key) (listp key)) - (single-key-description key) - (prin1-to-string key nil))) - (recent-keys) + (cond + ((and (consp key) (null (car key))) + (format "[%s]\n" (if (symbolp (cdr key)) (cdr key) + "anonymous-command"))) + ((or (integerp key) (symbolp key) (listp key)) + (single-key-description key)) + (t + (prin1-to-string key nil)))) + (recent-keys 'include-cmds) " ")) (with-current-buffer standard-output (goto-char (point-min)) - (while (progn (move-to-column 50) (not (eobp))) - (when (search-forward " " nil t) - (delete-char -1)) - (insert "\n")) + (while (not (eobp)) + (move-to-column 50) + (unless (eolp) + (fill-region (line-beginning-position) (line-end-position))) + (forward-line 1)) ;; jidanni wants to see the last keystrokes immediately. (set-marker help-window-point-marker (point))))) @@ -521,8 +532,10 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer." (if fn (format "Where is command (default %s): " fn) "Where is command: ") - obarray 'commandp t)) - (list (if (equal val "") fn (intern val)) current-prefix-arg))) + obarray 'commandp t nil nil + (and fn (symbol-name fn)))) + (list (unless (equal val "") (intern val)) + current-prefix-arg))) (unless definition (error "No command")) (let ((func (indirect-function definition)) (defs nil) @@ -648,6 +661,68 @@ temporarily enables it to allow getting help on disabled items and buttons." (princ (format "%s%s is undefined" key-desc mouse-msg)) (princ (format "%s%s runs the command %S" key-desc mouse-msg defn))))) +(defun help--key-binding-keymap (key &optional accept-default no-remap position) + "Return a keymap holding a binding for KEY within current keymaps. +The effect of the arguments KEY, ACCEPT-DEFAULT, NO-REMAP and +POSITION is as documented in the function `key-binding'." + (let* ((active-maps (current-active-maps t position)) + map found) + ;; We loop over active maps like key-binding does. + (while (and + (not found) + (setq map (pop active-maps))) + (setq found (lookup-key map key accept-default)) + (when (integerp found) + ;; The first `found' characters of KEY were found but not the + ;; whole sequence. + (setq found nil))) + (when found + (if (and (symbolp found) + (not no-remap) + (command-remapping found)) + ;; The user might want to know in which map the binding is + ;; found, or in which map the remapping is found. The + ;; default is to show the latter. + (help--key-binding-keymap (vector 'remap found)) + map)))) + +(defun help--binding-locus (key position) + "Describe in which keymap KEY is defined. +Return a symbol pointing to that keymap if one exists ; otherwise +return nil." + (let ((map (help--key-binding-keymap key t nil position))) + (when map + (catch 'found + (let ((advertised-syms (nconc + (list 'overriding-terminal-local-map + 'overriding-local-map) + (delq nil + (mapcar + (lambda (mode-and-map) + (let ((mode (car mode-and-map))) + (when (symbol-value mode) + (intern-soft + (format "%s-map" mode))))) + minor-mode-map-alist)) + (list 'global-map + (intern-soft (format "%s-map" major-mode))))) + found) + ;; Look into these advertised symbols first. + (dolist (sym advertised-syms) + (when (and + (boundp sym) + (eq map (symbol-value sym))) + (throw 'found sym))) + ;; Only look in other symbols otherwise. + (mapatoms + (lambda (x) + (when (and (boundp x) + ;; Avoid let-bound symbols. + (special-variable-p x) + (eq (symbol-value x) map)) + (throw 'found x)))) + nil))))) + (defun describe-key (&optional key untranslated up-event) "Display documentation of the function invoked by KEY. KEY can be any kind of a key sequence; it can include keyboard events, @@ -710,6 +785,7 @@ temporarily enables it to allow getting help on disabled items and buttons." (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers) (memq 'drag modifiers)) " at that spot" "")) (defn (key-binding key t)) + key-locus key-locus-up key-locus-up-tricky defn-up defn-up-tricky ev-type mouse-1-remapped mouse-1-tricky) @@ -748,15 +824,19 @@ temporarily enables it to allow getting help on disabled items and buttons." (setcar up-event (elt mouse-1-remapped 0))) (t (setcar up-event 'mouse-2)))) (setq defn-up (key-binding sequence nil nil (event-start up-event))) + (setq key-locus-up (help--binding-locus sequence (event-start up-event))) (when mouse-1-tricky (setq sequence (vector up-event)) (aset sequence 0 'mouse-1) - (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event)))))) + (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event))) + (setq key-locus-up-tricky (help--binding-locus sequence (event-start up-event)))))) + (setq key-locus (help--binding-locus key (event-start event))) (with-help-window (help-buffer) (princ (help-key-description key untranslated)) - (princ (format "\ -%s runs the command %S, which is " - mouse-msg defn)) + (princ (format "%s runs the command %S%s, which is " + mouse-msg defn (if key-locus + (format " (found in %s)" key-locus) + ""))) (describe-function-1 defn) (when up-event (unless (or (null defn-up) @@ -766,13 +846,15 @@ temporarily enables it to allow getting help on disabled items and buttons." ----------------- up-event %s---------------- -%s%s%s runs the command %S, which is " +%s%s%s runs the command %S%s, which is " (if mouse-1-tricky "(short click) " "") (key-description (vector up-event)) mouse-msg (if mouse-1-remapped " is remapped to <mouse-2>, which" "") - defn-up)) + defn-up (if key-locus-up + (format " (found in %s)" key-locus-up) + ""))) (describe-function-1 defn-up)) (unless (or (null defn-up-tricky) (integerp defn-up-tricky) @@ -782,10 +864,12 @@ temporarily enables it to allow getting help on disabled items and buttons." ----------------- up-event (long click) ---------------- Pressing <%S>%s for longer than %d milli-seconds -runs the command %S, which is " +runs the command %S%s, which is " ev-type mouse-msg mouse-1-click-follows-link - defn-up-tricky)) + defn-up-tricky (if key-locus-up-tricky + (format " (found in %s)" key-locus-up-tricky) + ""))) (describe-function-1 defn-up-tricky))))))) (defun describe-mode (&optional buffer) @@ -1050,7 +1134,10 @@ of a horizontal combination, restrain its new size by `fit-window-to-buffer-horizontally' can inhibit resizing. If WINDOW is the root window of its frame, resize the frame -provided `fit-frame-to-buffer' is non-nil." +provided `fit-frame-to-buffer' is non-nil. + +This function may call `preserve-window-size' to preserve the +size of WINDOW." (setq window (window-normalize-window window t)) (let ((height (if (functionp temp-buffer-max-height) (with-selected-window window @@ -1072,20 +1159,30 @@ provided `fit-frame-to-buffer' is non-nil." (and (eq quit-cadr 'frame) fit-frame-to-buffer (eq window (frame-root-window window)))) - (fit-window-to-buffer window height nil width)))) + (fit-window-to-buffer window height nil width nil t)))) ;;; Help windows. -(defcustom help-window-select 'other - "Non-nil means select help window for viewing. +(defcustom help-window-select nil + "Non-nil means select help window for viewing. Choices are: + never (nil) Select help window only if there is no other window on its frame. - other Select help window unless the selected window is the - only other window on the help window's frame. + + other Select help window if and only if it appears on the + previously selected frame, that frame contains at + least two other windows and the help window is + either new or showed a different buffer before. + always (t) Always select the help window. +If this option is non-nil and the help window appears on another +frame, then give that frame input focus too. Note also that if +the help window appears on another frame, it may get selected and +its frame get input focus even if this option is nil. + This option has effect if and only if the help window was created -by `with-help-window'" +by `with-help-window'." :type '(choice (const :tag "never (nil)" nil) (const :tag "other" other) (const :tag "always (t)" t)) @@ -1132,7 +1229,9 @@ Return VALUE." (let* ((help-buffer (when (window-live-p window) (window-buffer window))) (help-setup (when (window-live-p window) - (car (window-parameter window 'quit-restore))))) + (car (window-parameter window 'quit-restore)))) + (frame (window-frame window))) + (when help-buffer ;; Handle `help-window-point-marker'. (when (eq (marker-buffer help-window-point-marker) help-buffer) @@ -1140,13 +1239,27 @@ Return VALUE." ;; Reset `help-window-point-marker'. (set-marker help-window-point-marker nil)) + ;; If the help window appears on another frame, select it if + ;; `help-window-select' is non-nil and give that frame input focus + ;; too. See also Bug#19012. + (when (and help-window-select + (frame-live-p help-window-old-frame) + (not (eq frame help-window-old-frame))) + (select-window window) + (select-frame-set-input-focus frame)) + (cond ((or (eq window (selected-window)) - (and (or (eq help-window-select t) - (eq help-setup 'frame) + ;; If the help window is on the selected frame, select + ;; it if `help-window-select' is t or `help-window-select' + ;; is 'other, the frame contains at least three windows, and + ;; the help window did show another buffer before. See also + ;; Bug#11039. + (and (eq frame (selected-frame)) + (or (eq help-window-select t) (and (eq help-window-select 'other) - (eq (window-frame window) (selected-frame)) - (> (length (window-list nil 'no-mini)) 2))) + (> (length (window-list nil 'no-mini)) 2) + (not (eq help-setup 'same)))) (select-window window))) ;; The help window is or gets selected ... (help-window-display-message @@ -1155,12 +1268,13 @@ Return VALUE." ;; ... and is new, ... "Type \"q\" to delete help window") ((eq help-setup 'frame) + ;; ... on a new frame, ... "Type \"q\" to quit the help frame") ((eq help-setup 'other) ;; ... or displayed some other buffer before. "Type \"q\" to restore previous buffer")) window t)) - ((and (eq (window-frame window) (selected-frame)) + ((and (eq (window-frame window) help-window-old-frame) (= (length (window-list nil 'no-mini)) 2)) ;; There are two windows on the help window's frame and the ;; other one is the selected one. @@ -1217,6 +1331,7 @@ the help window if the current value of the user option (cons 'help-mode-setup temp-buffer-window-setup-hook)) (temp-buffer-window-show-hook (cons 'help-mode-finish temp-buffer-window-show-hook))) + (setq help-window-old-frame (selected-frame)) (with-temp-buffer-window ,buffer-name nil 'help-window-setup (progn ,@body))))) @@ -1330,7 +1445,7 @@ the same names as used in the original source code, when possible." (let ((name (symbol-name arg))) (cond ((string-match "\\`&" name) arg) - ((string-match "\\`_" name) + ((string-match "\\`_." name) (intern (upcase (substring name 1)))) (t (intern (upcase name))))))) arglist))) diff --git a/lisp/hexl.el b/lisp/hexl.el index 3751bcf4bb3..27d46592698 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -395,8 +395,8 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode. (add-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer nil t) ;; Set a callback function for eldoc. - (hexl-mode--setq-local 'eldoc-documentation-function - #'hexl-print-current-point-info) + (add-function :before-until (local 'eldoc-documentation-function) + #'hexl-print-current-point-info) (eldoc-add-command-completions "hexl-") (eldoc-remove-command "hexl-save-buffer" "hexl-current-address") diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 5d22a7e3360..65a4561e3ab 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -391,7 +391,7 @@ versions before 22 use the following in your init file: (font-lock-remove-keywords nil hi-lock-file-patterns) (setq hi-lock-file-patterns nil)) (remove-overlays nil nil 'hi-lock-overlay t) - (when font-lock-fontified (font-lock-fontify-buffer))) + (font-lock-flush)) (define-key-after menu-bar-edit-menu [hi-lock] nil) (remove-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook t))) @@ -601,7 +601,7 @@ then remove all hi-lock highlighting." (delq keyword hi-lock-interactive-patterns)) (remove-overlays nil nil 'hi-lock-overlay-regexp (hi-lock--hashcons (car keyword))) - (when font-lock-fontified (font-lock-fontify-buffer))))) + (font-lock-flush)))) ;;;###autoload (defun hi-lock-write-interactive-patterns () @@ -695,7 +695,7 @@ with completion and history." (if (and font-lock-mode (font-lock-specified-p major-mode)) (progn (font-lock-add-keywords nil (list pattern) t) - (font-lock-fontify-buffer)) + (font-lock-flush)) (let* ((range-min (- (point) (/ hi-lock-highlight-range 2))) (range-max (+ (point) (/ hi-lock-highlight-range 2))) (search-start @@ -719,7 +719,7 @@ with completion and history." (font-lock-remove-keywords nil hi-lock-file-patterns) (setq hi-lock-file-patterns patterns) (font-lock-add-keywords nil hi-lock-file-patterns t) - (font-lock-fontify-buffer))) + (font-lock-flush))) (defun hi-lock-find-patterns () "Find patterns in current buffer for hi-lock." diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el index 2854d824850..b167671ab0b 100644 --- a/lisp/hippie-exp.el +++ b/lisp/hippie-exp.el @@ -637,15 +637,27 @@ string). It returns t if a new completion is found, nil otherwise." The argument OLD has to be nil the first call of this function, and t for subsequent calls (for further possible completions of the same string). It returns t if a new completion is found, nil otherwise." + (he--all-buffers + old + (lambda () (he-line-beg (and (get-buffer-process (current-buffer)) + comint-use-prompt-regexp + comint-prompt-regexp))) + (lambda (string) + (he-line-search string + (and (get-buffer-process (current-buffer)) + comint-use-prompt-regexp + comint-prompt-regexp) + nil)))) + +(defun he--all-buffers (old beg-function search-function) (let ((expansion ()) - (strip-prompt (and (get-buffer-process (current-buffer)) - comint-use-prompt-regexp - comint-prompt-regexp)) - (buf (current-buffer)) - (orig-case-fold-search case-fold-search)) + (buf (current-buffer)) + (only-buffers hippie-expand-only-buffers) + (ignore-buffers hippie-expand-ignore-buffers) + (orig-case-fold-search case-fold-search)) (if (not old) - (progn - (he-init-string (he-line-beg strip-prompt) (point)) + (progn + (he-init-string (funcall beg-function) (point)) (setq he-search-bufs (buffer-list)) (setq he-searched-n-bufs 0) (set-marker he-search-loc 1 (car he-search-bufs)))) @@ -654,24 +666,20 @@ string). It returns t if a new completion is found, nil otherwise." (while (and he-search-bufs (not expansion) (or (not hippie-expand-max-buffers) - (< he-searched-n-bufs hippie-expand-max-buffers))) - (set-buffer (car he-search-bufs)) - (if (and (not (eq (current-buffer) buf)) - (if hippie-expand-only-buffers - (he-buffer-member hippie-expand-only-buffers) - (not (he-buffer-member hippie-expand-ignore-buffers)))) - (save-excursion - (save-restriction - (if hippie-expand-no-restriction + (< he-searched-n-bufs hippie-expand-max-buffers))) + (set-buffer (car he-search-bufs)) + (if (and (not (eq (current-buffer) buf)) + (if only-buffers + (he-buffer-member only-buffers) + (not (he-buffer-member ignore-buffers)))) + (save-excursion + (save-restriction + (if hippie-expand-no-restriction (widen)) (goto-char he-search-loc) - (setq strip-prompt (and (get-buffer-process (current-buffer)) - comint-use-prompt-regexp - comint-prompt-regexp)) (setq expansion (let ((case-fold-search orig-case-fold-search)) - (he-line-search he-search-string - strip-prompt nil))) + (funcall search-function he-search-string))) (set-marker he-search-loc (point)) (if (not expansion) (progn @@ -686,9 +694,9 @@ string). It returns t if a new completion is found, nil otherwise." (progn (if old (he-reset-string)) ()) - (progn - (he-substitute-string expansion t) - t)))) + (progn + (he-substitute-string expansion t) + t)))) (defun he-line-search (str strip-prompt reverse) (let ((result ())) @@ -769,53 +777,9 @@ string). It returns t if a new completion is found, nil otherwise." The argument OLD has to be nil the first call of this function, and t for subsequent calls (for further possible completions of the same string). It returns t if a new completion is found, nil otherwise." - (let ((expansion ()) - (buf (current-buffer)) - (orig-case-fold-search case-fold-search)) - (if (not old) - (progn - (he-init-string (he-list-beg) (point)) - (setq he-search-bufs (buffer-list)) - (setq he-searched-n-bufs 0) - (set-marker he-search-loc 1 (car he-search-bufs)))) - - (if (not (equal he-search-string "")) - (while (and he-search-bufs - (not expansion) - (or (not hippie-expand-max-buffers) - (< he-searched-n-bufs hippie-expand-max-buffers))) - (set-buffer (car he-search-bufs)) - (if (and (not (eq (current-buffer) buf)) - (if hippie-expand-only-buffers - (he-buffer-member hippie-expand-only-buffers) - (not (he-buffer-member hippie-expand-ignore-buffers)))) - (save-excursion - (save-restriction - (if hippie-expand-no-restriction - (widen)) - (goto-char he-search-loc) - (setq expansion - (let ((case-fold-search orig-case-fold-search)) - (he-list-search he-search-string nil))) - (set-marker he-search-loc (point)) - (if (not expansion) - (progn - (setq he-search-bufs (cdr he-search-bufs)) - (setq he-searched-n-bufs (1+ he-searched-n-bufs)) - (set-marker he-search-loc 1 (car he-search-bufs)))))) - (setq he-search-bufs (cdr he-search-bufs)) - (set-marker he-search-loc 1 (car he-search-bufs))))) - - (set-buffer buf) - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion t) - t)))) + (he--all-buffers old #'he-list-beg #'he-list-search)) -(defun he-list-search (str reverse) +(defun he-list-search (str &optional reverse) (let ((result ()) beg pos err) (while (and (not result) @@ -924,51 +888,7 @@ string). It returns t if a new expansion is found, nil otherwise." The argument OLD has to be nil the first call of this function, and t for subsequent calls (for further possible expansions of the same string). It returns t if a new expansion is found, nil otherwise." - (let ((expansion ()) - (buf (current-buffer)) - (orig-case-fold-search case-fold-search)) - (if (not old) - (progn - (he-init-string (he-dabbrev-beg) (point)) - (setq he-search-bufs (buffer-list)) - (setq he-searched-n-bufs 0) - (set-marker he-search-loc 1 (car he-search-bufs)))) - - (if (not (equal he-search-string "")) - (while (and he-search-bufs - (not expansion) - (or (not hippie-expand-max-buffers) - (< he-searched-n-bufs hippie-expand-max-buffers))) - (set-buffer (car he-search-bufs)) - (if (and (not (eq (current-buffer) buf)) - (if hippie-expand-only-buffers - (he-buffer-member hippie-expand-only-buffers) - (not (he-buffer-member hippie-expand-ignore-buffers)))) - (save-excursion - (save-restriction - (if hippie-expand-no-restriction - (widen)) - (goto-char he-search-loc) - (setq expansion - (let ((case-fold-search orig-case-fold-search)) - (he-dabbrev-search he-search-string nil))) - (set-marker he-search-loc (point)) - (if (not expansion) - (progn - (setq he-search-bufs (cdr he-search-bufs)) - (setq he-searched-n-bufs (1+ he-searched-n-bufs)) - (set-marker he-search-loc 1 (car he-search-bufs)))))) - (setq he-search-bufs (cdr he-search-bufs)) - (set-marker he-search-loc 1 (car he-search-bufs))))) - - (set-buffer buf) - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion t) - t)))) + (he--all-buffers old #'he-dabbrev-beg #'he-dabbrev-search)) ;; Thanks go to Jeff Dairiki <dairiki@faraday.apl.washington.edu> who ;; suggested this one. diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index bb1ae18d9c9..719cb82b989 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -1809,17 +1809,25 @@ fontified. This is a simple convenience wrapper around (eval-and-compile (require 'font-lock)) (if (boundp 'font-lock-cache-position) (or font-lock-cache-position - (set 'font-lock-cache-position (make-marker)))) - (if (not noninteractive) - (progn - (message "hfy interactive mode (%S %S)" window-system major-mode) - (when (and font-lock-defaults - font-lock-mode) - (font-lock-fontify-region (point-min) (point-max) nil))) + (setq font-lock-cache-position (make-marker)))) + (cond + (noninteractive (message "hfy batch mode (%s:%S)" (or (buffer-file-name) (buffer-name)) major-mode) - (when font-lock-defaults - (font-lock-fontify-buffer)) )) + (if (fboundp 'font-lock-ensure) + (font-lock-ensure) + (when font-lock-defaults + (font-lock-fontify-buffer)))) + ((fboundp #'jit-lock-fontify-now) + (message "hfy jit-lock mode (%S %S)" window-system major-mode) + (jit-lock-fontify-now)) + (t + (message "hfy interactive mode (%S %S)" window-system major-mode) + ;; If jit-lock is not in use, then the buffer is already fontified! + ;; (when (and font-lock-defaults + ;; font-lock-mode) + ;; (font-lock-fontify-region (point-min) (point-max) nil)) + ))) ;;;###autoload (defun htmlfontify-buffer (&optional srcdir file) diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index d9c40b728e9..10887713122 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -1,4 +1,4 @@ -;;; ibuf-ext.el --- extensions for ibuffer +;;; ibuf-ext.el --- extensions for ibuffer -*- lexical-binding:t -*- ;; Copyright (C) 2000-2015 Free Software Foundation, Inc. @@ -523,9 +523,9 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'." ibuffer-filter-groups (append ibuffer-filter-groups (list (cons "Default" nil)))))) -;; (dolist (hidden ibuffer-hidden-filter-groups) -;; (setq filter-group-alist (ibuffer-delete-alist -;; hidden filter-group-alist))) + ;; (dolist (hidden ibuffer-hidden-filter-groups) + ;; (setq filter-group-alist (ibuffer-delete-alist + ;; hidden filter-group-alist))) (let ((vec (make-vector (length filter-group-alist) nil)) (i 0)) (dolist (filtergroup filter-group-alist) @@ -540,12 +540,13 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'." (cl-incf i) (setq bmarklist lamers)))) (let (ret) - (dotimes (j i ret) + (dotimes (j i) (let ((bufs (aref vec j))) (unless (and noempty (null bufs)) (push (cons (car (nth j filter-group-alist)) bufs) - ret)))))))) + ret)))) + ret)))) ;;;###autoload (defun ibuffer-filters-to-filter-group (name) @@ -1100,9 +1101,9 @@ Default sorting modes are: Major Mode - the name of the major mode of the buffer Size - the size of the buffer" (interactive) - (let ((modes (mapcar 'car ibuffer-sorting-functions-alist))) - (add-to-list 'modes 'recency) - (setq modes (sort modes 'string-lessp)) + (let ((modes (mapcar #'car ibuffer-sorting-functions-alist))) + (cl-pushnew 'recency modes) + (setq modes (sort modes #'string-lessp)) (let ((next (or (car-safe (cdr-safe (memq ibuffer-sorting-mode modes))) (car modes)))) (setq ibuffer-sorting-mode next) diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el index 1a204709dea..cf7f39e9fa5 100644 --- a/lisp/ibuf-macs.el +++ b/lisp/ibuf-macs.el @@ -1,4 +1,4 @@ -;;; ibuf-macs.el --- macros for ibuffer +;;; ibuf-macs.el --- macros for ibuffer -*- lexical-binding:t -*- ;; Copyright (C) 2000-2015 Free Software Foundation, Inc. @@ -111,6 +111,7 @@ change its definition, you should explicitly call ,(if inline `(push '(,sym ,bod) ibuffer-inline-columns) `(defun ,sym (buffer mark) + (ignore mark) ;Silence byte-compiler if mark is unused. ,bod)) (put (quote ,sym) 'ibuffer-column-name ,(if (stringp name) @@ -204,7 +205,8 @@ macro for exactly what it does. (declare (indent 2) (doc-string 3)) `(progn (defun ,(intern (concat (if (string-match "^ibuffer-do" (symbol-name op)) - "" "ibuffer-do-") (symbol-name op))) + "" "ibuffer-do-") + (symbol-name op))) ,args ,(if (stringp documentation) documentation @@ -247,6 +249,9 @@ macro for exactly what it does. (_ 'ibuffer-map-marked-lines)) #'(lambda (buf mark) + ;; Silence warning for code that doesn't + ;; use `mark'. + (ignore mark) ,(if (eq modifier-p :maybe) `(let ((ibuffer-tmp-previous-buffer-modification (buffer-modified-p buf))) diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index f940016fb95..8bd1e469650 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1,4 +1,4 @@ -;;; ibuffer.el --- operate on buffers like dired +;;; ibuffer.el --- operate on buffers like dired -*- lexical-binding:t -*- ;; Copyright (C) 2000-2015 Free Software Foundation, Inc. @@ -350,6 +350,7 @@ directory, like `default-directory'." (defcustom ibuffer-mode-hook nil "Hook run upon entry into `ibuffer-mode'." :type 'hook + :options '(ibuffer-auto-mode) :group 'ibuffer) (defcustom ibuffer-load-hook nil @@ -539,10 +540,6 @@ directory, like `default-directory'." (define-key map (kbd "/ X") 'ibuffer-delete-saved-filter-groups) (define-key map (kbd "/ \\") 'ibuffer-clear-filter-groups) - (define-key map (kbd "q") 'ibuffer-quit) - (define-key map (kbd "h") 'describe-mode) - (define-key map (kbd "?") 'describe-mode) - (define-key map (kbd "% n") 'ibuffer-mark-by-name-regexp) (define-key map (kbd "% m") 'ibuffer-mark-by-mode-regexp) (define-key map (kbd "% f") 'ibuffer-mark-by-file-name-regexp) @@ -706,7 +703,8 @@ directory, like `default-directory'." '(menu-item "Diff with file" ibuffer-diff-with-file :help "View the differences between this buffer and its file")) (define-key-after map [menu-bar view auto-mode] - '(menu-item "Toggle Auto Mode" ibuffer-auto-mode + '(menu-item "Auto Mode" ibuffer-auto-mode + :button (:toggle . ibuffer-auto-mode) :help "Attempt to automatically update the Ibuffer buffer")) (define-key-after map [menu-bar view customize] '(menu-item "Customize Ibuffer" ibuffer-customize @@ -876,12 +874,6 @@ directory, like `default-directory'." (define-key map [down-mouse-3] 'ibuffer-mouse-popup-menu) map)) -(defvar ibuffer-restore-window-config-on-quit nil - "If non-nil, restore previous window configuration upon exiting `ibuffer'.") - -(defvar ibuffer-prev-window-config nil - "Window configuration before starting Ibuffer.") - (defvar ibuffer-did-modification nil) (defvar ibuffer-compiled-formats nil) @@ -915,7 +907,7 @@ width and the longest string in LIST." (when (zerop columns) (setq columns 1)) (while list - (dotimes (i (1- columns)) + (dotimes (_ (1- columns)) (insert (concat (car list) (make-string (- max (length (car list))) ?\s))) (setq list (cdr list))) @@ -1283,7 +1275,7 @@ a new window in the current frame, splitting vertically." :modifier-p t) (set-buffer-modified-p (not (buffer-modified-p)))) -(define-ibuffer-op ibuffer-do-toggle-read-only (&optional arg) +(define-ibuffer-op ibuffer-do-toggle-read-only (&optional _arg);FIXME:arg unused! "Toggle read only status in marked buffers. With optional ARG, make read-only only if ARG is not negative." (:opstring "toggled read only status in" @@ -1528,7 +1520,7 @@ If point is on a group name, this function operates on that group." ;; We use these variables to keep track of which variables ;; inside the generated function we need to bind, since ;; binding variables in Emacs takes time. - str-used tmp1-used tmp2-used global-strlen-used) + (vars-used ())) (dolist (form format) (push ;; Generate a form based on a particular format entry, like @@ -1554,8 +1546,8 @@ If point is on a group name, this function operates on that group." ;; This is a complex case; they want it limited to a ;; minimum size. (setq min-used t) - (setq str-used t strlen-used t global-strlen-used t - tmp1-used t tmp2-used t) + (setq strlen-used t) + (setq vars-used '(str strlen tmp1 tmp2)) ;; Generate code to limit the string to a minimum size. (setq minform `(progn (setq str @@ -1567,7 +1559,8 @@ If point is on a group name, this function operates on that group." strlen) align))))) (when (or (not (integerp max)) (> max 0)) - (setq str-used t max-used t) + (setq max-used t) + (cl-pushnew 'str vars-used) ;; Generate code to limit the string to a maximum size. (setq maxform `(progn (setq str @@ -1595,8 +1588,9 @@ If point is on a group name, this function operates on that group." ;; don't even understand it, and I wrote it five ;; minutes ago. (insertgenfn - (ibuffer-aif (get sym 'ibuffer-column-summarizer) + (if (get sym 'ibuffer-column-summarizer) ;; I really, really wish Emacs Lisp had closures. + ;; FIXME: Elisp does have them now. (lambda (arg sym) `(insert (let ((ret ,arg)) @@ -1604,7 +1598,7 @@ If point is on a group name, this function operates on that group." (cons ret (get ',sym 'ibuffer-column-summary))) ret))) - (lambda (arg sym) + (lambda (arg _sym) `(insert ,arg)))) (mincompform `(< strlen ,(if (integerp min) min @@ -1632,10 +1626,9 @@ If point is on a group name, this function operates on that group." `(when ,maxcompform ,maxform))) outforms) - (push (append - `(setq str ,callform) - (when strlen-used - `(strlen (length str)))) + (push `(setq str ,callform + ,@(when strlen-used + `(strlen (length str)))) outforms) (setq outforms (append outforms @@ -1648,25 +1641,17 @@ If point is on a group name, this function operates on that group." `(let ,letbindings ,@outforms))))) result)) - (setq result - ;; We don't want to unconditionally load the byte-compiler. - (funcall (if (or ibuffer-always-compile-formats - (featurep 'bytecomp)) - #'byte-compile - #'identity) - ;; Here, we actually create a lambda form which - ;; inserts all the generated forms for each entry - ;; in the format string. - (nconc (list 'lambda '(buffer mark)) - `((let ,(append (when str-used - '(str)) - (when global-strlen-used - '(strlen)) - (when tmp1-used - '(tmp1)) - (when tmp2-used - '(tmp2))) - ,@(nreverse result)))))))) + ;; We don't want to unconditionally load the byte-compiler. + (funcall (if (or ibuffer-always-compile-formats + (featurep 'bytecomp)) + #'byte-compile + #'identity) + ;; Here, we actually create a lambda form which + ;; inserts all the generated forms for each entry + ;; in the format string. + `(lambda (buffer mark) + (let ,vars-used + ,@(nreverse result)))))) (defun ibuffer-recompile-formats () "Recompile `ibuffer-formats'." @@ -1684,8 +1669,8 @@ If point is on a group name, this function operates on that group." (defun ibuffer-clear-summary-columns (format) (dolist (form format) - (ibuffer-awhen (and (consp form) - (get (car form) 'ibuffer-column-summarizer)) + (when (and (consp form) + (get (car form) 'ibuffer-column-summarizer)) (put (car form) 'ibuffer-column-summary nil)))) (defun ibuffer-check-formats () @@ -2296,18 +2281,6 @@ If optional arg SILENT is non-nil, do not display progress messages." (goto-char (point-min)) (forward-line orig)))) -(defun ibuffer-quit () - "Quit this `ibuffer' session. -Try to restore the previous window configuration if -`ibuffer-restore-window-config-on-quit' is non-nil." - (interactive) - (if ibuffer-restore-window-config-on-quit - (progn - (bury-buffer) - (unless (= (count-windows) 1) - (set-window-configuration ibuffer-prev-window-config))) - (bury-buffer))) - ;;;###autoload (defun ibuffer-list-buffers (&optional files-only) "Display a list of buffers, in another window. @@ -2348,7 +2321,6 @@ FORMATS is the value to use for `ibuffer-formats'. (interactive "P") (when ibuffer-use-other-window (setq other-window-p t)) - (setq ibuffer-prev-window-config (current-window-configuration)) (let ((buf (get-buffer-create (or name "*Ibuffer*")))) (if other-window-p (funcall (if noselect (lambda (buf) (display-buffer buf t)) #'pop-to-buffer) buf) @@ -2360,8 +2332,7 @@ FORMATS is the value to use for `ibuffer-formats'. (select-window (get-buffer-window buf 0)) (or (derived-mode-p 'ibuffer-mode) (ibuffer-mode)) - (setq ibuffer-restore-window-config-on-quit other-window-p) - (when shrink + (when shrink (setq ibuffer-shrink-to-minimum-size shrink)) (when qualifiers (require 'ibuf-ext) @@ -2499,7 +2470,6 @@ Other commands: '\\[ibuffer-switch-format]' - Change the current display format. '\\[forward-line]' - Move point to the next line. '\\[previous-line]' - Move point to the previous line. - '\\[ibuffer-quit]' - Bury the Ibuffer buffer. '\\[describe-mode]' - This help. '\\[ibuffer-diff-with-file]' - View the differences between this buffer and its associated file. @@ -2614,7 +2584,6 @@ will be inserted before the group at point." (set (make-local-variable 'ibuffer-cached-eliding-string) nil) (set (make-local-variable 'ibuffer-cached-elide-long-columns) nil) (set (make-local-variable 'ibuffer-current-format) nil) - (set (make-local-variable 'ibuffer-restore-window-config-on-quit) nil) (set (make-local-variable 'ibuffer-did-modification) nil) (set (make-local-variable 'ibuffer-tmp-hide-regexps) nil) (set (make-local-variable 'ibuffer-tmp-show-regexps) nil) @@ -2628,7 +2597,7 @@ will be inserted before the group at point." ;;; Start of automatically extracted autoloads. -;;;### (autoloads nil "ibuf-ext" "ibuf-ext.el" "1132b875829542a46bbf126cbcdd662d") +;;;### (autoloads nil "ibuf-ext" "ibuf-ext.el" "442bac528ce7a9a20bb191d0eb08cbd8") ;;; Generated autoloads from ibuf-ext.el (autoload 'ibuffer-auto-mode "ibuf-ext" "\ diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 78b9a828641..ee281122852 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -487,6 +487,19 @@ matches exist." "}") (concat determ " [Matched]")))))) +;;; Iswitchb compatibility + +;; We moved Iswitchb to `obsolete' in 24.4, but autoloads in files in +;; `obsolete' aren't obeyed (since that would encourage people to keep using +;; those packages, oblivious to their obsolescence). Given the fact that +;; Iswitchb was very popular, we decided to keep its autoload for a bit longer, +;; so we moved it here. + +;;;###autoload(when (locate-library "obsolete/iswitchb") +;;;###autoload (autoload 'iswitchb-mode "iswitchb" "Toggle Iswitchb mode." t) +;;;###autoload (make-obsolete 'iswitchb-mode +;;;###autoload "use `icomplete-mode' or `ido-mode' instead." "24.4")) + ;;;_* Provide (provide 'icomplete) diff --git a/lisp/ido.el b/lisp/ido.el index 782979ad44e..1f4e3facd36 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -208,13 +208,13 @@ ;; ;; Customize the Ido group to change the Ido functionality. ;; -;; To modify the keybindings, use the ido-setup-hook. For example: -;;(add-hook 'ido-setup-hook 'ido-my-keys) +;; To modify the keybindings, use `define-key' on +;; `ido-common-completion-map' or one of the specialized keymaps: +;; `ido-file-dir-completion-map', `ido-file-completion-map' or +;; `ido-buffer-completion-map'. ;; -;;(defun ido-my-keys () -;; "Add my keybindings for ido." -;; (define-key ido-completion-map " " 'ido-next-match) -;; ) +;; (with-eval-after-load 'ido +;; (define-key ido-common-completion-map " " 'ido-next-match)) ;; Seeing all the matching buffers or files ;; ---------------------------------------- @@ -323,8 +323,8 @@ (defvar recentf-list) -;;; User Variables -;; +;;;; Options + ;; These are some things you might want to change. (defun ido-fractionp (n) @@ -978,25 +978,90 @@ The fallback command is passed as an argument to the functions." :type 'hook :group 'ido) -;;; Internal Variables - -;; Persistent variables - -(defvar ido-completion-map nil - "Currently active keymap for Ido commands.") +;;;; Keymaps -(defvar ido-common-completion-map nil +(defvar ido-common-completion-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (define-key map "\C-a" 'ido-toggle-ignore) + (define-key map "\C-c" 'ido-toggle-case) + (define-key map "\C-e" 'ido-edit-input) + (define-key map "\t" 'ido-complete) + (define-key map " " 'ido-complete-space) + (define-key map "\C-j" 'ido-select-text) + (define-key map "\C-m" 'ido-exit-minibuffer) + (define-key map "\C-p" 'ido-toggle-prefix) + (define-key map "\C-r" 'ido-prev-match) + (define-key map "\C-s" 'ido-next-match) + (define-key map [?\C-.] 'ido-next-match) + (define-key map [?\C-,] 'ido-prev-match) + (define-key map "\C-t" 'ido-toggle-regexp) + (define-key map "\C-z" 'ido-undo-merge-work-directory) + (define-key map [(control ?\s)] 'ido-restrict-to-matches) + (define-key map [(meta ?\s)] 'ido-take-first-match) + (define-key map [(control ?@)] 'ido-restrict-to-matches) + (define-key map [right] 'ido-next-match) + (define-key map [left] 'ido-prev-match) + (define-key map "?" 'ido-completion-help) + (define-key map "\C-b" 'ido-magic-backward-char) + (define-key map "\C-f" 'ido-magic-forward-char) + (define-key map "\C-d" 'ido-magic-delete-char) + map) "Keymap for all Ido commands.") -(defvar ido-file-completion-map nil - "Keymap for Ido file commands.") - -(defvar ido-file-dir-completion-map nil +(defvar ido-file-dir-completion-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map ido-common-completion-map) + (define-key map "\C-x\C-b" 'ido-enter-switch-buffer) + (define-key map "\C-x\C-f" 'ido-fallback-command) + (define-key map "\C-x\C-d" 'ido-enter-dired) + (define-key map [down] 'ido-next-match-dir) + (define-key map [up] 'ido-prev-match-dir) + (define-key map [(meta up)] 'ido-prev-work-directory) + (define-key map [(meta down)] 'ido-next-work-directory) + (define-key map [backspace] 'ido-delete-backward-updir) + (define-key map "\d" 'ido-delete-backward-updir) + (define-key map [remap delete-backward-char] 'ido-delete-backward-updir) ; BS + (define-key map [remap backward-kill-word] 'ido-delete-backward-word-updir) ; M-DEL + (define-key map [(control backspace)] 'ido-up-directory) + (define-key map "\C-l" 'ido-reread-directory) + (define-key map [(meta ?d)] 'ido-wide-find-dir-or-delete-dir) + (define-key map [(meta ?b)] 'ido-push-dir) + (define-key map [(meta ?v)] 'ido-push-dir-first) + (define-key map [(meta ?f)] 'ido-wide-find-file-or-pop-dir) + (define-key map [(meta ?k)] 'ido-forget-work-directory) + (define-key map [(meta ?m)] 'ido-make-directory) + (define-key map [(meta ?n)] 'ido-next-work-directory) + (define-key map [(meta ?o)] 'ido-prev-work-file) + (define-key map [(meta control ?o)] 'ido-next-work-file) + (define-key map [(meta ?p)] 'ido-prev-work-directory) + (define-key map [(meta ?s)] 'ido-merge-work-directories) + map) "Keymap for Ido file and directory commands.") -(defvar ido-buffer-completion-map nil +(defvar ido-file-completion-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map ido-file-dir-completion-map) + (define-key map "\C-k" 'ido-delete-file-at-head) + (define-key map "\C-o" 'ido-copy-current-word) + (define-key map "\C-w" 'ido-copy-current-file-name) + (define-key map [(meta ?l)] 'ido-toggle-literal) + map) + "Keymap for Ido file commands.") + +(defvar ido-buffer-completion-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map ido-common-completion-map) + (define-key map "\C-x\C-f" 'ido-enter-find-file) + (define-key map "\C-x\C-b" 'ido-fallback-command) + (define-key map "\C-k" 'ido-kill-buffer-at-head) + (define-key map [?\C-\S-b] 'ido-bury-buffer-at-head) + (define-key map "\C-o" 'ido-toggle-virtual-buffers) + map) "Keymap for Ido buffer commands.") +;;;; Persistent variables + (defvar ido-file-history nil "History of files selected using `ido-find-file'.") @@ -1027,7 +1092,10 @@ Each element in the list is of the form (DIR (MTIME) FILE...).") Intended to be let-bound by functions which call Ido repeatedly. Should never be set permanently.") -;; Temporary storage +;;;; Temporary storage + +(defvar ido-completion-map nil + "Currently active keymap for Ido commands.") (defvar ido-eoinput 1 "Point where minibuffer input ends and completion info begins. @@ -1086,13 +1154,14 @@ Value is an integer which is number of chars to right of prompt.") This is a copy of `recentf-list', pared down and with faces applied. Only used if `ido-use-virtual-buffers' is non-nil.") -;;; Variables with dynamic bindings. -;;; Declared here to keep the byte compiler quiet. +;;;; Variables with dynamic bindings. + +;; These are declared here to keep the byte compiler quiet. ;; Stores the current ido item type ('file, 'dir, 'buffer, or 'list). (defvar ido-cur-item) -;;; Stores the current default item +;; Stores the current default item. (defvar ido-default-item) ;; Stores the current list of items that will be searched through. @@ -1306,8 +1375,7 @@ Only used if `ido-use-virtual-buffers' is non-nil.") (defun ido-time-stamp (&optional time) ;; Time is a floating point number (fractions of 1 hour) - (setq time (or time (current-time))) - (/ (+ (* (car time) 65536.0) (car (cdr time))) 3600.0)) + (/ (float-time time) 3600)) (defun ido-cache-ftp-valid (&optional time) (and (numberp ido-cache-ftp-work-directory-time) @@ -1503,7 +1571,6 @@ Removes badly formatted data and ignored directories." (ido-save-history)) (defun ido-common-initialization () - (ido-init-completion-maps) (add-hook 'minibuffer-setup-hook 'ido-minibuffer-setup) (add-hook 'choose-completion-string-functions 'ido-choose-completion-string)) @@ -1597,119 +1664,51 @@ This function also adds a hook to the minibuffer." ;;; IDO KEYMAP -(defun ido-init-completion-maps () - "Set up the completion keymaps used by Ido." - ;; Common map - (let ((map (make-sparse-keymap))) - (define-key map "\C-a" 'ido-toggle-ignore) - (define-key map "\C-c" 'ido-toggle-case) - (define-key map "\C-e" 'ido-edit-input) - (define-key map "\t" 'ido-complete) - (define-key map " " 'ido-complete-space) - (define-key map "\C-j" 'ido-select-text) - (define-key map "\C-m" 'ido-exit-minibuffer) - (define-key map "\C-p" 'ido-toggle-prefix) - (define-key map "\C-r" 'ido-prev-match) - (define-key map "\C-s" 'ido-next-match) - (define-key map [?\C-.] 'ido-next-match) - (define-key map [?\C-,] 'ido-prev-match) - (define-key map "\C-t" 'ido-toggle-regexp) - (define-key map "\C-z" 'ido-undo-merge-work-directory) - (define-key map [(control ?\s)] 'ido-restrict-to-matches) - (define-key map [(meta ?\s)] 'ido-take-first-match) - (define-key map [(control ?@)] 'ido-restrict-to-matches) - (define-key map [right] 'ido-next-match) - (define-key map [left] 'ido-prev-match) - (define-key map "?" 'ido-completion-help) - ;; Magic commands. - (define-key map "\C-b" 'ido-magic-backward-char) - (define-key map "\C-f" 'ido-magic-forward-char) - (define-key map "\C-d" 'ido-magic-delete-char) - (set-keymap-parent map minibuffer-local-map) - (setq ido-common-completion-map map)) - - ;; File and directory map - (let ((map (make-sparse-keymap))) - (define-key map "\C-x\C-b" 'ido-enter-switch-buffer) - (define-key map "\C-x\C-f" 'ido-fallback-command) - (define-key map "\C-x\C-d" 'ido-enter-dired) - (define-key map [down] 'ido-next-match-dir) - (define-key map [up] 'ido-prev-match-dir) - (define-key map [(meta up)] 'ido-prev-work-directory) - (define-key map [(meta down)] 'ido-next-work-directory) - (define-key map [backspace] 'ido-delete-backward-updir) - (define-key map "\d" 'ido-delete-backward-updir) - (define-key map [remap delete-backward-char] 'ido-delete-backward-updir) ; BS - (define-key map [remap backward-kill-word] 'ido-delete-backward-word-updir) ; M-DEL - - (define-key map [(control backspace)] 'ido-up-directory) - (define-key map "\C-l" 'ido-reread-directory) - (define-key map [(meta ?d)] 'ido-wide-find-dir-or-delete-dir) - (define-key map [(meta ?b)] 'ido-push-dir) - (define-key map [(meta ?v)] 'ido-push-dir-first) - (define-key map [(meta ?f)] 'ido-wide-find-file-or-pop-dir) - (define-key map [(meta ?k)] 'ido-forget-work-directory) - (define-key map [(meta ?m)] 'ido-make-directory) - (define-key map [(meta ?n)] 'ido-next-work-directory) - (define-key map [(meta ?o)] 'ido-prev-work-file) - (define-key map [(meta control ?o)] 'ido-next-work-file) - (define-key map [(meta ?p)] 'ido-prev-work-directory) - (define-key map [(meta ?s)] 'ido-merge-work-directories) - (set-keymap-parent map ido-common-completion-map) - (setq ido-file-dir-completion-map map)) - - ;; File only map - (let ((map (make-sparse-keymap))) - (define-key map "\C-k" 'ido-delete-file-at-head) - (define-key map "\C-o" 'ido-copy-current-word) - (define-key map "\C-w" 'ido-copy-current-file-name) - (define-key map [(meta ?l)] 'ido-toggle-literal) - (set-keymap-parent map ido-file-dir-completion-map) - (setq ido-file-completion-map map)) +(defalias 'ido-init-completion-maps 'ignore "") +(make-obsolete 'ido-init-completion-maps "it does nothing." "25.1") - ;; Buffer map - (let ((map (make-sparse-keymap))) - (define-key map "\C-x\C-f" 'ido-enter-find-file) - (define-key map "\C-x\C-b" 'ido-fallback-command) - (define-key map "\C-k" 'ido-kill-buffer-at-head) - (define-key map "\C-o" 'ido-toggle-virtual-buffers) - (set-keymap-parent map ido-common-completion-map) - (setq ido-buffer-completion-map map))) +(defun ido-setup-completion-map () + "Set up the completion keymap used by Ido. +Create a keymap, bind `ido-completion-map' to it, and depending +on what is being completed (`ido-cur-item') set its parent keymap +to one of: -(defun ido-setup-completion-map () - "Set up the keymap for Ido." + `ido-common-completion-map' + `ido-file-dir-completion-map' + `ido-file-completion-map' + `ido-buffer-completion-map' +If option `ido-context-switch-command' is non-nil or `viper-mode' +is enabled then some keybindings are changed in the keymap." ;; generated every time so that it can inherit new functions. (let ((map (make-sparse-keymap)) (viper-p (if (boundp 'viper-mode) viper-mode))) - (when viper-p (define-key map [remap viper-intercept-ESC-key] 'ignore)) - - (cond - ((memq ido-cur-item '(file dir)) + (pcase ido-cur-item + ((or `file `dir) (when ido-context-switch-command (define-key map "\C-x\C-b" ido-context-switch-command) (define-key map "\C-x\C-d" 'ignore)) (when viper-p - (define-key map [remap viper-backward-char] 'ido-delete-backward-updir) - (define-key map [remap viper-del-backward-char-in-insert] 'ido-delete-backward-updir) - (define-key map [remap viper-delete-backward-word] 'ido-delete-backward-word-updir)) + (define-key map [remap viper-backward-char] + 'ido-delete-backward-updir) + (define-key map [remap viper-del-backward-char-in-insert] + 'ido-delete-backward-updir) + (define-key map [remap viper-delete-backward-word] + 'ido-delete-backward-word-updir)) (set-keymap-parent map (if (eq ido-cur-item 'file) ido-file-completion-map ido-file-dir-completion-map))) - - ((eq ido-cur-item 'buffer) + (`buffer (when ido-context-switch-command (define-key map "\C-x\C-f" ido-context-switch-command)) (set-keymap-parent map ido-buffer-completion-map)) - - (t + (_ (set-keymap-parent map ido-common-completion-map))) - (setq ido-completion-map map))) (defun ido-final-slash (dir &optional fix-it) @@ -4027,6 +4026,20 @@ If cursor is not at the end of the user input, delete to end of input." (setq ido-cur-list (delete buf ido-cur-list)) (setq ido-rescan t)))))) +;;; BURY CURRENT BUFFER +(defun ido-bury-buffer-at-head () + "Bury the buffer at the head of `ido-matches'." + (interactive) + (let ((enable-recursive-minibuffers t) + (buf (ido-name (car ido-matches))) + (nextbuf (cadr ido-matches))) + (when (get-buffer buf) + (bury-buffer buf) + (setq ido-default-item nextbuf + ido-text-init ido-text + ido-exit 'refresh) + (exit-minibuffer)))) + ;;; DELETE CURRENT FILE (defun ido-delete-file-at-head () "Delete the file at the head of `ido-matches'. diff --git a/lisp/ielm.el b/lisp/ielm.el index 01d14b5de48..be877eb250a 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -380,7 +380,7 @@ nonempty, then flushes the buffer." (*3 ***) (active-process (ielm-process)) (old-standard-output standard-output) - new-standard-output + new-standard-output ielm-temp-buffer) (set-match-data ielm-match-data) (save-excursion @@ -541,7 +541,9 @@ Customized bindings may be defined in `ielm-map', which currently contains: (setq comint-process-echoes nil) (set (make-local-variable 'completion-at-point-functions) '(comint-replace-by-expanded-history - ielm-complete-filename lisp-completion-at-point)) + ielm-complete-filename elisp-completion-at-point)) + (add-function :before-until (local 'eldoc-documentation-function) + #'elisp-eldoc-documentation-function) (set (make-local-variable 'ielm-prompt-internal) ielm-prompt) (set (make-local-variable 'comint-prompt-read-only) ielm-prompt-read-only) (setq comint-get-old-input 'ielm-get-old-input) diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 2ed7fbeec67..9e527f1f0b3 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -49,6 +49,26 @@ "Special hook run when image data is requested in a new window. It is called with one argument, the initial WINPROPS.") +;; FIXME this doesn't seem mature yet. Document in manual when it is. +(defvar image-transform-resize nil + "The image resize operation. +Its value should be one of the following: + - nil, meaning no resizing. + - `fit-height', meaning to fit the image to the window height. + - `fit-width', meaning to fit the image to the window width. + - A number, which is a scale factor (the default size is 1).") + +(defvar image-transform-scale 1.0 + "The scale factor of the image being displayed.") + +(defvar image-transform-rotation 0.0 + "Rotation angle for the image in the current Image mode buffer.") + +(defvar image-transform-right-angle-fudge 0.0001 + "Snap distance to a multiple of a right angle. +There's no deep theory behind the default value, it should just +be somewhat larger than ImageMagick's MagickEpsilon.") + (defun image-mode-winprops (&optional window cleanup) "Return winprops of WINDOW. A winprops object has the shape (WINDOW . ALIST). @@ -90,6 +110,8 @@ otherwise it defaults to t, used for times when the buffer is not displayed." (defun image-mode-window-put (prop val &optional winprops) (unless (consp winprops) (setq winprops (image-mode-winprops winprops))) + (unless (eq t (car winprops)) + (image-mode-window-put prop val t)) (setcdr winprops (cons (cons prop val) (delq (assq prop (cdr winprops)) (cdr winprops))))) @@ -377,8 +399,6 @@ call." ["Show as Text" image-toggle-display :active t :help "Show image as text"] "--" - ["Fit Frame to Image" image-mode-fit-frame :active t - :help "Resize frame to match image"] ["Fit to Window Height" image-transform-fit-to-height :visible (eq image-type 'imagemagick) :help "Resize image to match the window height"] @@ -388,6 +408,9 @@ call." ["Rotate Image..." image-transform-set-rotation :visible (eq image-type 'imagemagick) :help "Rotate the image"] + ["Reset Transformations" image-transform-reset + :visible (eq image-type 'imagemagick) + :help "Reset all image transformations"] "--" ["Show Thumbnails" (lambda () @@ -400,6 +423,9 @@ call." ["Previous Image" image-previous-file :active buffer-file-name :help "Move to previous image in this directory"] "--" + ["Fit Frame to Image" image-mode-fit-frame :active t + :help "Resize frame to match image"] + "--" ["Animate Image" image-toggle-animation :style toggle :selected (let ((image (image-get-display-property))) (and image (image-animate-timer image))) @@ -636,8 +662,19 @@ was inserted." (string-make-unibyte (buffer-substring-no-properties (point-min) (point-max))) filename)) - (type (image-type file-or-data nil data-p)) - (image (create-image file-or-data type data-p)) + ;; If we have a `fit-width' or a `fit-height', don't limit + ;; the size of the image to the window size. + (edges (and (null image-transform-resize) + (window-inside-pixel-edges + (get-buffer-window (current-buffer))))) + (type (if (fboundp 'imagemagick-types) + 'imagemagick + (image-type file-or-data nil data-p))) + (image (if (not edges) + (create-image file-or-data type data-p) + (create-image file-or-data type data-p + :max-width (- (nth 2 edges) (nth 0 edges)) + :max-height (- (nth 3 edges) (nth 1 edges))))) (inhibit-read-only t) (buffer-undo-list t) (modified (buffer-modified-p)) @@ -888,26 +925,6 @@ replacing the current Image mode buffer." ;; nil "image-transform" image-transform-minor-mode-map) -;; FIXME this doesn't seem mature yet. Document in manual when it is. -(defvar image-transform-resize nil - "The image resize operation. -Its value should be one of the following: - - nil, meaning no resizing. - - `fit-height', meaning to fit the image to the window height. - - `fit-width', meaning to fit the image to the window width. - - A number, which is a scale factor (the default size is 1).") - -(defvar image-transform-scale 1.0 - "The scale factor of the image being displayed.") - -(defvar image-transform-rotation 0.0 - "Rotation angle for the image in the current Image mode buffer.") - -(defvar image-transform-right-angle-fudge 0.0001 - "Snap distance to a multiple of a right angle. -There's no deep theory behind the default value, it should just -be somewhat larger than ImageMagick's MagickEpsilon.") - (defsubst image-transform-width (width height) "Return the bounding box width of a rotated WIDTH x HEIGHT rectangle. The rotation angle is the value of `image-transform-rotation' in degrees." @@ -1089,6 +1106,16 @@ Emacs is compiled with ImageMagick support." (setq image-transform-rotation (float (mod rotation 360))) (image-toggle-display-image)) +(defun image-transform-reset () + "Display the current image with the default size and rotation. +This command has no effect unless Emacs is compiled with +ImageMagick support." + (interactive) + (setq image-transform-resize nil + image-transform-rotation 0.0 + image-transform-scale 1) + (image-toggle-display-image)) + (provide 'image-mode) ;;; image-mode.el ends here diff --git a/lisp/imenu.el b/lisp/imenu.el index 316905fd0fd..65c52828c47 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -936,6 +936,8 @@ The returned value is of the form (INDEX-NAME . INDEX-POSITION)." (setq result t imenu--index-alist nil))) result)) +(defvar-local imenu--menubar-keymap nil) + ;;;###autoload (defun imenu-add-to-menubar (name) "Add an `imenu' entry to the menu bar for the current buffer. @@ -952,8 +954,9 @@ See the command `imenu' for more information." (let ((newmap (make-sparse-keymap))) (set-keymap-parent newmap (current-local-map)) (setq imenu--last-menubar-index-alist nil) + (setq imenu--menubar-keymap (make-sparse-keymap "Imenu")) (define-key newmap [menu-bar index] - `(menu-item ,name ,(make-sparse-keymap "Imenu"))) + `(menu-item ,name ,imenu--menubar-keymap)) (use-local-map newmap) (add-hook 'menu-bar-update-hook 'imenu-update-menubar))) (user-error "The mode `%s' does not support Imenu" @@ -975,28 +978,23 @@ to `imenu-update-menubar'.") (defun imenu-update-menubar () (when (and (current-local-map) - (keymapp (lookup-key (current-local-map) [menu-bar index])) + imenu--menubar-keymap (/= (buffer-chars-modified-tick) imenu-menubar-modified-tick)) (setq imenu-menubar-modified-tick (buffer-chars-modified-tick)) (let ((index-alist (imenu--make-index-alist t))) ;; Don't bother updating if the index-alist has not changed ;; since the last time we did it. (unless (equal index-alist imenu--last-menubar-index-alist) - (let (menu menu1 old) - (setq imenu--last-menubar-index-alist index-alist) - (setq index-alist (imenu--split-submenus index-alist)) - (setq menu (imenu--split-menu index-alist - (buffer-name))) - (setq menu1 (imenu--create-keymap (car menu) + (setq imenu--last-menubar-index-alist index-alist) + (setq index-alist (imenu--split-submenus index-alist)) + (let* ((menu (imenu--split-menu index-alist + (buffer-name))) + (menu1 (imenu--create-keymap (car menu) (cdr (if (< 1 (length (cdr menu))) menu (car (cdr menu)))) - 'imenu--menubar-select)) - (setq old (lookup-key (current-local-map) [menu-bar index])) - ;; This should never happen, but in some odd cases, potentially, - ;; lookup-key may return a dynamically composed keymap. - (if (keymapp (cadr old)) (setq old (cadr old))) - (setcdr old (cdr menu1))))))) + 'imenu--menubar-select))) + (setcdr imenu--menubar-keymap (cdr menu1))))))) (defun imenu--menubar-select (item) "Use Imenu to select the function or variable named in this menu ITEM." @@ -1034,16 +1032,13 @@ for more information." (if (stringp index-item) (setq index-item (assoc index-item (imenu--make-index-alist)))) (when index-item - (push-mark nil t) - (let* ((is-special-item (listp (cdr index-item))) - (function - (if is-special-item - (nth 2 index-item) imenu-default-goto-function)) - (position (if is-special-item - (cadr index-item) (cdr index-item))) - (args (if is-special-item (cdr (cddr index-item))))) - (apply function (car index-item) position args)) - (run-hooks 'imenu-after-jump-hook))) + (pcase index-item + (`(,name ,pos ,fn . ,args) + (push-mark nil t) + (apply fn name pos args) + (run-hooks 'imenu-after-jump-hook)) + (`(,name . ,pos) (imenu (list name pos imenu-default-goto-function))) + (_ (error "Unknown imenu item: %S" index-item))))) (provide 'imenu) diff --git a/lisp/info.el b/lisp/info.el index 84c0879060f..01596619476 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1,4 +1,4 @@ -;; info.el --- info package for Emacs +;; info.el --- Info package for Emacs -*- lexical-binding:t -*- ;; Copyright (C) 1985-1986, 1992-2015 Free Software Foundation, Inc. @@ -32,17 +32,19 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defgroup info nil "Info subsystem." :group 'help :group 'docs) -(defvar Info-history nil +(defvar-local Info-history nil "Stack of Info nodes user has visited. Each element of the stack is a list (FILENAME NODENAME BUFFERPOS).") -(defvar Info-history-forward nil +(defvar-local Info-history-forward nil "Stack of Info nodes user has visited with `Info-history-back' command. Each element of the stack is a list (FILENAME NODENAME BUFFERPOS).") @@ -136,10 +138,15 @@ The Lisp code is executed when the node is selected.") :type 'boolean :group 'info) -(defcustom Info-fontify-maximum-menu-size 100000 +;; It's unfortunate that nil means no fontification, as opposed to no limit, +;; since that differs from font-lock-maximum-size. +(defcustom Info-fontify-maximum-menu-size 400000 "Maximum size of menu to fontify if `font-lock-mode' is non-nil. -Set to nil to disable node fontification." - :type 'integer +Set to nil to disable node fontification; set to t for no limit." + :type '(choice (const :tag "No fontification" nil) + (const :tag "No size limit" t) + (integer :tag "Up to this many characters")) + :version "25.1" ; 100k -> 400k :group 'info) (defcustom Info-use-header-line t @@ -375,33 +382,33 @@ with wrapping around the current Info node." (make-obsolete-variable 'Info-edit-mode-hook "editing Info nodes by hand is not recommended." "24.4") -(defvar Info-current-file nil +(defvar-local Info-current-file nil "Info file that Info is now looking at, or nil. This is the name that was specified in Info, not the actual file name. It doesn't contain directory names or file name extensions added by Info.") -(defvar Info-current-subfile nil +(defvar-local Info-current-subfile nil "Info subfile that is actually in the *info* buffer now. It is nil if current Info file is not split into subfiles.") -(defvar Info-current-node nil +(defvar-local Info-current-node nil "Name of node that Info is now looking at, or nil.") -(defvar Info-tag-table-marker nil +(defvar-local Info-tag-table-marker nil "Marker pointing at beginning of current Info file's tag table. Marker points nowhere if file has no tag table.") -(defvar Info-tag-table-buffer nil +(defvar-local Info-tag-table-buffer nil "Buffer used for indirect tag tables.") -(defvar Info-current-file-completions nil +(defvar-local Info-current-file-completions nil "Cached completion list for current Info file.") (defvar Info-file-completions nil "Cached completion alist of visited Info files. Each element of the alist is (FILE . COMPLETIONS)") -(defvar Info-file-supports-index-cookies nil +(defvar-local Info-file-supports-index-cookies nil "Non-nil if current Info file supports index cookies.") (defvar Info-file-supports-index-cookies-list nil @@ -409,7 +416,7 @@ Each element of the alist is (FILE . COMPLETIONS)") Each element of the list is a list (FILENAME SUPPORTS-INDEX-COOKIES) where SUPPORTS-INDEX-COOKIES can be either t or nil.") -(defvar Info-index-alternatives nil +(defvar-local Info-index-alternatives nil "List of possible matches for last `Info-index' command.") (defvar Info-point-loc nil @@ -455,7 +462,7 @@ existing node names. OPERATION is one of the following operation symbols `find-node' that define what HANDLER function to call instead of calling the default corresponding function to override it.") -(defvar Info-current-node-virtual nil +(defvar-local Info-current-node-virtual nil "Non-nil if the current Info node is virtual.") (defun Info-virtual-file-p (filename) @@ -953,10 +960,10 @@ otherwise, that defaults to `Top'." (unless nodename (setq nodename "Top")) (info-initialize) (Info-mode) - (set (make-local-variable 'Info-current-file) - (or buffer-file-name - ;; If called on a non-file buffer, make a fake file name. - (concat default-directory (buffer-name)))) + (setq Info-current-file + (or buffer-file-name + ;; If called on a non-file buffer, make a fake file name. + (concat default-directory (buffer-name)))) (Info-find-node-2 nil nodename)) (defun Info-revert-find-node (filename nodename) @@ -1090,7 +1097,7 @@ is non-nil)." (set-marker Info-tag-table-marker nil) (setq buffer-read-only t) (set-buffer-modified-p nil) - (set (make-local-variable 'Info-current-node-virtual) t))) + (setq Info-current-node-virtual t))) ((not (and ;; Reread a file when moving from a virtual node. (not Info-current-node-virtual) @@ -1100,7 +1107,7 @@ is non-nil)." (let ((inhibit-read-only t)) (when Info-current-node-virtual ;; When moving from a virtual node. - (set (make-local-variable 'Info-current-node-virtual) nil) + (setq Info-current-node-virtual nil) (if (null filename) (setq filename Info-current-file))) (setq Info-current-file nil @@ -1111,7 +1118,7 @@ is non-nil)." (info-insert-file-contents filename nil) (setq default-directory (file-name-directory filename)) (set-buffer-modified-p nil) - (set (make-local-variable 'Info-file-supports-index-cookies) + (setq Info-file-supports-index-cookies (Info-file-supports-index-cookies filename)) ;; See whether file has a tag table. Record the location if yes. @@ -1250,17 +1257,17 @@ is non-nil)." ;; Cache the contents of the (virtual) dir file, once we have merged ;; it for the first time, so we can save time subsequently. -(defvar Info-dir-contents nil) +(defvar-local Info-dir-contents nil) ;; Cache for the directory we decided to use for the default-directory ;; of the merged dir text. -(defvar Info-dir-contents-directory nil) +(defvar-local Info-dir-contents-directory nil) ;; Record the file attributes of all the files from which we ;; constructed Info-dir-contents. -(defvar Info-dir-file-attributes nil) +(defvar-local Info-dir-file-attributes nil) -(defvar Info-dir-file-name nil) +(defvar-local Info-dir-file-name nil) ;; Construct the Info directory node by merging the files named `dir' ;; from various directories. Set the *info* buffer's @@ -1333,13 +1340,12 @@ is non-nil)." ;; knows... (let ((inhibit-null-byte-detection t)) (insert-file-contents file) - (set (make-local-variable 'Info-dir-file-name) - file) + (setq Info-dir-file-name file) (push (current-buffer) buffers) (push (cons file attrs) dir-file-attrs)) (error (kill-buffer (current-buffer)))))))) (unless (cdr dirs) - (set (make-local-variable 'Info-dir-contents-directory) + (setq Info-dir-contents-directory (file-name-as-directory (car dirs)))) (setq dirs (cdr dirs)))) @@ -1424,8 +1430,8 @@ is non-nil)." (if problems (message "Composing main Info directory...problems encountered, see `*Messages*'") (message "Composing main Info directory...done")) - (set (make-local-variable 'Info-dir-contents) (buffer-string)) - (set (make-local-variable 'Info-dir-file-attributes) dir-file-attrs))) + (setq Info-dir-contents (buffer-string)) + (setq Info-dir-file-attributes dir-file-attrs))) (setq default-directory Info-dir-contents-directory)) (defvar Info-streamline-headings @@ -1891,7 +1897,7 @@ the Top node in FILENAME." (cons (list (match-string-no-properties 1)) compl)))))))) (setq compl (cons '("*") (nreverse compl))) - (set (make-local-variable 'Info-current-file-completions) compl) + (setq Info-current-file-completions compl) compl)) @@ -2206,7 +2212,7 @@ End of submatch 0, 1, and 3 are the same, so you can safely concat." "[" (or allowedchars "^,\t\n") " ]" ;The last char can't be a space. "\\|\\)\\)")) ;Allow empty node names. -;;; For compatibility; other files have used this name. +;; For compatibility; other files have used this name. (defun Info-following-node-name () (and (looking-at (Info-following-node-name-re)) (match-string-no-properties 1))) @@ -2644,7 +2650,7 @@ Because of ambiguities, this should be concatenated with something like (defvar Info-complete-menu-buffer) (defvar Info-complete-next-re nil) (defvar Info-complete-nodes nil) -(defvar Info-complete-cache nil) +(defvar-local Info-complete-cache nil) (defconst Info-node-spec-re (concat (Info-following-node-name-re "^.,:") "[,:.]") @@ -2689,9 +2695,7 @@ Because of ambiguities, this should be concatenated with something like (equal (nth 1 Info-complete-cache) Info-current-node) (equal (nth 2 Info-complete-cache) Info-complete-next-re) (equal (nth 5 Info-complete-cache) Info-complete-nodes) - (let ((prev (nth 3 Info-complete-cache))) - (eq t (compare-strings string 0 (length prev) - prev 0 nil t)))) + (string-prefix-p (nth 3 Info-complete-cache) string) t) ;; We can reuse the previous list. (setq completions (nth 4 Info-complete-cache)) ;; The cache can't be used. @@ -2713,7 +2717,7 @@ Because of ambiguities, this should be concatenated with something like (unless (equal Info-current-node orignode) (Info-goto-node orignode)) ;; Update the cache. - (set (make-local-variable 'Info-complete-cache) + (setq Info-complete-cache (list Info-current-file Info-current-node Info-complete-next-re string completions Info-complete-nodes))) @@ -3561,9 +3565,9 @@ Return a list of matches where each element is in the format (goto-char (point-min)) (re-search-forward "\\* Menu: *\n" nil t) (while (re-search-forward "\\*.*: *(\\([^)]+\\))" nil t) - ;; add-to-list makes sure we don't have duplicates in `manuals', + ;; Make sure we don't have duplicates in `manuals', ;; so that the following dolist loop runs faster. - (add-to-list 'manuals (match-string 1))) + (cl-pushnew (match-string 1) manuals :test #'equal)) (dolist (manual (nreverse manuals)) (message "Searching %s" manual) (condition-case err @@ -3632,6 +3636,18 @@ Build a menu of the possible matches." (defvar finder-keywords-hash) (defvar package--builtins) ; finder requires package +(defun info--prettify-description (desc) + (if (stringp desc) + (with-temp-buffer + (insert desc) + (if (equal ?. (char-before)) + (delete-char -1)) + (goto-char (point-min)) + (or (let (case-fold-search) (looking-at-p "\\.\\|[[:upper:]]")) + (capitalize-word 1)) + (buffer-string)) + desc)) + (defun Info-finder-find-node (_filename nodename &optional _no-going-back) "Finder-specific implementation of `Info-find-node-2'." (require 'finder) @@ -3650,7 +3666,7 @@ Build a menu of the possible matches." (insert (format "* %s %s.\n" (concat (symbol-name keyword) ": " "Keyword " (symbol-name keyword) ".") - (cdr assoc)))))) + (info--prettify-description (cdr assoc))))))) ((equal nodename "Keyword unknown") ;; Display unknown keywords (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n" @@ -3678,7 +3694,7 @@ Build a menu of the possible matches." (when (vectorp desc) (insert (format "* %-16s %s.\n" (concat (symbol-name (car package)) "::") - (aref desc 2))))))) + (info--prettify-description (aref desc 2)))))))) ((string-match "\\`Keyword " nodename) (setq nodename (substring nodename (match-end 0))) ;; Display packages that match the keyword @@ -3699,27 +3715,31 @@ Build a menu of the possible matches." (push (copy-tree (gethash keyword finder-keywords-hash)) hits)) (setq hits (delete-dups (apply 'append hits)) ;; Not a meaningful package. - hits (delete 'emacs hits)) + hits (delete 'emacs hits) + hits (sort hits (lambda (a b) (string< (symbol-name a) + (symbol-name b))))) (dolist (package hits) (setq desc (cdr-safe (assq package package--builtins))) (when (vectorp desc) (insert (format "* %-16s %s.\n" (concat (symbol-name package) "::") - (aref desc 2))))))) + (info--prettify-description (aref desc 2)))))))) (t ;; Display commentary section (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n" Info-finder-file nodename)) - (insert "Finder Commentary\n") - (insert "*****************\n\n") + (insert "Package Description\n") + (insert "*******************\n\n") (insert - "Commentary section of the package `" nodename "':\n\n") - ;; FIXME this assumes that a file named package.el exists, + "Description of the package `" nodename "':\n\n") + ;; This assumes that a file named package.el exists, ;; which is not always true. E.g. for the nxml package, ;; there is no "nxml.el" (it's nxml-mode.el). - (let ((str (lm-commentary (find-library-name nodename)))) + ;; But package.el makes the same assumption. + ;; I think nxml is the only exception - maybe it should be just be renamed. + (let ((str (ignore-errors (lm-commentary (find-library-name nodename))))) (if (null str) - (insert "Can't find any Commentary section\n\n") + (insert "Can't find package description.\n\n") (insert (with-temp-buffer (insert str) @@ -3993,7 +4013,6 @@ If FORK is non-nil, it is passed to `Info-goto-node'." (define-key map "," 'Info-index-next) (define-key map "\177" 'Info-scroll-down) (define-key map [mouse-2] 'Info-mouse-follow-nearest-node) - (define-key map [down-mouse-2] 'ignore) ;Override potential global binding. (define-key map [follow-link] 'mouse-face) (define-key map [XF86Back] 'Info-history-back) (define-key map [XF86Forward] 'Info-history-forward) @@ -4192,9 +4211,16 @@ With a zero prefix arg, put the name inside a function call to `info'." st) "Syntax table used in `Info-mode'.") +(defface Info-quoted + '((t :family "courier")) + "Face used for quoted elements.") + +(defvar Info-mode-font-lock-keywords + '(("‘\\([^’]*\\)’" (1 'Info-quoted)))) + ;; Autoload cookie needed by desktop.el ;;;###autoload -(define-derived-mode Info-mode nil "Info" +(define-derived-mode Info-mode nil "Info" ;FIXME: Derive from special-mode? "Info mode provides commands for browsing through the Info documentation tree. Documentation in Info is divided into \"nodes\", each of which discusses one topic and contains references to other nodes which discuss related @@ -4262,39 +4288,27 @@ Advanced commands: (add-hook 'activate-menubar-hook 'Info-menu-update nil t) (setq case-fold-search t) (setq buffer-read-only t) - (make-local-variable 'Info-current-file) - (make-local-variable 'Info-current-subfile) - (make-local-variable 'Info-current-node) - (set (make-local-variable 'Info-tag-table-marker) (make-marker)) - (set (make-local-variable 'Info-tag-table-buffer) nil) - (make-local-variable 'Info-history) - (make-local-variable 'Info-history-forward) - (make-local-variable 'Info-index-alternatives) + (setq Info-tag-table-marker (make-marker)) (if Info-use-header-line ; do not override global header lines (setq header-line-format '(:eval (get-text-property (point-min) 'header-line)))) - (set (make-local-variable 'tool-bar-map) info-tool-bar-map) + (setq-local tool-bar-map info-tool-bar-map) ;; This is for the sake of the invisible text we use handling titles. - (set (make-local-variable 'line-move-ignore-invisible) t) - (set (make-local-variable 'desktop-save-buffer) - 'Info-desktop-buffer-misc-data) - (set (make-local-variable 'widen-automatically) nil) + (setq-local line-move-ignore-invisible t) + (setq-local desktop-save-buffer 'Info-desktop-buffer-misc-data) + (setq-local widen-automatically nil) (add-hook 'kill-buffer-hook 'Info-kill-buffer nil t) (add-hook 'clone-buffer-hook 'Info-clone-buffer nil t) (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) (add-hook 'isearch-mode-hook 'Info-isearch-start nil t) - (set (make-local-variable 'isearch-search-fun-function) - 'Info-isearch-search) - (set (make-local-variable 'isearch-wrap-function) - 'Info-isearch-wrap) - (set (make-local-variable 'isearch-push-state-function) - 'Info-isearch-push-state) - (set (make-local-variable 'isearch-filter-predicate) #'Info-isearch-filter) - (set (make-local-variable 'revert-buffer-function) - 'Info-revert-buffer-function) + (setq-local isearch-search-fun-function #'Info-isearch-search) + (setq-local isearch-wrap-function #'Info-isearch-wrap) + (setq-local isearch-push-state-function #'Info-isearch-push-state) + (setq-local isearch-filter-predicate #'Info-isearch-filter) + (setq-local revert-buffer-function #'Info-revert-buffer-function) + (setq-local font-lock-defaults '(Info-mode-font-lock-keywords t t)) (Info-set-mode-line) - (set (make-local-variable 'bookmark-make-record-function) - 'Info-bookmark-make-record)) + (setq-local bookmark-make-record-function #'Info-bookmark-make-record)) ;; When an Info buffer is killed, make sure the associated tags buffer ;; is killed too. @@ -4323,7 +4337,7 @@ Advanced commands: map) "Local keymap used within `e' command of Info.") -(make-obsolete-variable 'Info-edit-map +(make-obsolete-variable 'Info-edit-mode-map "editing Info nodes by hand is not recommended." "24.4") @@ -4333,8 +4347,7 @@ Advanced commands: (define-derived-mode Info-edit-mode text-mode "Info Edit" "Major mode for editing the contents of an Info node. Like text mode with the addition of `Info-cease-edit' -which returns to Info mode for browsing. -\\{Info-edit-map}" +which returns to Info mode for browsing." (setq buffer-read-only nil) (force-mode-line-update) (buffer-enable-undo (current-buffer))) @@ -4347,7 +4360,7 @@ which returns to Info mode for browsing. (interactive) (Info-edit-mode) (message "%s" (substitute-command-keys - "Editing: Type \\<Info-edit-map>\\[Info-cease-edit] to return to info"))) + "Editing: Type \\<Info-edit-mode-map>\\[Info-cease-edit] to return to info"))) (put 'Info-edit 'disabled "Editing Info nodes by hand is not recommended. This feature will be removed in future.") @@ -4596,7 +4609,9 @@ first line or header line, and for breadcrumb links.") (and Info-fontify-visited-nodes ;; Don't take time to refontify visited nodes in huge nodes Info-fontify-maximum-menu-size - (< (- (point-max) (point-min)) Info-fontify-maximum-menu-size))) + (or (eq Info-fontify-maximum-menu-size t) + (< (- (point-max) (point-min)) + Info-fontify-maximum-menu-size)))) rbeg rend) ;; Fontify header line @@ -4853,7 +4868,9 @@ first line or header line, and for breadcrumb links.") (search-forward "\n* Menu:" nil t) ;; Don't take time to annotate huge menus Info-fontify-maximum-menu-size - (< (- (point-max) (point)) Info-fontify-maximum-menu-size)) + (or (eq Info-fontify-maximum-menu-size t) + (< (- (point-max) (point)) + Info-fontify-maximum-menu-size))) (let ((n 0) cont) (while (re-search-forward @@ -5260,13 +5277,15 @@ type returned by `Info-bookmark-make-record', which see." (defun info-display-manual (manual) "Display an Info buffer displaying MANUAL. If there is an existing Info buffer for MANUAL, display it. -Otherwise, visit the manual in a new Info buffer." +Otherwise, visit the manual in a new Info buffer. In interactive +use, a prefix argument directs this command to limit the +completion alternatives to currently visited manuals." (interactive (list (progn (info-initialize) (completing-read "Manual name: " - (info--manual-names) + (info--manual-names current-prefix-arg) nil t)))) (let ((blist (buffer-list)) (manual-re (concat "\\(/\\|\\`\\)" manual "\\(\\.\\|\\'\\)")) @@ -5285,7 +5304,7 @@ Otherwise, visit the manual in a new Info buffer." (info (Info-find-file manual) (generate-new-buffer-name "*info*"))))) -(defun info--manual-names () +(defun info--manual-names (visited-only) (let (names) (dolist (buffer (buffer-list)) (with-current-buffer buffer @@ -5296,11 +5315,12 @@ Otherwise, visit the manual in a new Info buffer." (file-name-nondirectory Info-current-file)) names)))) (delete-dups (append (nreverse names) - (all-completions - "" - (apply-partially 'Info-read-node-name-2 - Info-directory-list - (mapcar 'car Info-suffix-list))))))) + (when (not visited-only) + (all-completions + "" + (apply-partially 'Info-read-node-name-2 + Info-directory-list + (mapcar 'car Info-suffix-list)))))))) (provide 'info) diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el index 9eb091f80c1..429c14b5e44 100644 --- a/lisp/international/ccl.el +++ b/lisp/international/ccl.el @@ -1355,6 +1355,14 @@ IF := (if EXPRESSION CCL_BLOCK_0 CCL_BLOCK_1) BRANCH := (branch EXPRESSION CCL_BLOCK_0 [CCL_BLOCK_1 ...]) ;; Execute STATEMENTs until (break) or (end) is executed. + +;; Create a block of STATEMENTs for repeating. The STATEMENTs +;; are executed sequentially until REPEAT or BREAK is executed. +;; If REPEAT statement is executed, STATEMENTs are executed from the +;; start again. If BREAK statements is executed, the execution +;; exits from the block. If neither REPEAT nor BREAK is +;; executed, the execution exits from the block after executing the +;; last STATEMENT. LOOP := (loop STATEMENT [STATEMENT ...]) ;; Terminate the most inner loop. @@ -1501,17 +1509,42 @@ ARRAY := `[' integer ... `]' TRANSLATE := - (translate-character REG(table) REG(charset) REG(codepoint)) - | (translate-character SYMBOL REG(charset) REG(codepoint)) - ;; SYMBOL must refer to a table defined by `define-translation-table'. + ;; Decode character SRC, translate it by translate table + ;; TABLE, and encode it back to DST. TABLE is specified + ;; by its id number in REG_0, SRC is specified by its + ;; charset id number and codepoint in REG_1 and REG_2 + ;; respectively. + ;; On encoding, the charset of highest priority is selected. + ;; After the execution, DST is specified by its charset + ;; id number and codepoint in REG_1 and REG_2 respectively. + (translate-character REG_0 REG_1 REG_2) + + ;; Same as above except for SYMBOL specifying the name of + ;; the translate table defined by `define-translation-table'. + | (translate-character SYMBOL REG_1 REG_2) + LOOKUP := - (lookup-character SYMBOL REG(charset) REG(codepoint)) + ;; Look up character SRC in hash table TABLE. TABLE is + ;; specified by its name in SYMBOL, and SRC is specified by + ;; its charset id number and codepoint in REG_1 and REG_2 + ;; respectively. + ;; If its associated value is an integer, set REG_1 to that + ;; value, and set r7 to 1. Otherwise, set r7 to 0. + (lookup-character SYMBOL REG_1 REG_2) + + ;; Look up integer value N in hash table TABLE. TABLE is + ;; specified by its name in SYMBOL and N is specified in + ;; REG. + ;; If its associated value is a character, set REG to that + ;; value, and set r7 to 1. Otherwise, set r7 to 0. | (lookup-integer SYMBOL REG(integer)) - ;; SYMBOL refers to a table defined by `define-translation-hash-table'. + MAP := - (iterate-multiple-map REG REG MAP-IDs) - | (map-multiple REG REG (MAP-SET)) - | (map-single REG REG MAP-ID) + ;; The following statements are for internal use only. + (iterate-multiple-map REG REG MAP-IDs) + | (map-multiple REG REG (MAP-SET)) + | (map-single REG REG MAP-ID) + MAP-IDs := MAP-ID ... MAP-SET := MAP-IDs | (MAP-IDs) MAP-SET MAP-ID := integer diff --git a/lisp/international/characters.el b/lisp/international/characters.el index 4cc9d0e0c83..247a10dd38f 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -495,12 +495,13 @@ with L, LRE, or LRO Unicode bidi character type.") (modify-category-entry key ?L)))) table))) -;; Load uni-mirrored.el if available, so that it gets dumped into -;; Emacs. This allows to start Emacs with force-load-messages in -;; ~/.emacs, and avoid infinite recursion in bidi_initialize, which -;; needs to load uni-mirrored.el in order to display the "Loading" -;; messages. +;; Load uni-mirrored.el and uni-brackets.el if available, so that they +;; get dumped into Emacs. This allows to start Emacs with +;; force-load-messages in ~/.emacs, and avoid infinite recursion in +;; bidi_initialize, which needs to load uni-mirrored.el and +;; uni-brackets.el in order to display the "Loading" messages. (unicode-property-table-internal 'mirroring) +(unicode-property-table-internal 'bracket-type) ;; Latin @@ -1389,11 +1390,13 @@ Setup char-width-table appropriate for non-CJK language environment." (when (setq unicode-category-table (unicode-property-table-internal 'general-category)) (map-char-table #'(lambda (key val) - (if (and val - (or (and (/= (aref (symbol-name val) 0) ?M) - (/= (aref (symbol-name val) 0) ?C)) - (eq val 'Zs))) - (modify-category-entry key ?.))) + (if val + (cond ((or (and (/= (aref (symbol-name val) 0) ?M) + (/= (aref (symbol-name val) 0) ?C)) + (eq val 'Zs)) + (modify-category-entry key ?.)) + ((eq val 'Mn) + (modify-category-entry key ?^))))) unicode-category-table)) (optimize-char-table (standard-category-table)) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 508b2261463..dcf850d9425 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -1,4 +1,4 @@ -;;; mule-cmds.el --- commands for multilingual environment -*-coding: utf-8 -*- +;;; mule-cmds.el --- commands for multilingual environment -*- lexical-binding:t -*- ;; Copyright (C) 1997-2015 Free Software Foundation, Inc. ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, @@ -2776,11 +2776,7 @@ See also the documentation of `get-char-code-property' and (or (stringp table) (error "Not a char-table nor a file name: %s" table))) (if (stringp table) (setq table (purecopy table))) - (let ((slot (assq name char-code-property-alist))) - (if slot - (setcdr slot table) - (setq char-code-property-alist - (cons (cons name table) char-code-property-alist)))) + (setf (alist-get name char-code-property-alist) table) (put name 'char-code-property-documentation (purecopy docstring))) (defvar char-code-property-table @@ -2909,16 +2905,14 @@ on encoding." (defun ucs-names () "Return alist of (CHAR-NAME . CHAR-CODE) pairs cached in `ucs-names'." (or ucs-names - (let ((bmp-ranges + (let ((ranges '((#x0000 . #x33FF) ;; (#x3400 . #x4DBF) CJK Ideographs Extension A (#x4DC0 . #x4DFF) ;; (#x4E00 . #x9FFF) CJK Unified Ideographs (#xA000 . #xD7FF) ;; (#xD800 . #xFAFF) Surrogate/Private - (#xFB00 . #xFFFD))) - (upper-ranges - '((#x10000 . #x134FF) + (#xFB00 . #x134FF) ;; (#x13500 . #x167FF) unused (#x16800 . #x16A3F) ;; (#x16A40 . #x1AFFF) unused @@ -2928,23 +2922,20 @@ on encoding." ;; (#x20000 . #xDFFFF) CJK Ideograph Extension A, B, etc, unused (#xE0000 . #xE01FF))) (gc-cons-threshold 10000000) - c end name names) - (dolist (range bmp-ranges) - (setq c (car range) - end (cdr range)) - (while (<= c end) - (if (setq name (get-char-code-property c 'name)) - (push (cons name c) names)) - (if (setq name (get-char-code-property c 'old-name)) - (push (cons name c) names)) - (setq c (1+ c)))) - (dolist (range upper-ranges) - (setq c (car range) - end (cdr range)) + names) + (dolist (range ranges) + (let ((c (car range)) + (end (cdr range))) (while (<= c end) - (if (setq name (get-char-code-property c 'name)) - (push (cons name c) names)) - (setq c (1+ c)))) + (let ((new-name (get-char-code-property c 'name)) + (old-name (get-char-code-property c 'old-name))) + ;; In theory this code could end up pushing an "old-name" that + ;; shadows a "new-name" but in practice every time an + ;; `old-name' conflicts with a `new-name', the newer one has a + ;; higher code, so it gets pushed later! + (if new-name (push (cons new-name c) names)) + (if old-name (push (cons old-name c) names)) + (setq c (1+ c)))))) ;; Special case for "BELL" which is apparently the only char which ;; doesn't have a new name and whose old-name is shadowed by a newer ;; char with that name. diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index 72cca420a7a..42e78f9c904 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -825,10 +825,18 @@ but still contains full information about each coding system." The IGNORED argument is ignored." (print-list "name (opened by):" (aref font-info 0)) (print-list " full name:" (aref font-info 1)) + (and (aref font-info 12) + (print-list " file name:" (aref font-info 12))) (print-list " size:" (format "%2d" (aref font-info 2))) (print-list " height:" (format "%2d" (aref font-info 3))) (print-list " baseline-offset:" (format "%2d" (aref font-info 4))) - (print-list "relative-compose:" (format "%2d" (aref font-info 5)))) + (print-list "relative-compose:" (format "%2d" (aref font-info 5))) + (print-list " default-ascent:" (format "%2d" (aref font-info 6))) + (print-list " ascent:" (format "%2d" (aref font-info 8))) + (print-list " descent:" (format "%2d" (aref font-info 9))) + (print-list " average-width:" (format "%2d" (aref font-info 11))) + (print-list " space-width:" (format "%2d" (aref font-info 10))) + (print-list " max-width:" (format "%2d" (aref font-info 7)))) ;;;###autoload (defun describe-font (fontname) diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el index 3376aefa3fd..eae787bbeb9 100644 --- a/lisp/international/mule-util.el +++ b/lisp/international/mule-util.el @@ -56,6 +56,9 @@ (setq i (1+ i))))) string) +(defvar truncate-string-ellipsis "..." ;"…" + "String to use to indicate truncation.") + ;;;###autoload (defun truncate-string-to-width (str end-column &optional start-column padding ellipsis) @@ -80,11 +83,11 @@ If ELLIPSIS is non-nil, it should be a string which will replace the end of STR (including any padding) if it extends beyond END-COLUMN, unless the display width of STR is equal to or less than the display width of ELLIPSIS. If it is non-nil and not a string, then ELLIPSIS -defaults to \"...\"." +defaults to `truncate-string-ellipsis'." (or start-column (setq start-column 0)) (when (and ellipsis (not (stringp ellipsis))) - (setq ellipsis "...")) + (setq ellipsis truncate-string-ellipsis)) (let ((str-len (length str)) (str-width (string-width str)) (ellipsis-len (if ellipsis (length ellipsis) 0)) diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 1de2d5106e3..181474c65ce 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -2317,7 +2317,13 @@ ALIST is an alist, each element has the form (FROM . TO). FROM and TO are a character or a vector of characters. If FROM is a character, that character is translated to TO. If FROM is a vector of characters, that sequence is translated to TO. -The first extra-slot of the value is a translation table for reverse mapping." +The first extra-slot of the value is a translation table for reverse mapping. + +FROM and TO may be nil. If TO is nil, the translation from FROM +to nothing is defined in the translation table and that element +is ignored in the reverse map. If FROM is nil, the translation +from TO to nothing is defined in the reverse map only. A vector +of length zero has the same meaning as specifying nil." (let ((tables (vector (make-char-table 'translation-table) (make-char-table 'translation-table))) table max-lookup from to idx val) @@ -2330,20 +2336,23 @@ The first extra-slot of the value is a translation table for reverse mapping." (setq from (cdr elt) to (car elt))) (if (characterp from) (setq idx from) - (setq idx (aref from 0) - max-lookup (max max-lookup (length from)))) - (setq val (aref table idx)) - (if val - (progn - (or (consp val) - (setq val (list (cons (vector idx) val)))) - (if (characterp from) - (setq from (vector from))) - (setq val (nconc val (list (cons from to))))) - (if (characterp from) - (setq val to) - (setq val (list (cons from to))))) - (aset table idx val)) + (if (= (length from) 0) + (setq idx nil) + (setq idx (aref from 0) + max-lookup (max max-lookup (length from))))) + (when idx + (setq val (aref table idx)) + (if val + (progn + (or (consp val) + (setq val (list (cons (vector idx) val)))) + (if (characterp from) + (setq from (vector from))) + (setq val (nconc val (list (cons from to))))) + (if (characterp from) + (setq val to) + (setq val (list (cons from to))))) + (aset table idx val))) (set-char-table-extra-slot table 1 max-lookup)) (set-char-table-extra-slot (aref tables 0) 0 (aref tables 1)) (aref tables 0))) diff --git a/lisp/international/quail.el b/lisp/international/quail.el index f194b93526e..2755fd68bef 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -2985,7 +2985,7 @@ of each directory." quail-dirs list-buf pkg-list pos) (if (not (file-writable-p leim-list)) (error "Can't write to file \"%s\"" leim-list)) - (message "Updating %s ..." leim-list) + (or noninteractive (message "Updating %s ..." leim-list)) (setq list-buf (find-file-noselect leim-list)) ;; At first, clean up the file. @@ -3077,7 +3077,7 @@ of each directory." (let ((coding-system-for-write 'utf-8)) (save-buffer 0))) (kill-buffer list-buf) - (message "Updating %s ... done" leim-list))) + (or noninteractive (message "Updating %s ... done" leim-list)))) (defun quail-advice (args) "Advise users about the characters input by the current Quail package. diff --git a/lisp/isearch.el b/lisp/isearch.el index 06a1944999c..99ca73f9f54 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -974,10 +974,17 @@ The last thing it does is to run `isearch-update-post-hook'." (other-window 1)) (goto-char found-point)) ;; Keep same hscrolling as at the start of the search when possible - (let ((current-scroll (window-hscroll))) + (let ((current-scroll (window-hscroll)) + visible-p) (set-window-hscroll (selected-window) isearch-start-hscroll) - (unless (pos-visible-in-window-p) - (set-window-hscroll (selected-window) current-scroll)))) + (setq visible-p (pos-visible-in-window-p nil nil t)) + (if (or (not visible-p) + ;; When point is not visible because of hscroll, + ;; pos-visible-in-window-p returns non-nil, but + ;; the X coordinate it returns is 1 pixel beyond + ;; the last visible one. + (>= (car visible-p) (window-body-width nil t))) + (set-window-hscroll (selected-window) current-scroll)))) (if isearch-other-end (if (< isearch-other-end (point)) ; isearch-forward? (isearch-highlight isearch-other-end (point)) @@ -2342,6 +2349,8 @@ With argument, add COUNT copies of the character." (isearch-process-search-char char count)))) (defun isearch-process-search-char (char &optional count) + "Add CHAR to the search string, COUNT times. +Search is updated accordingly." ;; * and ? are special in regexps when not preceded by \. ;; } and | are special in regexps when preceded by \. ;; Nothing special for + because it matches at least once. @@ -2514,7 +2523,10 @@ If there is no completion possible, say so and continue searching." "word ") "") (if isearch-regexp "regexp " "") - (if multi-isearch-next-buffer-current-function "multi " "") + (cond + (multi-isearch-file-list "multi-file ") + (multi-isearch-buffer-list "multi-buffer ") + (t "")) (or isearch-message-prefix-add "") (if nonincremental "search" "I-search") (if isearch-forward "" " backward") @@ -2724,7 +2736,7 @@ update the match data, and return point." ;; in any of these overlays, se we are safe in this case too. (defun isearch-open-necessary-overlays (ov) (let ((inside-overlay (and (> (point) (overlay-start ov)) - (< (point) (overlay-end ov)))) + (<= (point) (overlay-end ov)))) ;; If this exists it means that the overlay was opened using ;; this function, not by us tweaking the overlay properties. (fct-temp (overlay-get ov 'isearch-open-invisible-temporary))) @@ -2873,8 +2885,12 @@ since they have special meaning in a regexp." (defun isearch-text-char-description (c) (cond - ((< c ?\s) (propertize (format "^%c" (+ c 64)) 'face 'escape-glyph)) - ((= c ?\^?) (propertize "^?" 'face 'escape-glyph)) + ((< c ?\s) (propertize + (char-to-string c) + 'display (propertize (format "^%c" (+ c 64)) 'face 'escape-glyph))) + ((= c ?\^?) (propertize + (char-to-string c) + 'display (propertize "^?" 'face 'escape-glyph))) (t (char-to-string c)))) ;; General function to unread characters or events. @@ -3049,11 +3065,15 @@ Attempt to do the search exactly the way the pending Isearch would." (bound (if isearch-lazy-highlight-forward (min (or isearch-lazy-highlight-end-limit (point-max)) (if isearch-lazy-highlight-wrapped - isearch-lazy-highlight-start + (+ isearch-lazy-highlight-start + ;; Extend bound to match whole string at point + (1- (length isearch-lazy-highlight-last-string))) (window-end))) (max (or isearch-lazy-highlight-start-limit (point-min)) (if isearch-lazy-highlight-wrapped - isearch-lazy-highlight-end + (- isearch-lazy-highlight-end + ;; Extend bound to match whole string at point + (1- (length isearch-lazy-highlight-last-string))) (window-start)))))) ;; Use a loop like in `isearch-search'. (while retry diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index 9d8fd289e1b..788646c97be 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -125,7 +125,8 @@ The value of this variable is used when JIT Lock mode is turned on." (defcustom jit-lock-defer-time nil ;; 0.25 "Idle time after which deferred fontification should take place. -If nil, fontification is not deferred." +If nil, fontification is not deferred. +If 0, then fontification is only deferred while there is input pending." :group 'jit-lock :type '(choice (const :tag "never" nil) (number :tag "seconds"))) @@ -318,10 +319,6 @@ Only applies to the current buffer." (remove-hook 'jit-lock-functions fun t) (unless jit-lock-functions (jit-lock-mode nil))) -;; This function is used to prevent font-lock-fontify-buffer from -;; fontifying eagerly the whole buffer. This is important for -;; things like CWarn mode which adds/removes a few keywords and -;; does a refontify (which takes ages on large files). (defun jit-lock-refontify (&optional beg end) "Force refontification of the region BEG..END (default whole buffer)." (with-buffer-prepared-for-jit-lock @@ -337,7 +334,9 @@ Only applies to the current buffer." This function is added to `fontification-functions' when `jit-lock-mode' is active." (when (and jit-lock-mode (not memory-full)) - (if (null jit-lock-defer-timer) + (if (not (and jit-lock-defer-timer + (or (not (eq jit-lock-defer-time 0)) + (input-pending-p)))) ;; No deferral. (jit-lock-fontify-now start (+ start jit-lock-chunk-size)) ;; Record the buffer for later fontification. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 23e9b94d437..d11401b5c2d 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -3,7 +3,7 @@ ;;; Code: -;;;### (autoloads nil "5x5" "play/5x5.el" (21607 56025 301574 889000)) +;;;### (autoloads nil "5x5" "play/5x5.el" (21607 54478 800121 42000)) ;;; Generated autoloads from play/5x5.el (autoload '5x5 "5x5" "\ @@ -65,8 +65,8 @@ should return a grid vector array that is the new solution. ;;;*** -;;;### (autoloads nil "ada-mode" "progmodes/ada-mode.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "ada-mode" "progmodes/ada-mode.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/ada-mode.el (autoload 'ada-add-extensions "ada-mode" "\ @@ -85,8 +85,8 @@ Ada mode is the major mode for editing Ada code. ;;;*** -;;;### (autoloads nil "ada-stmt" "progmodes/ada-stmt.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "ada-stmt" "progmodes/ada-stmt.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/ada-stmt.el (autoload 'ada-header "ada-stmt" "\ @@ -96,8 +96,8 @@ Insert a descriptive header at the top of the file. ;;;*** -;;;### (autoloads nil "ada-xref" "progmodes/ada-xref.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "ada-xref" "progmodes/ada-xref.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/ada-xref.el (autoload 'ada-find-file "ada-xref" "\ @@ -108,8 +108,8 @@ Completion is available. ;;;*** -;;;### (autoloads nil "add-log" "vc/add-log.el" (21607 56059 804396 -;;;;;; 982000)) +;;;### (autoloads nil "add-log" "vc/add-log.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from vc/add-log.el (put 'change-log-default-name 'safe-local-variable 'string-or-null-p) @@ -238,8 +238,8 @@ old-style time formats for entries are supported. ;;;*** -;;;### (autoloads nil "advice" "emacs-lisp/advice.el" (21607 56023 -;;;;;; 800854 237000)) +;;;### (autoloads nil "advice" "emacs-lisp/advice.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from emacs-lisp/advice.el (defvar ad-redefinition-action 'warn "\ @@ -368,13 +368,13 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) \(fn FUNCTION ARGS &rest BODY)" nil t) -(put 'defadvice 'doc-string-elt '3) +(function-put 'defadvice 'doc-string-elt '3) -(put 'defadvice 'lisp-indent-function '2) +(function-put 'defadvice 'lisp-indent-function '2) ;;;*** -;;;### (autoloads nil "align" "align.el" (21607 56023 800854 237000)) +;;;### (autoloads nil "align" "align.el" (21607 54477 800124 118000)) ;;; Generated autoloads from align.el (autoload 'align "align" "\ @@ -477,7 +477,7 @@ A replacement function for `newline-and-indent', aligning as it goes. ;;;*** -;;;### (autoloads nil "allout" "allout.el" (21607 56023 800854 237000)) +;;;### (autoloads nil "allout" "allout.el" (21607 54477 800124 118000)) ;;; Generated autoloads from allout.el (push (purecopy '(allout 2 3)) package--builtin-versions) @@ -837,8 +837,8 @@ for details on preparing Emacs for automatic allout activation. ;;;*** -;;;### (autoloads nil "allout-widgets" "allout-widgets.el" (21607 -;;;;;; 56058 801550 360000)) +;;;### (autoloads nil "allout-widgets" "allout-widgets.el" (21609 +;;;;;; 55608 852266 580000)) ;;; Generated autoloads from allout-widgets.el (push (purecopy '(allout-widgets 1 0)) package--builtin-versions) @@ -896,8 +896,8 @@ outline hot-spot navigation (see `allout-mode'). ;;;*** -;;;### (autoloads nil "ange-ftp" "net/ange-ftp.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "ange-ftp" "net/ange-ftp.el" (21640 46919 650145 +;;;;;; 897000)) ;;; Generated autoloads from net/ange-ftp.el (defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir) @@ -918,8 +918,8 @@ directory, so that Emacs will know its current contents. ;;;*** -;;;### (autoloads nil "animate" "play/animate.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "animate" "play/animate.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from play/animate.el (autoload 'animate-string "animate" "\ @@ -951,8 +951,8 @@ the buffer *Birthday-Present-for-Name*. ;;;*** -;;;### (autoloads nil "ansi-color" "ansi-color.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "ansi-color" "ansi-color.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from ansi-color.el (push (purecopy '(ansi-color 3 4 2)) package--builtin-versions) @@ -979,7 +979,7 @@ This is a good function to put in `comint-output-filter-functions'. ;;;*** ;;;### (autoloads nil "antlr-mode" "progmodes/antlr-mode.el" (21607 -;;;;;; 56025 301574 889000)) +;;;;;; 54478 800121 42000)) ;;; Generated autoloads from progmodes/antlr-mode.el (push (purecopy '(antlr-mode 2 2 3)) package--builtin-versions) @@ -1015,8 +1015,8 @@ Used in `antlr-mode'. Also a useful function in `java-mode-hook'. ;;;*** -;;;### (autoloads nil "appt" "calendar/appt.el" (21607 56058 801550 -;;;;;; 360000)) +;;;### (autoloads nil "appt" "calendar/appt.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from calendar/appt.el (autoload 'appt-add "appt" "\ @@ -1037,8 +1037,8 @@ ARG is positive, otherwise off. ;;;*** -;;;### (autoloads nil "apropos" "apropos.el" (21607 56058 801550 -;;;;;; 360000)) +;;;### (autoloads nil "apropos" "apropos.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from apropos.el (autoload 'apropos-read-pattern "apropos" "\ @@ -1153,8 +1153,8 @@ Returns list of symbols and documentation found. ;;;*** -;;;### (autoloads nil "arc-mode" "arc-mode.el" (21607 56058 801550 -;;;;;; 360000)) +;;;### (autoloads nil "arc-mode" "arc-mode.el" (21621 7062 810116 +;;;;;; 332000)) ;;; Generated autoloads from arc-mode.el (autoload 'archive-mode "arc-mode" "\ @@ -1174,7 +1174,7 @@ archive. ;;;*** -;;;### (autoloads nil "array" "array.el" (21607 56023 800854 237000)) +;;;### (autoloads nil "array" "array.el" (21607 54477 800124 118000)) ;;; Generated autoloads from array.el (autoload 'array-mode "array" "\ @@ -1245,8 +1245,8 @@ Entering array mode calls the function `array-mode-hook'. ;;;*** -;;;### (autoloads nil "artist" "textmodes/artist.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "artist" "textmodes/artist.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from textmodes/artist.el (push (purecopy '(artist 1 2 6)) package--builtin-versions) @@ -1452,8 +1452,8 @@ Keymap summary ;;;*** -;;;### (autoloads nil "asm-mode" "progmodes/asm-mode.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "asm-mode" "progmodes/asm-mode.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/asm-mode.el (autoload 'asm-mode "asm-mode" "\ @@ -1480,8 +1480,8 @@ Special commands: ;;;*** -;;;### (autoloads nil "auth-source" "gnus/auth-source.el" (21623 -;;;;;; 5708 80843 798000)) +;;;### (autoloads nil "auth-source" "gnus/auth-source.el" (21625 +;;;;;; 43838 483701 627000)) ;;; Generated autoloads from gnus/auth-source.el (defvar auth-source-cache-expiry 7200 "\ @@ -1493,8 +1493,8 @@ let-binding.") ;;;*** -;;;### (autoloads nil "autoarg" "autoarg.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "autoarg" "autoarg.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from autoarg.el (defvar autoarg-mode nil "\ @@ -1554,8 +1554,8 @@ This is similar to `autoarg-mode' but rebinds the keypad keys ;;;*** -;;;### (autoloads nil "autoconf" "progmodes/autoconf.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "autoconf" "progmodes/autoconf.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/autoconf.el (autoload 'autoconf-mode "autoconf" "\ @@ -1565,8 +1565,8 @@ Major mode for editing Autoconf configure.ac files. ;;;*** -;;;### (autoloads nil "autoinsert" "autoinsert.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "autoinsert" "autoinsert.el" (21632 17083 200835 +;;;;;; 890000)) ;;; Generated autoloads from autoinsert.el (autoload 'auto-insert "autoinsert" "\ @@ -1604,14 +1604,16 @@ insert a template for the file depending on the mode of the buffer. ;;;*** -;;;### (autoloads nil "autoload" "emacs-lisp/autoload.el" (21607 -;;;;;; 56058 801550 360000)) +;;;### (autoloads nil "autoload" "emacs-lisp/autoload.el" (21628 +;;;;;; 43483 380149 771000)) ;;; Generated autoloads from emacs-lisp/autoload.el (put 'generated-autoload-file 'safe-local-variable 'stringp) (put 'generated-autoload-load-name 'safe-local-variable 'stringp) +(put 'autoload-ensure-writable 'risky-local-variable t) + (autoload 'update-file-autoloads "autoload" "\ Update the autoloads for FILE. If prefix arg SAVE-AFTER is non-nil, save the buffer too. @@ -1654,8 +1656,8 @@ should be non-nil). ;;;*** -;;;### (autoloads nil "autorevert" "autorevert.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "autorevert" "autorevert.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from autorevert.el (autoload 'auto-revert-mode "autorevert" "\ @@ -1743,7 +1745,7 @@ specifies in the mode line. ;;;*** -;;;### (autoloads nil "avoid" "avoid.el" (21607 56023 800854 237000)) +;;;### (autoloads nil "avoid" "avoid.el" (21607 54477 800124 118000)) ;;; Generated autoloads from avoid.el (defvar mouse-avoidance-mode nil "\ @@ -1781,8 +1783,8 @@ definition of \"random distance\".) ;;;*** -;;;### (autoloads nil "bat-mode" "progmodes/bat-mode.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "bat-mode" "progmodes/bat-mode.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/bat-mode.el (add-to-list 'auto-mode-alist '("\\.\\(bat\\|cmd\\)\\'" . bat-mode)) @@ -1800,8 +1802,8 @@ Run script using `bat-run' and `bat-run-args'. ;;;*** -;;;### (autoloads nil "battery" "battery.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "battery" "battery.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from battery.el (put 'battery-mode-line-string 'risky-local-variable t) @@ -1837,7 +1839,7 @@ seconds. ;;;*** ;;;### (autoloads nil "benchmark" "emacs-lisp/benchmark.el" (21607 -;;;;;; 56023 800854 237000)) +;;;;;; 54477 800124 118000)) ;;; Generated autoloads from emacs-lisp/benchmark.el (autoload 'benchmark-run "benchmark" "\ @@ -1851,7 +1853,7 @@ See also `benchmark-run-compiled'. \(fn &optional REPETITIONS &rest FORMS)" nil t) -(put 'benchmark-run 'lisp-indent-function '1) +(function-put 'benchmark-run 'lisp-indent-function '1) (autoload 'benchmark-run-compiled "benchmark" "\ Time execution of compiled version of FORMS. @@ -1861,7 +1863,7 @@ result. The overhead of the `lambda's is accounted for. \(fn &optional REPETITIONS &rest FORMS)" nil t) -(put 'benchmark-run-compiled 'lisp-indent-function '1) +(function-put 'benchmark-run-compiled 'lisp-indent-function '1) (autoload 'benchmark "benchmark" "\ Print the time taken for REPETITIONS executions of FORM. @@ -1873,8 +1875,8 @@ For non-interactive use see also `benchmark-run' and ;;;*** -;;;### (autoloads nil "bibtex" "textmodes/bibtex.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "bibtex" "textmodes/bibtex.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from textmodes/bibtex.el (autoload 'bibtex-initialize "bibtex" "\ @@ -1966,7 +1968,7 @@ A prefix arg negates the value of `bibtex-search-entry-globally'. ;;;*** ;;;### (autoloads nil "bibtex-style" "textmodes/bibtex-style.el" -;;;;;; (21607 56025 801549 101000)) +;;;;;; (21607 54478 800121 42000)) ;;; Generated autoloads from textmodes/bibtex-style.el (autoload 'bibtex-style-mode "bibtex-style" "\ @@ -1976,8 +1978,8 @@ Major mode for editing BibTeX style files. ;;;*** -;;;### (autoloads nil "binhex" "mail/binhex.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "binhex" "mail/binhex.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from mail/binhex.el (defconst binhex-begin-line "^:...............................................................$" "\ @@ -2001,8 +2003,8 @@ Binhex decode region between START and END. ;;;*** -;;;### (autoloads nil "blackbox" "play/blackbox.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "blackbox" "play/blackbox.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from play/blackbox.el (autoload 'blackbox "blackbox" "\ @@ -2121,8 +2123,8 @@ a reflection. ;;;*** -;;;### (autoloads nil "bookmark" "bookmark.el" (21607 56058 801550 -;;;;;; 360000)) +;;;### (autoloads nil "bookmark" "bookmark.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from bookmark.el (define-key ctl-x-r-map "b" 'bookmark-jump) (define-key ctl-x-r-map "m" 'bookmark-set) @@ -2248,10 +2250,11 @@ probably because we were called from there. (autoload 'bookmark-write "bookmark" "\ Write bookmarks to a file (reading the file name with the minibuffer). -Don't use this in Lisp programs; use `bookmark-save' instead. \(fn)" t nil) +(function-put 'bookmark-write 'interactive-only 'bookmark-save) + (autoload 'bookmark-save "bookmark" "\ Save currently defined bookmarks. Saves by default in the file defined by the variable @@ -2314,8 +2317,8 @@ Incremental search of bookmarks, hiding the non-matches as we go. ;;;*** -;;;### (autoloads nil "browse-url" "net/browse-url.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "browse-url" "net/browse-url.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from net/browse-url.el (defvar browse-url-browser-function 'browse-url-default-browser "\ @@ -2630,7 +2633,7 @@ from `browse-url-elinks-wrapper'. ;;;*** -;;;### (autoloads nil "bs" "bs.el" (21607 56058 801550 360000)) +;;;### (autoloads nil "bs" "bs.el" (21607 54477 800124 118000)) ;;; Generated autoloads from bs.el (push (purecopy '(bs 1 17)) package--builtin-versions) @@ -2671,8 +2674,8 @@ name of buffer configuration. ;;;*** -;;;### (autoloads nil "bubbles" "play/bubbles.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "bubbles" "play/bubbles.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from play/bubbles.el (autoload 'bubbles "bubbles" "\ @@ -2694,7 +2697,7 @@ columns on its right towards the left. ;;;*** ;;;### (autoloads nil "bug-reference" "progmodes/bug-reference.el" -;;;;;; (21607 56025 301574 889000)) +;;;;;; (21607 54478 800121 42000)) ;;; Generated autoloads from progmodes/bug-reference.el (put 'bug-reference-url-format 'safe-local-variable (lambda (s) (or (stringp s) (and (symbolp s) (get s 'bug-reference-url-format))))) @@ -2714,8 +2717,8 @@ Like `bug-reference-mode', but only buttonize in comments and strings. ;;;*** -;;;### (autoloads nil "bytecomp" "emacs-lisp/bytecomp.el" (21607 -;;;;;; 56058 801550 360000)) +;;;### (autoloads nil "bytecomp" "emacs-lisp/bytecomp.el" (21645 +;;;;;; 29116 670141 789000)) ;;; Generated autoloads from emacs-lisp/bytecomp.el (put 'byte-compile-dynamic 'safe-local-variable 'booleanp) (put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp) @@ -2835,8 +2838,8 @@ and corresponding effects. ;;;*** -;;;### (autoloads nil "cal-china" "calendar/cal-china.el" (21607 -;;;;;; 56058 801550 360000)) +;;;### (autoloads nil "cal-china" "calendar/cal-china.el" (21617 +;;;;;; 49721 420132 227000)) ;;; Generated autoloads from calendar/cal-china.el (put 'calendar-chinese-time-zone 'risky-local-variable t) @@ -2845,8 +2848,8 @@ and corresponding effects. ;;;*** -;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (21607 56023 -;;;;;; 800854 237000)) +;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (21609 55608 +;;;;;; 852266 580000)) ;;; Generated autoloads from calendar/cal-dst.el (put 'calendar-daylight-savings-starts 'risky-local-variable t) @@ -2858,7 +2861,7 @@ and corresponding effects. ;;;*** ;;;### (autoloads nil "cal-hebrew" "calendar/cal-hebrew.el" (21607 -;;;;;; 56058 801550 360000)) +;;;;;; 54477 800124 118000)) ;;; Generated autoloads from calendar/cal-hebrew.el (autoload 'calendar-hebrew-list-yahrzeits "cal-hebrew" "\ @@ -2868,11 +2871,9 @@ from the cursor position. \(fn DEATH-DATE START-YEAR END-YEAR)" t nil) -(define-obsolete-function-alias 'list-yahrzeit-dates 'calendar-hebrew-list-yahrzeits "23.1") - ;;;*** -;;;### (autoloads nil "calc" "calc/calc.el" (21607 56058 801550 360000)) +;;;### (autoloads nil "calc" "calc/calc.el" (21607 54477 800124 118000)) ;;; Generated autoloads from calc/calc.el (define-key ctl-x-map "*" 'calc-dispatch) @@ -2893,8 +2894,10 @@ Invoke the Calculator and give it a full-sized window. (autoload 'quick-calc "calc" "\ Do a quick calculation in the minibuffer without invoking full Calculator. +With prefix argument INSERT, insert the result in the current +buffer. Otherwise, the result is copied into the kill ring. -\(fn)" t nil) +\(fn &optional INSERT)" t nil) (autoload 'calc-eval "calc" "\ Do a quick calculation and return the result as a string. @@ -2952,12 +2955,12 @@ See Info node `(calc)Defining Functions'. \(fn FUNC ARGS &rest BODY)" nil t) -(put 'defmath 'doc-string-elt '3) +(function-put 'defmath 'doc-string-elt '3) ;;;*** -;;;### (autoloads nil "calc-undo" "calc/calc-undo.el" (21607 56023 -;;;;;; 800854 237000)) +;;;### (autoloads nil "calc-undo" "calc/calc-undo.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from calc/calc-undo.el (autoload 'calc-undo "calc-undo" "\ @@ -2967,8 +2970,8 @@ See Info node `(calc)Defining Functions'. ;;;*** -;;;### (autoloads nil "calculator" "calculator.el" (21607 56058 801550 -;;;;;; 360000)) +;;;### (autoloads nil "calculator" "calculator.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from calculator.el (autoload 'calculator "calculator" "\ @@ -2979,8 +2982,8 @@ See the documentation for `calculator-mode' for more information. ;;;*** -;;;### (autoloads nil "calendar" "calendar/calendar.el" (21607 56058 -;;;;;; 801550 360000)) +;;;### (autoloads nil "calendar" "calendar/calendar.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from calendar/calendar.el (autoload 'calendar "calendar" "\ @@ -3023,8 +3026,8 @@ This function is suitable for execution in an init file. ;;;*** -;;;### (autoloads nil "canlock" "gnus/canlock.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "canlock" "gnus/canlock.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from gnus/canlock.el (autoload 'canlock-insert-header "canlock" "\ @@ -3041,48 +3044,8 @@ it fails. ;;;*** -;;;### (autoloads nil "cap-words" "progmodes/cap-words.el" (21607 -;;;;;; 56059 303525 127000)) -;;; Generated autoloads from progmodes/cap-words.el - -(autoload 'capitalized-words-mode "cap-words" "\ -Toggle Capitalized Words mode. -With a prefix argument ARG, enable Capitalized Words mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. - -Capitalized Words mode is a buffer-local minor mode. When -enabled, a word boundary occurs immediately before an uppercase -letter in a symbol. This is in addition to all the normal -boundaries given by the syntax and category tables. There is no -restriction to ASCII. - -E.g. the beginning of words in the following identifier are as marked: - - capitalizedWorDD - ^ ^ ^^ - -Note that these word boundaries only apply for word motion and -marking commands such as \\[forward-word]. This mode does not affect word -boundaries found by regexp matching (`\\>', `\\w' &c). - -This style of identifiers is common in environments like Java ones, -where underscores aren't trendy enough. Capitalization rules are -sometimes part of the language, e.g. Haskell, which may thus encourage -such a style. It is appropriate to add `capitalized-words-mode' to -the mode hook for programming language modes in which you encounter -variables like this, e.g. `java-mode-hook'. It's unlikely to cause -trouble if such identifiers aren't used. - -See also `glasses-mode' and `studlify-word'. -Obsoletes `c-forward-into-nomenclature'. - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads nil "cc-engine" "progmodes/cc-engine.el" (21607 -;;;;;; 56059 303525 127000)) +;;;### (autoloads nil "cc-engine" "progmodes/cc-engine.el" (21653 +;;;;;; 23227 760147 961000)) ;;; Generated autoloads from progmodes/cc-engine.el (autoload 'c-guess-basic-syntax "cc-engine" "\ @@ -3092,8 +3055,8 @@ Return the syntactic context of the current line. ;;;*** -;;;### (autoloads nil "cc-guess" "progmodes/cc-guess.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "cc-guess" "progmodes/cc-guess.el" (21628 56730 +;;;;;; 520119 990000)) ;;; Generated autoloads from progmodes/cc-guess.el (defvar c-guess-guessed-offsets-alist nil "\ @@ -3191,8 +3154,8 @@ the absolute file name of the file if STYLE-NAME is nil. ;;;*** -;;;### (autoloads nil "cc-mode" "progmodes/cc-mode.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "cc-mode" "progmodes/cc-mode.el" (21652 2366 +;;;;;; 414435 564000)) ;;; Generated autoloads from progmodes/cc-mode.el (autoload 'c-initialize-cc-mode "cc-mode" "\ @@ -3349,8 +3312,8 @@ Key bindings: ;;;*** -;;;### (autoloads nil "cc-styles" "progmodes/cc-styles.el" (21607 -;;;;;; 56025 301574 889000)) +;;;### (autoloads nil "cc-styles" "progmodes/cc-styles.el" (21628 +;;;;;; 56730 520119 990000)) ;;; Generated autoloads from progmodes/cc-styles.el (autoload 'c-set-style "cc-styles" "\ @@ -3401,8 +3364,8 @@ and exists only for compatibility reasons. ;;;*** -;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (21628 56730 +;;;;;; 520119 990000)) ;;; Generated autoloads from progmodes/cc-vars.el (put 'c-basic-offset 'safe-local-variable 'integerp) (put 'c-backslash-column 'safe-local-variable 'integerp) @@ -3410,8 +3373,8 @@ and exists only for compatibility reasons. ;;;*** -;;;### (autoloads nil "ccl" "international/ccl.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "ccl" "international/ccl.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from international/ccl.el (autoload 'ccl-compile "ccl" "\ @@ -3650,7 +3613,7 @@ MAP-ID := integer \(fn NAME CCL-PROGRAM &optional DOC)" nil t) -(put 'define-ccl-program 'doc-string-elt '3) +(function-put 'define-ccl-program 'doc-string-elt '3) (autoload 'check-ccl-program "ccl" "\ Check validity of CCL-PROGRAM. @@ -3671,8 +3634,8 @@ See the documentation of `define-ccl-program' for the detail of CCL program. ;;;*** -;;;### (autoloads nil "cconv" "emacs-lisp/cconv.el" (21607 56058 -;;;;;; 801550 360000)) +;;;### (autoloads nil "cconv" "emacs-lisp/cconv.el" (21645 29116 +;;;;;; 670141 789000)) ;;; Generated autoloads from emacs-lisp/cconv.el (autoload 'cconv-closure-convert "cconv" "\ @@ -3691,15 +3654,15 @@ Add the warnings that closure conversion would encounter. ;;;*** -;;;### (autoloads nil "cedet" "cedet/cedet.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "cedet" "cedet/cedet.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from cedet/cedet.el (push (purecopy '(cedet 2 0)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "cfengine" "progmodes/cfengine.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "cfengine" "progmodes/cfengine.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/cfengine.el (push (purecopy '(cfengine 1 3)) package--builtin-versions) @@ -3722,22 +3685,21 @@ to the action header. \(fn)" t nil) (autoload 'cfengine-auto-mode "cfengine" "\ -Choose between `cfengine2-mode' and `cfengine3-mode' depending -on the buffer contents +Choose `cfengine2-mode' or `cfengine3-mode' by buffer contents. -\(fn)" nil nil) +\(fn)" t nil) ;;;*** -;;;### (autoloads nil "chart" "emacs-lisp/chart.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "chart" "emacs-lisp/chart.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from emacs-lisp/chart.el (push (purecopy '(chart 0 2)) package--builtin-versions) ;;;*** ;;;### (autoloads nil "check-declare" "emacs-lisp/check-declare.el" -;;;;;; (21607 56024 300834 853000)) +;;;;;; (21607 54477 800124 118000)) ;;; Generated autoloads from emacs-lisp/check-declare.el (autoload 'check-declare-file "check-declare" "\ @@ -3755,7 +3717,7 @@ Returns non-nil if any false statements are found. ;;;*** ;;;### (autoloads nil "checkdoc" "emacs-lisp/checkdoc.el" (21607 -;;;;;; 56024 300834 853000)) +;;;;;; 54477 800124 118000)) ;;; Generated autoloads from emacs-lisp/checkdoc.el (push (purecopy '(checkdoc 0 6 2)) package--builtin-versions) (put 'checkdoc-force-docstrings-flag 'safe-local-variable #'booleanp) @@ -3956,7 +3918,7 @@ checking of documentation strings. ;;;*** ;;;### (autoloads nil "china-util" "language/china-util.el" (21607 -;;;;;; 56024 801559 72000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from language/china-util.el (autoload 'decode-hz-region "china-util" "\ @@ -3993,8 +3955,8 @@ Encode the text in the current buffer to HZ. ;;;*** -;;;### (autoloads nil "chistory" "chistory.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "chistory" "chistory.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from chistory.el (autoload 'repeat-matching-complex-command "chistory" "\ @@ -4034,7 +3996,7 @@ and runs the normal hook `command-history-hook'. ;;;*** ;;;### (autoloads nil "cl-indent" "emacs-lisp/cl-indent.el" (21607 -;;;;;; 56058 801550 360000)) +;;;;;; 54477 800124 118000)) ;;; Generated autoloads from emacs-lisp/cl-indent.el (autoload 'common-lisp-indent-function "cl-indent" "\ @@ -4108,12 +4070,17 @@ For example, the function `case' has an indent property of them. The first list element has an offset of 2, all the rest have an offset of 2+1=3. +If the current mode is actually `emacs-lisp-mode', look for a +`common-lisp-indent-function-for-elisp' property before looking +at `common-lisp-indent-function' and, if set, use its value +instead. + \(fn INDENT-POINT STATE)" nil nil) ;;;*** -;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (21607 56058 -;;;;;; 801550 360000)) +;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (21619 26501 +;;;;;; 970129 581000)) ;;; Generated autoloads from emacs-lisp/cl-lib.el (push (purecopy '(cl-lib 1 0)) package--builtin-versions) @@ -4143,8 +4110,8 @@ a future Emacs interpreter will be able to use it.") ;;;*** -;;;### (autoloads nil "cmacexp" "progmodes/cmacexp.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "cmacexp" "progmodes/cmacexp.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/cmacexp.el (autoload 'c-macro-expand "cmacexp" "\ @@ -4164,8 +4131,8 @@ For use inside Lisp programs, see also `c-macro-expansion'. ;;;*** -;;;### (autoloads nil "cmuscheme" "cmuscheme.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "cmuscheme" "cmuscheme.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from cmuscheme.el (autoload 'run-scheme "cmuscheme" "\ @@ -4185,7 +4152,7 @@ is run). ;;;*** -;;;### (autoloads nil "color" "color.el" (21607 56023 800854 237000)) +;;;### (autoloads nil "color" "color.el" (21607 54477 800124 118000)) ;;; Generated autoloads from color.el (autoload 'color-name-to-rgb "color" "\ @@ -4204,7 +4171,7 @@ If FRAME cannot display COLOR, return nil. ;;;*** -;;;### (autoloads nil "comint" "comint.el" (21607 56058 801550 360000)) +;;;### (autoloads nil "comint" "comint.el" (21665 14401 955623 556000)) ;;; Generated autoloads from comint.el (defvar comint-output-filter-functions '(ansi-color-process-output comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt) "\ @@ -4266,6 +4233,8 @@ See `make-comint' and `comint-exec'. \(fn PROGRAM)" t nil) +(function-put 'comint-run 'interactive-only 'make-comint) + (defvar comint-file-name-prefix (purecopy "") "\ Prefix prepended to absolute file names taken from process input. This is used by Comint's and shell's completion functions, and by shell's @@ -4303,12 +4272,15 @@ REGEXP-GROUP is the regular expression group in REGEXP to use. ;;;*** -;;;### (autoloads nil "compare-w" "vc/compare-w.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "compare-w" "vc/compare-w.el" (21663 59071 +;;;;;; 96337 184000)) ;;; Generated autoloads from vc/compare-w.el (autoload 'compare-windows "compare-w" "\ -Compare text in current window with text in next window. +Compare text in current window with text in another window. +The option `compare-windows-get-window-function' defines how +to get another window. + Compares the text starting at point in each window, moving over text in each one as far as they match. @@ -4337,8 +4309,8 @@ on third call it again advances points to the next difference and so on. ;;;*** -;;;### (autoloads nil "compile" "progmodes/compile.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "compile" "progmodes/compile.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/compile.el (defvar compilation-mode-hook nil "\ @@ -4519,8 +4491,8 @@ This is the value of `next-error-function' in Compilation buffers. ;;;*** -;;;### (autoloads nil "completion" "completion.el" (21607 56058 801550 -;;;;;; 360000)) +;;;### (autoloads nil "completion" "completion.el" (21657 20283 330825 +;;;;;; 807000)) ;;; Generated autoloads from completion.el (defvar dynamic-completion-mode nil "\ @@ -4543,7 +4515,7 @@ if ARG is omitted or nil. ;;;*** ;;;### (autoloads nil "conf-mode" "textmodes/conf-mode.el" (21607 -;;;;;; 56059 303525 127000)) +;;;;;; 54478 800121 42000)) ;;; Generated autoloads from textmodes/conf-mode.el (autoload 'conf-mode "conf-mode" "\ @@ -4698,8 +4670,8 @@ For details see `conf-mode'. Example: ;;;*** -;;;### (autoloads nil "cookie1" "play/cookie1.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "cookie1" "play/cookie1.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from play/cookie1.el (autoload 'cookie "cookie1" "\ @@ -4728,7 +4700,7 @@ and subsequent calls on the same file won't go to disk. ;;;*** ;;;### (autoloads nil "copyright" "emacs-lisp/copyright.el" (21607 -;;;;;; 56024 300834 853000)) +;;;;;; 54477 800124 118000)) ;;; Generated autoloads from emacs-lisp/copyright.el (put 'copyright-at-end-flag 'safe-local-variable 'booleanp) (put 'copyright-names-regexp 'safe-local-variable 'stringp) @@ -4767,7 +4739,7 @@ If FIX is non-nil, run `copyright-fix-years' instead. ;;;*** ;;;### (autoloads nil "cperl-mode" "progmodes/cperl-mode.el" (21607 -;;;;;; 56059 303525 127000)) +;;;;;; 54478 800121 42000)) ;;; Generated autoloads from progmodes/cperl-mode.el (put 'cperl-indent-level 'safe-local-variable 'integerp) (put 'cperl-brace-offset 'safe-local-variable 'integerp) @@ -4965,8 +4937,8 @@ Run a `perldoc' on the word around point. ;;;*** -;;;### (autoloads nil "cpp" "progmodes/cpp.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "cpp" "progmodes/cpp.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from progmodes/cpp.el (autoload 'cpp-highlight-buffer "cpp" "\ @@ -4984,8 +4956,8 @@ Edit display information for cpp conditionals. ;;;*** -;;;### (autoloads nil "crm" "emacs-lisp/crm.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "crm" "emacs-lisp/crm.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from emacs-lisp/crm.el (autoload 'completing-read-multiple "crm" "\ @@ -5011,19 +4983,25 @@ with empty strings removed. ;;;*** -;;;### (autoloads nil "css-mode" "textmodes/css-mode.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "css-mode" "textmodes/css-mode.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from textmodes/css-mode.el (autoload 'css-mode "css-mode" "\ Major mode to edit Cascading Style Sheets. \(fn)" t nil) + (add-to-list 'auto-mode-alist '("\\.scss\\'" . scss-mode)) + +(autoload 'scss-mode "css-mode" "\ +Major mode to edit \"Sassy CSS\" files. + +\(fn)" t nil) ;;;*** -;;;### (autoloads nil "cua-base" "emulation/cua-base.el" (21607 56058 -;;;;;; 801550 360000)) +;;;### (autoloads nil "cua-base" "emulation/cua-base.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from emulation/cua-base.el (defvar cua-mode nil "\ @@ -5068,8 +5046,8 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings. ;;;*** -;;;### (autoloads nil "cua-rect" "emulation/cua-rect.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "cua-rect" "emulation/cua-rect.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from emulation/cua-rect.el (autoload 'cua-rectangle-mark-mode "cua-rect" "\ @@ -5080,8 +5058,8 @@ Activates the region if needed. Only lasts until the region is deactivated. ;;;*** -;;;### (autoloads nil "cus-edit" "cus-edit.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "cus-edit" "cus-edit.el" (21646 49980 500843 +;;;;;; 452000)) ;;; Generated autoloads from cus-edit.el (defvar custom-browse-sort-alphabetically nil "\ @@ -5307,6 +5285,13 @@ Customize all loaded groups matching REGEXP. \(fn REGEXP)" t nil) +(autoload 'custom-prompt-customize-unsaved-options "cus-edit" "\ +Prompt user to customize any unsaved customization options. +Return non-nil if user chooses to customize, for use in +`kill-emacs-query-functions'. + +\(fn)" nil nil) + (autoload 'custom-buffer-create "cus-edit" "\ Create a buffer containing OPTIONS. Optional NAME is the name of the buffer. @@ -5393,8 +5378,8 @@ The format is suitable for use with `easy-menu-define'. ;;;*** -;;;### (autoloads nil "cus-theme" "cus-theme.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "cus-theme" "cus-theme.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from cus-theme.el (autoload 'customize-create-theme "cus-theme" "\ @@ -5427,8 +5412,8 @@ omitted, a buffer named *Custom Themes* is used. ;;;*** -;;;### (autoloads nil "cvs-status" "vc/cvs-status.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "cvs-status" "vc/cvs-status.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from vc/cvs-status.el (autoload 'cvs-status-mode "cvs-status" "\ @@ -5438,8 +5423,8 @@ Mode used for cvs status output. ;;;*** -;;;### (autoloads nil "cwarn" "progmodes/cwarn.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "cwarn" "progmodes/cwarn.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from progmodes/cwarn.el (push (purecopy '(cwarn 1 3 1)) package--builtin-versions) @@ -5484,7 +5469,7 @@ See `cwarn-mode' for more information on Cwarn mode. ;;;*** ;;;### (autoloads nil "cyril-util" "language/cyril-util.el" (21607 -;;;;;; 56024 801559 72000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from language/cyril-util.el (autoload 'cyrillic-encode-koi8-r-char "cyril-util" "\ @@ -5512,8 +5497,8 @@ If the argument is nil, we return the display table to its standard state. ;;;*** -;;;### (autoloads nil "dabbrev" "dabbrev.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "dabbrev" "dabbrev.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from dabbrev.el (put 'dabbrev-case-fold-search 'risky-local-variable t) (put 'dabbrev-case-replace 'risky-local-variable t) @@ -5559,8 +5544,8 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]. ;;;*** -;;;### (autoloads nil "data-debug" "cedet/data-debug.el" (21607 56023 -;;;;;; 800854 237000)) +;;;### (autoloads nil "data-debug" "cedet/data-debug.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from cedet/data-debug.el (autoload 'data-debug-new-buffer "data-debug" "\ @@ -5570,7 +5555,7 @@ Create a new data-debug buffer with NAME. ;;;*** -;;;### (autoloads nil "dbus" "net/dbus.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "dbus" "net/dbus.el" (21607 54478 300138 641000)) ;;; Generated autoloads from net/dbus.el (autoload 'dbus-handle-event "dbus" "\ @@ -5583,8 +5568,8 @@ If the HANDLER returns a `dbus-error', it is propagated as return message. ;;;*** -;;;### (autoloads nil "dcl-mode" "progmodes/dcl-mode.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "dcl-mode" "progmodes/dcl-mode.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/dcl-mode.el (autoload 'dcl-mode "dcl-mode" "\ @@ -5710,8 +5695,8 @@ There is some minimal font-lock support (see vars ;;;*** -;;;### (autoloads nil "debug" "emacs-lisp/debug.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "debug" "emacs-lisp/debug.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from emacs-lisp/debug.el (setq debugger 'debug) @@ -5754,8 +5739,8 @@ To specify a nil argument interactively, exit with an empty minibuffer. ;;;*** -;;;### (autoloads nil "decipher" "play/decipher.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "decipher" "play/decipher.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from play/decipher.el (autoload 'decipher "decipher" "\ @@ -5783,8 +5768,8 @@ The most useful commands are: ;;;*** -;;;### (autoloads nil "delim-col" "delim-col.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "delim-col" "delim-col.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from delim-col.el (push (purecopy '(delim-col 2 1)) package--builtin-versions) @@ -5809,7 +5794,7 @@ START and END delimits the corners of text rectangle. ;;;*** -;;;### (autoloads nil "delsel" "delsel.el" (21607 56023 800854 237000)) +;;;### (autoloads nil "delsel" "delsel.el" (21607 54477 800124 118000)) ;;; Generated autoloads from delsel.el (defalias 'pending-delete-mode 'delete-selection-mode) @@ -5837,8 +5822,8 @@ point regardless of any selection. ;;;*** -;;;### (autoloads nil "derived" "emacs-lisp/derived.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "derived" "emacs-lisp/derived.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from emacs-lisp/derived.el (autoload 'define-derived-mode "derived" "\ @@ -5892,7 +5877,7 @@ See Info node `(elisp)Derived Modes' for more details. \(fn CHILD PARENT NAME &optional DOCSTRING &rest BODY)" nil t) -(put 'define-derived-mode 'doc-string-elt '4) +(function-put 'define-derived-mode 'doc-string-elt '4) (autoload 'derived-mode-init-mode-variables "derived" "\ Initialize variables for a new MODE. @@ -5904,8 +5889,8 @@ the first time the mode is used. ;;;*** -;;;### (autoloads nil "descr-text" "descr-text.el" (21607 56058 801550 -;;;;;; 360000)) +;;;### (autoloads nil "descr-text" "descr-text.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from descr-text.el (autoload 'describe-text-properties "descr-text" "\ @@ -5939,8 +5924,8 @@ relevant to POS. ;;;*** -;;;### (autoloads nil "desktop" "desktop.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "desktop" "desktop.el" (21666 35265 825623 +;;;;;; 21000)) ;;; Generated autoloads from desktop.el (defvar desktop-save-mode nil "\ @@ -6145,8 +6130,8 @@ Revert to the last loaded desktop. ;;;*** -;;;### (autoloads nil "deuglify" "gnus/deuglify.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "deuglify" "gnus/deuglify.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/deuglify.el (autoload 'gnus-article-outlook-unwrap-lines "deuglify" "\ @@ -6178,8 +6163,8 @@ Deuglify broken Outlook (Express) articles and redisplay. ;;;*** -;;;### (autoloads nil "diary-lib" "calendar/diary-lib.el" (21617 -;;;;;; 53323 210147 705000)) +;;;### (autoloads nil "diary-lib" "calendar/diary-lib.el" (21625 +;;;;;; 43838 483701 627000)) ;;; Generated autoloads from calendar/diary-lib.el (autoload 'diary "diary-lib" "\ @@ -6221,7 +6206,7 @@ Major mode for editing the diary file. ;;;*** -;;;### (autoloads nil "diff" "vc/diff.el" (21607 56025 801549 101000)) +;;;### (autoloads nil "diff" "vc/diff.el" (21607 54478 800121 42000)) ;;; Generated autoloads from vc/diff.el (defvar diff-switches (purecopy "-c") "\ @@ -6269,8 +6254,8 @@ This requires the external program `diff' to be in your `exec-path'. ;;;*** -;;;### (autoloads nil "diff-mode" "vc/diff-mode.el" (21607 56059 -;;;;;; 804396 982000)) +;;;### (autoloads nil "diff-mode" "vc/diff-mode.el" (21628 45530 +;;;;;; 160140 360000)) ;;; Generated autoloads from vc/diff-mode.el (autoload 'diff-mode "diff-mode" "\ @@ -6302,7 +6287,7 @@ the mode if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "dig" "net/dig.el" (21607 56024 801559 72000)) +;;;### (autoloads nil "dig" "net/dig.el" (21607 54478 300138 641000)) ;;; Generated autoloads from net/dig.el (autoload 'dig "dig" "\ @@ -6313,7 +6298,7 @@ Optional arguments are passed to `dig-invoke'. ;;;*** -;;;### (autoloads nil "dired" "dired.el" (21607 56058 801550 360000)) +;;;### (autoloads nil "dired" "dired.el" (21662 38238 226339 285000)) ;;; Generated autoloads from dired.el (defvar dired-listing-switches (purecopy "-al") "\ @@ -6389,7 +6374,7 @@ Type \\[dired-mark] to Mark a file or subdirectory for later commands. to see why something went wrong. Type \\[dired-unmark] to Unmark a file or all files of an inserted subdirectory. Type \\[dired-unmark-backward] to back up one line and unmark or unflag. -Type \\[dired-do-flagged-delete] to delete (eXecute) the files flagged `D'. +Type \\[dired-do-flagged-delete] to delete (eXpunge) the files flagged `D'. Type \\[dired-find-file] to Find the current line's file (or dired it in another buffer, if it is a directory). Type \\[dired-find-file-other-window] to find file or Dired directory in Other window. @@ -6433,8 +6418,8 @@ Keybindings: ;;;*** -;;;### (autoloads nil "dirtrack" "dirtrack.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "dirtrack" "dirtrack.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from dirtrack.el (autoload 'dirtrack-mode "dirtrack" "\ @@ -6464,8 +6449,8 @@ from `default-directory'. ;;;*** -;;;### (autoloads nil "disass" "emacs-lisp/disass.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "disass" "emacs-lisp/disass.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from emacs-lisp/disass.el (autoload 'disassemble "disass" "\ @@ -6479,8 +6464,8 @@ redefine OBJECT if it is a symbol. ;;;*** -;;;### (autoloads nil "disp-table" "disp-table.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "disp-table" "disp-table.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from disp-table.el (autoload 'make-display-table "disp-table" "\ @@ -6601,8 +6586,8 @@ in `.emacs'. ;;;*** -;;;### (autoloads nil "dissociate" "play/dissociate.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "dissociate" "play/dissociate.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from play/dissociate.el (autoload 'dissociated-press "dissociate" "\ @@ -6618,7 +6603,7 @@ Default is 2. ;;;*** -;;;### (autoloads nil "dnd" "dnd.el" (21607 56023 800854 237000)) +;;;### (autoloads nil "dnd" "dnd.el" (21666 35265 825623 21000)) ;;; Generated autoloads from dnd.el (defvar dnd-protocol-alist `((,(purecopy "^file:///") . dnd-open-local-file) (,(purecopy "^file://") . dnd-open-file) (,(purecopy "^file:") . dnd-open-local-file) (,(purecopy "^\\(https?\\|ftp\\|file\\|nfs\\)://") . dnd-open-file)) "\ @@ -6638,8 +6623,8 @@ if some action was made, or nil if the URL is ignored.") ;;;*** -;;;### (autoloads nil "dns-mode" "textmodes/dns-mode.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "dns-mode" "textmodes/dns-mode.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from textmodes/dns-mode.el (autoload 'dns-mode "dns-mode" "\ @@ -6662,8 +6647,8 @@ Locate SOA record and increment the serial field. ;;;*** -;;;### (autoloads nil "doc-view" "doc-view.el" (21607 56058 801550 -;;;;;; 360000)) +;;;### (autoloads nil "doc-view" "doc-view.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from doc-view.el (autoload 'doc-view-mode-p "doc-view" "\ @@ -6709,8 +6694,8 @@ See the command `doc-view-mode' for more information on this mode. ;;;*** -;;;### (autoloads nil "doctor" "play/doctor.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "doctor" "play/doctor.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from play/doctor.el (autoload 'doctor "doctor" "\ @@ -6720,7 +6705,7 @@ Switch to *doctor* buffer and start giving psychotherapy. ;;;*** -;;;### (autoloads nil "double" "double.el" (21607 56023 800854 237000)) +;;;### (autoloads nil "double" "double.el" (21607 54477 800124 118000)) ;;; Generated autoloads from double.el (autoload 'double-mode "double" "\ @@ -6736,8 +6721,8 @@ strings when pressed twice. See `double-map' for details. ;;;*** -;;;### (autoloads nil "dunnet" "play/dunnet.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "dunnet" "play/dunnet.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from play/dunnet.el (push (purecopy '(dunnet 2 1)) package--builtin-versions) @@ -6749,7 +6734,7 @@ Switch to *dungeon* buffer and start game. ;;;*** ;;;### (autoloads nil "easy-mmode" "emacs-lisp/easy-mmode.el" (21607 -;;;;;; 56058 801550 360000)) +;;;;;; 54477 800124 118000)) ;;; Generated autoloads from emacs-lisp/easy-mmode.el (defalias 'easy-mmode-define-minor-mode 'define-minor-mode) @@ -6821,7 +6806,7 @@ For example, you could write \(fn MODE DOC &optional INIT-VALUE LIGHTER KEYMAP &rest BODY)" nil t) -(put 'define-minor-mode 'doc-string-elt '2) +(function-put 'define-minor-mode 'doc-string-elt '2) (defalias 'easy-mmode-define-global-mode 'define-globalized-minor-mode) @@ -6852,7 +6837,7 @@ on if the hook has explicitly disabled it. \(fn GLOBAL-MODE MODE TURN-ON &rest KEYS)" nil t) -(put 'define-globalized-minor-mode 'doc-string-elt '2) +(function-put 'define-globalized-minor-mode 'doc-string-elt '2) (autoload 'easy-mmode-define-keymap "easy-mmode" "\ Return a keymap built from bindings BS. @@ -6889,7 +6874,7 @@ CSS contains a list of syntax specifications of the form (CHAR . SYNTAX). ;;;*** ;;;### (autoloads nil "easymenu" "emacs-lisp/easymenu.el" (21607 -;;;;;; 56024 300834 853000)) +;;;;;; 54477 800124 118000)) ;;; Generated autoloads from emacs-lisp/easymenu.el (autoload 'easy-menu-define "easymenu" "\ @@ -6991,7 +6976,7 @@ MENU. This is a submenu. \(fn SYMBOL MAPS DOC MENU)" nil t) -(put 'easy-menu-define 'lisp-indent-function 'defun) +(function-put 'easy-menu-define 'lisp-indent-function 'defun) (autoload 'easy-menu-do-define "easymenu" "\ @@ -7027,8 +7012,8 @@ To implement dynamic menus, either call this from ;;;*** -;;;### (autoloads nil "ebnf2ps" "progmodes/ebnf2ps.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "ebnf2ps" "progmodes/ebnf2ps.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/ebnf2ps.el (push (purecopy '(ebnf2ps 4 4)) package--builtin-versions) @@ -7293,8 +7278,8 @@ See `ebnf-style-database' documentation. ;;;*** -;;;### (autoloads nil "ebrowse" "progmodes/ebrowse.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "ebrowse" "progmodes/ebrowse.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/ebrowse.el (autoload 'ebrowse-tree-mode "ebrowse" "\ @@ -7442,8 +7427,8 @@ Display statistics for a class tree. ;;;*** -;;;### (autoloads nil "ebuff-menu" "ebuff-menu.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "ebuff-menu" "ebuff-menu.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from ebuff-menu.el (autoload 'electric-buffer-list "ebuff-menu" "\ @@ -7475,8 +7460,8 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry. ;;;*** -;;;### (autoloads nil "echistory" "echistory.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "echistory" "echistory.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from echistory.el (autoload 'Electric-command-history-redo-expression "echistory" "\ @@ -7487,8 +7472,8 @@ With prefix arg NOCONFIRM, execute current line as-is without editing. ;;;*** -;;;### (autoloads nil "ecomplete" "gnus/ecomplete.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "ecomplete" "gnus/ecomplete.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/ecomplete.el (autoload 'ecomplete-setup "ecomplete" "\ @@ -7498,7 +7483,7 @@ With prefix arg NOCONFIRM, execute current line as-is without editing. ;;;*** -;;;### (autoloads nil "ede" "cedet/ede.el" (21607 56058 801550 360000)) +;;;### (autoloads nil "ede" "cedet/ede.el" (21607 54477 800124 118000)) ;;; Generated autoloads from cedet/ede.el (push (purecopy '(ede 1 2)) package--builtin-versions) @@ -7524,8 +7509,8 @@ an EDE controlled project. ;;;*** -;;;### (autoloads nil "edebug" "emacs-lisp/edebug.el" (21607 56058 -;;;;;; 801550 360000)) +;;;### (autoloads nil "edebug" "emacs-lisp/edebug.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from emacs-lisp/edebug.el (defvar edebug-all-defs nil "\ @@ -7589,7 +7574,7 @@ Toggle edebugging of all forms. ;;;*** -;;;### (autoloads nil "ediff" "vc/ediff.el" (21607 56025 801549 101000)) +;;;### (autoloads nil "ediff" "vc/ediff.el" (21607 54478 800121 42000)) ;;; Generated autoloads from vc/ediff.el (push (purecopy '(ediff 2 81 4)) package--builtin-versions) @@ -7861,8 +7846,8 @@ With optional NODE, goes to that node. ;;;*** -;;;### (autoloads nil "ediff-help" "vc/ediff-help.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "ediff-help" "vc/ediff-help.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from vc/ediff-help.el (autoload 'ediff-customize "ediff-help" "\ @@ -7872,8 +7857,8 @@ With optional NODE, goes to that node. ;;;*** -;;;### (autoloads nil "ediff-mult" "vc/ediff-mult.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "ediff-mult" "vc/ediff-mult.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from vc/ediff-mult.el (autoload 'ediff-show-registry "ediff-mult" "\ @@ -7885,8 +7870,8 @@ Display Ediff's registry. ;;;*** -;;;### (autoloads nil "ediff-util" "vc/ediff-util.el" (21607 56059 -;;;;;; 804396 982000)) +;;;### (autoloads nil "ediff-util" "vc/ediff-util.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from vc/ediff-util.el (autoload 'ediff-toggle-multiframe "ediff-util" "\ @@ -7905,8 +7890,8 @@ To change the default, set the variable `ediff-use-toolbar-p', which see. ;;;*** -;;;### (autoloads nil "edmacro" "edmacro.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "edmacro" "edmacro.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from edmacro.el (push (purecopy '(edmacro 2 1)) package--builtin-versions) @@ -7955,8 +7940,8 @@ or nil, use a compact 80-column format. ;;;*** -;;;### (autoloads nil "edt" "emulation/edt.el" (21607 56058 801550 -;;;;;; 360000)) +;;;### (autoloads nil "edt" "emulation/edt.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from emulation/edt.el (autoload 'edt-set-scroll-margins "edt" "\ @@ -7973,7 +7958,7 @@ Turn on EDT Emulation. ;;;*** -;;;### (autoloads nil "ehelp" "ehelp.el" (21607 56023 800854 237000)) +;;;### (autoloads nil "ehelp" "ehelp.el" (21607 54477 800124 118000)) ;;; Generated autoloads from ehelp.el (autoload 'with-electric-help "ehelp" "\ @@ -8009,15 +7994,15 @@ BUFFER is put back into its original major mode. ;;;*** -;;;### (autoloads nil "eieio" "emacs-lisp/eieio.el" (21607 56058 -;;;;;; 801550 360000)) +;;;### (autoloads nil "eieio" "emacs-lisp/eieio.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from emacs-lisp/eieio.el (push (purecopy '(eieio 1 4)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "eieio-core" "emacs-lisp/eieio-core.el" (21607 -;;;;;; 56058 801550 360000)) +;;;### (autoloads nil "eieio-core" "emacs-lisp/eieio-core.el" (21634 +;;;;;; 58813 400848 500000)) ;;; Generated autoloads from emacs-lisp/eieio-core.el (push (purecopy '(eieio-core 1 4)) package--builtin-versions) @@ -8033,52 +8018,8 @@ It creates an autoload function for CNAME's constructor. ;;;*** -;;;### (autoloads nil "eldoc" "emacs-lisp/eldoc.el" (21607 56058 -;;;;;; 801550 360000)) -;;; Generated autoloads from emacs-lisp/eldoc.el - -(defvar eldoc-minor-mode-string (purecopy " ElDoc") "\ -String to display in mode line when ElDoc Mode is enabled; nil for none.") - -(custom-autoload 'eldoc-minor-mode-string "eldoc" t) - -(autoload 'eldoc-mode "eldoc" "\ -Toggle echo area display of Lisp objects at point (ElDoc mode). -With a prefix argument ARG, enable ElDoc mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable ElDoc mode -if ARG is omitted or nil. - -ElDoc mode is a buffer-local minor mode. When enabled, the echo -area displays information about a function or variable in the -text where point is. If point is on a documented variable, it -displays the first line of that variable's doc string. Otherwise -it displays the argument list of the function called in the -expression point is on. - -\(fn &optional ARG)" t nil) - -(define-obsolete-function-alias 'turn-on-eldoc-mode 'eldoc-mode "24.4") - -(defvar eldoc-documentation-function nil "\ -If non-nil, function to call to return doc string. -The function of no args should return a one-line string for displaying -doc about a function etc. appropriate to the context around point. -It should return nil if there's no doc appropriate for the context. -Typically doc is returned if point is on a function-like name or in its -arg list. - -The result is used as is, so the function must explicitly handle -the variables `eldoc-argument-case' and `eldoc-echo-area-use-multiline-p', -and the face `eldoc-highlight-function-argument', if they are to have any -effect. - -This variable is expected to be made buffer-local by modes (other than -Emacs Lisp mode) that support ElDoc.") - -;;;*** - -;;;### (autoloads nil "elec-pair" "elec-pair.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "elec-pair" "elec-pair.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from elec-pair.el (defvar electric-pair-text-pairs '((34 . 34)) "\ @@ -8113,8 +8054,8 @@ closing parenthesis. (Likewise for brackets, etc.). ;;;*** -;;;### (autoloads nil "elide-head" "elide-head.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "elide-head" "elide-head.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from elide-head.el (autoload 'elide-head "elide-head" "\ @@ -8129,8 +8070,8 @@ This is suitable as an entry on `find-file-hook' or appropriate mode hooks. ;;;*** -;;;### (autoloads nil "elint" "emacs-lisp/elint.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "elint" "emacs-lisp/elint.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from emacs-lisp/elint.el (autoload 'elint-file "elint" "\ @@ -8165,8 +8106,8 @@ optional prefix argument REINIT is non-nil. ;;;*** -;;;### (autoloads nil "elp" "emacs-lisp/elp.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "elp" "emacs-lisp/elp.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from emacs-lisp/elp.el (autoload 'elp-instrument-function "elp" "\ @@ -8200,8 +8141,8 @@ displayed. ;;;*** -;;;### (autoloads nil "emacs-lock" "emacs-lock.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "emacs-lock" "emacs-lock.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from emacs-lock.el (autoload 'emacs-lock-mode "emacs-lock" "\ @@ -8228,8 +8169,8 @@ Other values are interpreted as usual. ;;;*** -;;;### (autoloads nil "emacsbug" "mail/emacsbug.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "emacsbug" "mail/emacsbug.el" (21608 34742 +;;;;;; 2253 811000)) ;;; Generated autoloads from mail/emacsbug.el (autoload 'report-emacs-bug "emacsbug" "\ @@ -8242,8 +8183,8 @@ Prompts for bug subject. Leaves you in a mail buffer. ;;;*** -;;;### (autoloads nil "emerge" "vc/emerge.el" (21607 56059 804396 -;;;;;; 982000)) +;;;### (autoloads nil "emerge" "vc/emerge.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from vc/emerge.el (autoload 'emerge-files "emerge" "\ @@ -8303,8 +8244,8 @@ Emerge two RCS revisions of a file, with another revision as ancestor. ;;;*** -;;;### (autoloads nil "enriched" "textmodes/enriched.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "enriched" "textmodes/enriched.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from textmodes/enriched.el (autoload 'enriched-mode "enriched" "\ @@ -8339,7 +8280,7 @@ Commands: ;;;*** -;;;### (autoloads nil "epa" "epa.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "epa" "epa.el" (21624 22971 140149 848000)) ;;; Generated autoloads from epa.el (autoload 'epa-list-keys "epa" "\ @@ -8416,6 +8357,8 @@ See the reason described in the `epa-decrypt-region' documentation. \(fn START END)" t nil) +(function-put 'epa-decrypt-armor-in-region 'interactive-only 't) + (autoload 'epa-verify-region "epa" "\ Verify the current region between START and END. @@ -8436,6 +8379,8 @@ For example: \(fn START END)" t nil) +(function-put 'epa-verify-region 'interactive-only 't) + (autoload 'epa-verify-cleartext-in-region "epa" "\ Verify OpenPGP cleartext signed messages in the current region between START and END. @@ -8445,6 +8390,8 @@ See the reason described in the `epa-verify-region' documentation. \(fn START END)" t nil) +(function-put 'epa-verify-cleartext-in-region 'interactive-only 't) + (autoload 'epa-sign-region "epa" "\ Sign the current region between START and END by SIGNERS keys selected. @@ -8464,6 +8411,8 @@ For example: \(fn START END SIGNERS MODE)" t nil) +(function-put 'epa-sign-region 'interactive-only 't) + (autoload 'epa-encrypt-region "epa" "\ Encrypt the current region between START and END for RECIPIENTS. @@ -8484,6 +8433,8 @@ For example: \(fn START END RECIPIENTS SIGN SIGNERS)" t nil) +(function-put 'epa-encrypt-region 'interactive-only 't) + (autoload 'epa-delete-keys "epa" "\ Delete selected KEYS. @@ -8517,8 +8468,8 @@ Insert selected KEYS after the point. ;;;*** -;;;### (autoloads nil "epa-dired" "epa-dired.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "epa-dired" "epa-dired.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from epa-dired.el (autoload 'epa-dired-do-decrypt "epa-dired" "\ @@ -8543,8 +8494,8 @@ Encrypt marked files. ;;;*** -;;;### (autoloads nil "epa-file" "epa-file.el" (21607 56058 801550 -;;;;;; 360000)) +;;;### (autoloads nil "epa-file" "epa-file.el" (21611 10937 700236 +;;;;;; 3000)) ;;; Generated autoloads from epa-file.el (autoload 'epa-file-handler "epa-file" "\ @@ -8564,8 +8515,8 @@ Encrypt marked files. ;;;*** -;;;### (autoloads nil "epa-mail" "epa-mail.el" (21607 56058 801550 -;;;;;; 360000)) +;;;### (autoloads nil "epa-mail" "epa-mail.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from epa-mail.el (autoload 'epa-mail-mode "epa-mail" "\ @@ -8580,26 +8531,26 @@ if ARG is omitted or nil. Decrypt OpenPGP armors in the current buffer. The buffer is expected to contain a mail message. -Don't use this command in Lisp programs! - \(fn)" t nil) +(function-put 'epa-mail-decrypt 'interactive-only 't) + (autoload 'epa-mail-verify "epa-mail" "\ Verify OpenPGP cleartext signed messages in the current buffer. The buffer is expected to contain a mail message. -Don't use this command in Lisp programs! - \(fn)" t nil) +(function-put 'epa-mail-verify 'interactive-only 't) + (autoload 'epa-mail-sign "epa-mail" "\ Sign the current buffer. The buffer is expected to contain a mail message. -Don't use this command in Lisp programs! - \(fn START END SIGNERS MODE)" t nil) +(function-put 'epa-mail-sign 'interactive-only 't) + (autoload 'epa-mail-encrypt "epa-mail" "\ Encrypt the outgoing mail message in the current buffer. Takes the recipients from the text in the header in the buffer @@ -8619,10 +8570,10 @@ SIGNERS is a list of keys to sign the message with. Import keys in the OpenPGP armor format in the current buffer. The buffer is expected to contain a mail message. -Don't use this command in Lisp programs! - \(fn)" t nil) +(function-put 'epa-mail-import-keys 'interactive-only 't) + (defvar epa-global-mail-mode nil "\ Non-nil if Epa-Global-Mail mode is enabled. See the command `epa-global-mail-mode' for a description of this minor mode. @@ -8642,7 +8593,7 @@ if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "epg" "epg.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "epg" "epg.el" (21611 10937 700236 3000)) ;;; Generated autoloads from epg.el (push (purecopy '(epg 1 0 0)) package--builtin-versions) @@ -8653,8 +8604,8 @@ Return a context object. ;;;*** -;;;### (autoloads nil "epg-config" "epg-config.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "epg-config" "epg-config.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from epg-config.el (autoload 'epg-configuration "epg-config" "\ @@ -8674,7 +8625,7 @@ Look at CONFIG and try to expand GROUP. ;;;*** -;;;### (autoloads nil "erc" "erc/erc.el" (21607 56024 300834 853000)) +;;;### (autoloads nil "erc" "erc/erc.el" (21607 54478 300138 641000)) ;;; Generated autoloads from erc/erc.el (autoload 'erc-select-read-args "erc" "\ @@ -8703,7 +8654,7 @@ then the server and full-name will be set to those values, whereas `erc-compute-port', `erc-compute-nick' and `erc-compute-full-name' will be invoked for the values of the other parameters. -\(fn &key (server (erc-compute-server)) (port (erc-compute-port)) (nick (erc-compute-nick)) PASSWORD (full-name (erc-compute-full-name)))" t nil) +\(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK (erc-compute-nick)) PASSWORD (FULL-NAME (erc-compute-full-name)))" t nil) (defalias 'erc-select 'erc) @@ -8723,35 +8674,35 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL. ;;;*** ;;;### (autoloads nil "erc-autoaway" "erc/erc-autoaway.el" (21607 -;;;;;; 56024 300834 853000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from erc/erc-autoaway.el (autoload 'erc-autoaway-mode "erc-autoaway") ;;;*** -;;;### (autoloads nil "erc-button" "erc/erc-button.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "erc-button" "erc/erc-button.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from erc/erc-button.el (autoload 'erc-button-mode "erc-button" nil t) ;;;*** -;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from erc/erc-capab.el (autoload 'erc-capab-identify-mode "erc-capab" nil t) ;;;*** -;;;### (autoloads nil "erc-compat" "erc/erc-compat.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "erc-compat" "erc/erc-compat.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from erc/erc-compat.el (autoload 'erc-define-minor-mode "erc-compat") ;;;*** -;;;### (autoloads nil "erc-dcc" "erc/erc-dcc.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "erc-dcc" "erc/erc-dcc.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from erc/erc-dcc.el (autoload 'erc-dcc-mode "erc-dcc") @@ -8781,14 +8732,14 @@ that subcommand. ;;;*** ;;;### (autoloads nil "erc-desktop-notifications" "erc/erc-desktop-notifications.el" -;;;;;; (21607 56024 300834 853000)) +;;;;;; (21617 49721 420132 227000)) ;;; Generated autoloads from erc/erc-desktop-notifications.el (autoload 'erc-notifications-mode "erc-desktop-notifications" "" t) ;;;*** ;;;### (autoloads nil "erc-ezbounce" "erc/erc-ezbounce.el" (21607 -;;;;;; 56024 300834 853000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from erc/erc-ezbounce.el (autoload 'erc-cmd-ezb "erc-ezbounce" "\ @@ -8850,8 +8801,8 @@ Add EZBouncer convenience functions to ERC. ;;;*** -;;;### (autoloads nil "erc-fill" "erc/erc-fill.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "erc-fill" "erc/erc-fill.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from erc/erc-fill.el (autoload 'erc-fill-mode "erc-fill" nil t) @@ -8863,8 +8814,8 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'. ;;;*** -;;;### (autoloads nil "erc-identd" "erc/erc-identd.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "erc-identd" "erc/erc-identd.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from erc/erc-identd.el (autoload 'erc-identd-mode "erc-identd") @@ -8885,8 +8836,8 @@ system. ;;;*** -;;;### (autoloads nil "erc-imenu" "erc/erc-imenu.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "erc-imenu" "erc/erc-imenu.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from erc/erc-imenu.el (autoload 'erc-create-imenu-index "erc-imenu" "\ @@ -8896,22 +8847,22 @@ system. ;;;*** -;;;### (autoloads nil "erc-join" "erc/erc-join.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "erc-join" "erc/erc-join.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from erc/erc-join.el (autoload 'erc-autojoin-mode "erc-join" nil t) ;;;*** -;;;### (autoloads nil "erc-list" "erc/erc-list.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "erc-list" "erc/erc-list.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from erc/erc-list.el (autoload 'erc-list-mode "erc-list") ;;;*** -;;;### (autoloads nil "erc-log" "erc/erc-log.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "erc-log" "erc/erc-log.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from erc/erc-log.el (autoload 'erc-log-mode "erc-log" nil t) @@ -8940,8 +8891,8 @@ You can save every individual message by putting this function on ;;;*** -;;;### (autoloads nil "erc-match" "erc/erc-match.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "erc-match" "erc/erc-match.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from erc/erc-match.el (autoload 'erc-match-mode "erc-match") @@ -8987,15 +8938,15 @@ Delete dangerous-host interactively to `erc-dangerous-hosts'. ;;;*** -;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from erc/erc-menu.el (autoload 'erc-menu-mode "erc-menu" nil t) ;;;*** ;;;### (autoloads nil "erc-netsplit" "erc/erc-netsplit.el" (21607 -;;;;;; 56024 300834 853000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from erc/erc-netsplit.el (autoload 'erc-netsplit-mode "erc-netsplit") @@ -9007,7 +8958,7 @@ Show who's gone. ;;;*** ;;;### (autoloads nil "erc-networks" "erc/erc-networks.el" (21607 -;;;;;; 56024 300834 853000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from erc/erc-networks.el (autoload 'erc-determine-network "erc-networks" "\ @@ -9024,8 +8975,8 @@ Interactively select a server to connect to using `erc-server-alist'. ;;;*** -;;;### (autoloads nil "erc-notify" "erc/erc-notify.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "erc-notify" "erc/erc-notify.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from erc/erc-notify.el (autoload 'erc-notify-mode "erc-notify" nil t) @@ -9043,36 +8994,36 @@ with args, toggle notify status of people. ;;;*** -;;;### (autoloads nil "erc-page" "erc/erc-page.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "erc-page" "erc/erc-page.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from erc/erc-page.el (autoload 'erc-page-mode "erc-page") ;;;*** ;;;### (autoloads nil "erc-pcomplete" "erc/erc-pcomplete.el" (21607 -;;;;;; 56024 300834 853000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from erc/erc-pcomplete.el (autoload 'erc-completion-mode "erc-pcomplete" nil t) ;;;*** -;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from erc/erc-replace.el (autoload 'erc-replace-mode "erc-replace") ;;;*** -;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from erc/erc-ring.el (autoload 'erc-ring-mode "erc-ring" nil t) ;;;*** ;;;### (autoloads nil "erc-services" "erc/erc-services.el" (21607 -;;;;;; 56024 300834 853000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from erc/erc-services.el (autoload 'erc-services-mode "erc-services" nil t) @@ -9089,15 +9040,15 @@ When called interactively, read the password using `read-passwd'. ;;;*** -;;;### (autoloads nil "erc-sound" "erc/erc-sound.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "erc-sound" "erc/erc-sound.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from erc/erc-sound.el (autoload 'erc-sound-mode "erc-sound") ;;;*** ;;;### (autoloads nil "erc-speedbar" "erc/erc-speedbar.el" (21607 -;;;;;; 56024 300834 853000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from erc/erc-speedbar.el (autoload 'erc-speedbar-browser "erc-speedbar" "\ @@ -9109,21 +9060,21 @@ This will add a speedbar major display mode. ;;;*** ;;;### (autoloads nil "erc-spelling" "erc/erc-spelling.el" (21607 -;;;;;; 56024 300834 853000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from erc/erc-spelling.el (autoload 'erc-spelling-mode "erc-spelling" nil t) ;;;*** -;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from erc/erc-stamp.el (autoload 'erc-timestamp-mode "erc-stamp" nil t) ;;;*** -;;;### (autoloads nil "erc-track" "erc/erc-track.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "erc-track" "erc/erc-track.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from erc/erc-track.el (defvar erc-track-minor-mode nil "\ @@ -9149,7 +9100,7 @@ keybindings will not do anything useful. ;;;*** ;;;### (autoloads nil "erc-truncate" "erc/erc-truncate.el" (21607 -;;;;;; 56024 300834 853000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from erc/erc-truncate.el (autoload 'erc-truncate-mode "erc-truncate" nil t) @@ -9168,8 +9119,8 @@ Meant to be used in hooks, like `erc-insert-post-hook'. ;;;*** -;;;### (autoloads nil "erc-xdcc" "erc/erc-xdcc.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "erc-xdcc" "erc/erc-xdcc.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from erc/erc-xdcc.el (autoload 'erc-xdcc-mode "erc-xdcc") @@ -9180,8 +9131,8 @@ Add a file to `erc-xdcc-files'. ;;;*** -;;;### (autoloads nil "ert" "emacs-lisp/ert.el" (21607 56058 801550 -;;;;;; 360000)) +;;;### (autoloads nil "ert" "emacs-lisp/ert.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from emacs-lisp/ert.el (autoload 'ert-deftest "ert" "\ @@ -9199,7 +9150,11 @@ 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...)" nil (quote macro)) +\(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags '(TAG...)] BODY...)" nil t) + +(function-put 'ert-deftest 'doc-string-elt '3) + +(function-put 'ert-deftest 'lisp-indent-function '2) (put 'ert-deftest 'lisp-indent-function 2) @@ -9246,8 +9201,8 @@ Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test). ;;;*** -;;;### (autoloads nil "ert-x" "emacs-lisp/ert-x.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "ert-x" "emacs-lisp/ert-x.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from emacs-lisp/ert-x.el (put 'ert-with-test-buffer 'lisp-indent-function 1) @@ -9259,8 +9214,8 @@ Kill all test buffers that are still live. ;;;*** -;;;### (autoloads nil "esh-mode" "eshell/esh-mode.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "esh-mode" "eshell/esh-mode.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from eshell/esh-mode.el (autoload 'eshell-mode "esh-mode" "\ @@ -9270,8 +9225,8 @@ Emacs shell interactive mode. ;;;*** -;;;### (autoloads nil "eshell" "eshell/eshell.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "eshell" "eshell/eshell.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from eshell/eshell.el (push (purecopy '(eshell 2 4 2)) package--builtin-versions) @@ -9306,8 +9261,8 @@ corresponding to a successful execution. ;;;*** -;;;### (autoloads nil "etags" "progmodes/etags.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "etags" "progmodes/etags.el" (21665 14401 955623 +;;;;;; 556000)) ;;; Generated autoloads from progmodes/etags.el (defvar tags-file-name nil "\ @@ -9400,6 +9355,11 @@ as they appeared in the `etags' command that created the table, usually without directory names. \(fn)" nil nil) + +(autoload 'tags-lazy-completion-table "etags" "\ + + +\(fn)" nil nil) (defun tags-completion-at-point-function () (if (or tags-table-list tags-file-name) (progn @@ -9448,7 +9408,6 @@ Contrast this with the ring of marks gone to by the command. See documentation of variable `tags-file-name'. \(fn TAGNAME &optional NEXT-P REGEXP-P)" t nil) - (define-key esc-map "." 'find-tag) (autoload 'find-tag-other-window "etags" "\ Find tag (in current tags table) whose name contains TAGNAME. @@ -9471,7 +9430,8 @@ Contrast this with the ring of marks gone to by the command. See documentation of variable `tags-file-name'. \(fn TAGNAME &optional NEXT-P REGEXP-P)" t nil) - (define-key ctl-x-4-map "." 'find-tag-other-window) + +(make-obsolete 'find-tag-other-window 'xref-find-definitions-other-window '"25.1") (autoload 'find-tag-other-frame "etags" "\ Find tag (in current tags table) whose name contains TAGNAME. @@ -9494,7 +9454,8 @@ Contrast this with the ring of marks gone to by the command. See documentation of variable `tags-file-name'. \(fn TAGNAME &optional NEXT-P)" t nil) - (define-key ctl-x-5-map "." 'find-tag-other-frame) + +(make-obsolete 'find-tag-other-frame 'xref-find-definitions-other-frame '"25.1") (autoload 'find-tag-regexp "etags" "\ Find tag (in current tags table) whose name matches REGEXP. @@ -9515,17 +9476,10 @@ Contrast this with the ring of marks gone to by the command. See documentation of variable `tags-file-name'. \(fn REGEXP &optional NEXT-P OTHER-WINDOW)" t nil) - (define-key esc-map [?\C-.] 'find-tag-regexp) - (define-key esc-map "*" 'pop-tag-mark) -(autoload 'pop-tag-mark "etags" "\ -Pop back to where \\[find-tag] was last invoked. +(make-obsolete 'find-tag-regexp 'xref-find-apropos '"25.1") -This is distinct from invoking \\[find-tag] with a negative argument -since that pops a stack of markers at which tags were found, not from -where they were found. - -\(fn)" t nil) +(defalias 'pop-tag-mark 'xref-pop-marker-stack) (autoload 'next-file "etags" "\ Select next file among files in current tags table. @@ -9554,7 +9508,8 @@ evaluate to operate on an interesting file. If the latter evaluates to nil, we exit; otherwise we scan the next file. \(fn &optional FIRST-TIME)" t nil) - (define-key esc-map "," 'tags-loop-continue) + +(make-obsolete 'tags-loop-continue '"use `xref-find-definitions' interface instead." '"25.1") (autoload 'tags-search "etags" "\ Search through all files listed in tags table for match for REGEXP. @@ -9598,6 +9553,8 @@ Display list of all tags in tags table REGEXP matches. \(fn REGEXP)" t nil) +(make-obsolete 'tags-apropos 'xref-find-apropos '"25.1") + (autoload 'select-tags-table "etags" "\ Select a tags table file from a menu of those you have already used. The list of tags tables to select from is stored in `tags-table-set-list'; @@ -9613,10 +9570,15 @@ for \\[find-tag] (which see). \(fn)" t nil) +(autoload 'etags-xref-find "etags" "\ + + +\(fn ACTION ID)" nil nil) + ;;;*** ;;;### (autoloads nil "ethio-util" "language/ethio-util.el" (21607 -;;;;;; 56024 801559 72000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from language/ethio-util.el (autoload 'setup-ethiopic-environment-internal "ethio-util" "\ @@ -9784,7 +9746,7 @@ With ARG, insert that many delimiters. ;;;*** -;;;### (autoloads nil "eudc" "net/eudc.el" (21607 56024 801559 72000)) +;;;### (autoloads nil "eudc" "net/eudc.el" (21607 54478 300138 641000)) ;;; Generated autoloads from net/eudc.el (autoload 'eudc-set-server "eudc" "\ @@ -9838,8 +9800,8 @@ This does nothing except loading eudc by autoload side-effect. ;;;*** -;;;### (autoloads nil "eudc-bob" "net/eudc-bob.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "eudc-bob" "net/eudc-bob.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from net/eudc-bob.el (autoload 'eudc-display-generic-binary "eudc-bob" "\ @@ -9874,8 +9836,8 @@ Display a button for the JPEG DATA. ;;;*** -;;;### (autoloads nil "eudc-export" "net/eudc-export.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "eudc-export" "net/eudc-export.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from net/eudc-export.el (autoload 'eudc-insert-record-at-point-into-bbdb "eudc-export" "\ @@ -9892,7 +9854,7 @@ Call `eudc-insert-record-at-point-into-bbdb' if on a record. ;;;*** ;;;### (autoloads nil "eudc-hotlist" "net/eudc-hotlist.el" (21607 -;;;;;; 56024 801559 72000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from net/eudc-hotlist.el (autoload 'eudc-edit-hotlist "eudc-hotlist" "\ @@ -9902,8 +9864,8 @@ Edit the hotlist of directory servers in a specialized buffer. ;;;*** -;;;### (autoloads nil "ewoc" "emacs-lisp/ewoc.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "ewoc" "emacs-lisp/ewoc.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from emacs-lisp/ewoc.el (autoload 'ewoc-create "ewoc" "\ @@ -9929,7 +9891,7 @@ fourth arg NOSEP non-nil inhibits this. ;;;*** -;;;### (autoloads nil "eww" "net/eww.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "eww" "net/eww.el" (21667 56163 185621 290000)) ;;; Generated autoloads from net/eww.el (autoload 'eww "eww" "\ @@ -9945,15 +9907,26 @@ Render a file using EWW. \(fn FILE)" t nil) +(autoload 'eww-search-words "eww" "\ +Search the web for the text between the point and marker. +See the `eww-search-prefix' variable for the search engine used. + +\(fn &optional BEG END)" t nil) + (autoload 'eww-browse-url "eww" "\ \(fn URL &optional NEW-WINDOW)" nil nil) +(autoload 'eww-list-bookmarks "eww" "\ +Display the bookmarks. + +\(fn)" t nil) + ;;;*** ;;;### (autoloads nil "executable" "progmodes/executable.el" (21607 -;;;;;; 56025 301574 889000)) +;;;;;; 54478 800121 42000)) ;;; Generated autoloads from progmodes/executable.el (autoload 'executable-command-find-posix-p "executable" "\ @@ -9994,7 +9967,7 @@ file modes. ;;;*** -;;;### (autoloads nil "expand" "expand.el" (21607 56024 300834 853000)) +;;;### (autoloads nil "expand" "expand.el" (21607 54478 300138 641000)) ;;; Generated autoloads from expand.el (autoload 'expand-add-abbrevs "expand" "\ @@ -10043,8 +10016,8 @@ This is used only in conjunction with `expand-add-abbrevs'. ;;;*** -;;;### (autoloads nil "f90" "progmodes/f90.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "f90" "progmodes/f90.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from progmodes/f90.el (autoload 'f90-mode "f90" "\ @@ -10111,8 +10084,8 @@ with no args, if that value is non-nil. ;;;*** -;;;### (autoloads nil "face-remap" "face-remap.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "face-remap" "face-remap.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from face-remap.el (autoload 'face-remap-add-relative "face-remap" "\ @@ -10271,8 +10244,8 @@ Besides the choice of face, it is the same as `buffer-face-mode'. ;;;*** -;;;### (autoloads nil "feedmail" "mail/feedmail.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "feedmail" "mail/feedmail.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from mail/feedmail.el (push (purecopy '(feedmail 11)) package--builtin-versions) @@ -10326,7 +10299,7 @@ you can set `feedmail-queue-reminder-alist' to nil. ;;;*** -;;;### (autoloads nil "ffap" "ffap.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "ffap" "ffap.el" (21607 54478 300138 641000)) ;;; Generated autoloads from ffap.el (autoload 'ffap-next "ffap" "\ @@ -10389,8 +10362,8 @@ Evaluate the forms in variable `ffap-bindings'. ;;;*** -;;;### (autoloads nil "filecache" "filecache.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "filecache" "filecache.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from filecache.el (autoload 'file-cache-add-directory "filecache" "\ @@ -10447,8 +10420,8 @@ the name is considered already unique; only the second substitution ;;;*** -;;;### (autoloads nil "filenotify" "filenotify.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "filenotify" "filenotify.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from filenotify.el (autoload 'file-notify-handle-event "filenotify" "\ @@ -10460,8 +10433,8 @@ Otherwise, signal a `file-notify-error'. ;;;*** -;;;### (autoloads nil "files-x" "files-x.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "files-x" "files-x.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from files-x.el (autoload 'add-file-local-variable "files-x" "\ @@ -10526,8 +10499,8 @@ Copy directory-local variables to the -*- line. ;;;*** -;;;### (autoloads nil "filesets" "filesets.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "filesets" "filesets.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from filesets.el (autoload 'filesets-init "filesets" "\ @@ -10538,8 +10511,8 @@ Set up hooks, load the cache file -- if existing -- and build the menu. ;;;*** -;;;### (autoloads nil "find-cmd" "find-cmd.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "find-cmd" "find-cmd.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from find-cmd.el (push (purecopy '(find-cmd 0 6)) package--builtin-versions) @@ -10559,8 +10532,8 @@ result is a string that should be ready for the command line. ;;;*** -;;;### (autoloads nil "find-dired" "find-dired.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "find-dired" "find-dired.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from find-dired.el (autoload 'find-dired "find-dired" "\ @@ -10600,8 +10573,8 @@ use in place of \"-ls\" as the final argument. ;;;*** -;;;### (autoloads nil "find-file" "find-file.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "find-file" "find-file.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from find-file.el (defvar ff-special-constructs `((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") lambda nil (buffer-substring (match-beginning 2) (match-end 2)))) "\ @@ -10691,8 +10664,8 @@ Visit the file you click on in another window. ;;;*** -;;;### (autoloads nil "find-func" "emacs-lisp/find-func.el" (21607 -;;;;;; 56058 801550 360000)) +;;;### (autoloads nil "find-func" "emacs-lisp/find-func.el" (21665 +;;;;;; 14401 955623 556000)) ;;; Generated autoloads from emacs-lisp/find-func.el (autoload 'find-library "find-func" "\ @@ -10850,8 +10823,8 @@ Define some key bindings for the find-function family of functions. ;;;*** -;;;### (autoloads nil "find-lisp" "find-lisp.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "find-lisp" "find-lisp.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from find-lisp.el (autoload 'find-lisp-find-dired "find-lisp" "\ @@ -10871,7 +10844,7 @@ Change the filter on a `find-lisp-find-dired' buffer to REGEXP. ;;;*** -;;;### (autoloads nil "finder" "finder.el" (21607 56024 300834 853000)) +;;;### (autoloads nil "finder" "finder.el" (21607 54478 300138 641000)) ;;; Generated autoloads from finder.el (push (purecopy '(finder 1 0)) package--builtin-versions) @@ -10893,8 +10866,8 @@ Find packages matching a given keyword. ;;;*** -;;;### (autoloads nil "flow-ctrl" "flow-ctrl.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "flow-ctrl" "flow-ctrl.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from flow-ctrl.el (autoload 'enable-flow-control "flow-ctrl" "\ @@ -10915,8 +10888,8 @@ to get the effect of a C-q. ;;;*** -;;;### (autoloads nil "flow-fill" "gnus/flow-fill.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "flow-fill" "gnus/flow-fill.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/flow-fill.el (autoload 'fill-flowed-encode "flow-fill" "\ @@ -10931,8 +10904,8 @@ to get the effect of a C-q. ;;;*** -;;;### (autoloads nil "flymake" "progmodes/flymake.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "flymake" "progmodes/flymake.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/flymake.el (push (purecopy '(flymake 0 3)) package--builtin-versions) @@ -10962,8 +10935,8 @@ Turn flymake mode off. ;;;*** -;;;### (autoloads nil "flyspell" "textmodes/flyspell.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "flyspell" "textmodes/flyspell.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from textmodes/flyspell.el (autoload 'flyspell-prog-mode "flyspell" "\ @@ -11033,14 +11006,14 @@ Flyspell whole buffer. ;;;*** -;;;### (autoloads nil "foldout" "foldout.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "foldout" "foldout.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from foldout.el (push (purecopy '(foldout 1 10)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "follow" "follow.el" (21607 56024 300834 853000)) +;;;### (autoloads nil "follow" "follow.el" (21607 54478 300138 641000)) ;;; Generated autoloads from follow.el (autoload 'turn-on-follow-mode "follow" "\ @@ -11108,8 +11081,8 @@ selected if the original window is the first one in the frame. ;;;*** -;;;### (autoloads nil "footnote" "mail/footnote.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "footnote" "mail/footnote.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from mail/footnote.el (push (purecopy '(footnote 0 19)) package--builtin-versions) @@ -11128,7 +11101,7 @@ play around with the following keys: ;;;*** -;;;### (autoloads nil "forms" "forms.el" (21607 56024 300834 853000)) +;;;### (autoloads nil "forms" "forms.el" (21607 54478 300138 641000)) ;;; Generated autoloads from forms.el (autoload 'forms-mode "forms" "\ @@ -11164,8 +11137,8 @@ Visit a file in Forms mode in other window. ;;;*** -;;;### (autoloads nil "fortran" "progmodes/fortran.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "fortran" "progmodes/fortran.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/fortran.el (autoload 'fortran-mode "fortran" "\ @@ -11242,8 +11215,8 @@ with no args, if that value is non-nil. ;;;*** -;;;### (autoloads nil "fortune" "play/fortune.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "fortune" "play/fortune.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from play/fortune.el (autoload 'fortune-add-fortune "fortune" "\ @@ -11291,8 +11264,8 @@ and choose the directory as the fortune-file. ;;;*** -;;;### (autoloads nil "frameset" "frameset.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "frameset" "frameset.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from frameset.el (defvar frameset-session-filter-alist '((name . :never) (left . frameset-filter-iconified) (minibuffer . frameset-filter-minibuffer) (top . frameset-filter-iconified)) "\ @@ -11461,6 +11434,12 @@ Called from `jump-to-register'. Internal use only. \(fn DATA)" nil nil) +(autoload 'frameset--print-register "frameset" "\ +Print basic info about frameset stored in DATA. +Called from `list-registers' and `view-register'. Internal use only. + +\(fn DATA)" nil nil) + (autoload 'frameset-to-register "frameset" "\ Store the current frameset in register REGISTER. Use \\[jump-to-register] to restore the frameset. @@ -11472,15 +11451,15 @@ Interactively, reads the register using `register-read-with-preview'. ;;;*** -;;;### (autoloads nil "gamegrid" "play/gamegrid.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "gamegrid" "play/gamegrid.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from play/gamegrid.el (push (purecopy '(gamegrid 1 2)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "gdb-mi" "progmodes/gdb-mi.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "gdb-mi" "progmodes/gdb-mi.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/gdb-mi.el (defvar gdb-enable-debug nil "\ @@ -11557,8 +11536,8 @@ detailed description of this mode. ;;;*** -;;;### (autoloads nil "generic" "emacs-lisp/generic.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "generic" "emacs-lisp/generic.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from emacs-lisp/generic.el (defvar generic-mode-list nil "\ @@ -11602,9 +11581,9 @@ See the file generic-x.el for some examples of `define-generic-mode'. \(fn MODE COMMENT-LIST KEYWORD-LIST FONT-LOCK-LIST AUTO-MODE-LIST FUNCTION-LIST &optional DOCSTRING)" nil t) -(put 'define-generic-mode 'lisp-indent-function '1) +(function-put 'define-generic-mode 'lisp-indent-function '1) -(put 'define-generic-mode 'doc-string-elt '7) +(function-put 'define-generic-mode 'doc-string-elt '7) (autoload 'generic-mode-internal "generic" "\ Go into the generic mode MODE. @@ -11638,8 +11617,8 @@ regular expression that can be used as an element of ;;;*** -;;;### (autoloads nil "glasses" "progmodes/glasses.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "glasses" "progmodes/glasses.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/glasses.el (autoload 'glasses-mode "glasses" "\ @@ -11653,8 +11632,8 @@ add virtual separators (like underscores) at places they belong to. ;;;*** -;;;### (autoloads nil "gmm-utils" "gnus/gmm-utils.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "gmm-utils" "gnus/gmm-utils.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/gmm-utils.el (autoload 'gmm-regexp-concat "gmm-utils" "\ @@ -11708,7 +11687,7 @@ DEFAULT-MAP specifies the default key map for ICON-LIST. ;;;*** -;;;### (autoloads nil "gnus" "gnus/gnus.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "gnus" "gnus/gnus.el" (21607 54478 300138 641000)) ;;; Generated autoloads from gnus/gnus.el (push (purecopy '(gnus 5 13)) package--builtin-versions) (when (fboundp 'custom-autoload) @@ -11758,8 +11737,8 @@ prompt the user for the name of an NNTP server to use. ;;;*** -;;;### (autoloads nil "gnus-agent" "gnus/gnus-agent.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "gnus-agent" "gnus/gnus-agent.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/gnus-agent.el (autoload 'gnus-unplugged "gnus-agent" "\ @@ -11849,8 +11828,8 @@ CLEAN is obsolete and ignored. ;;;*** -;;;### (autoloads nil "gnus-art" "gnus/gnus-art.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "gnus-art" "gnus/gnus-art.el" (21652 2365 910127 +;;;;;; 752000)) ;;; Generated autoloads from gnus/gnus-art.el (autoload 'gnus-article-prepare-display "gnus-art" "\ @@ -11860,8 +11839,8 @@ Make the current buffer look like a nice article. ;;;*** -;;;### (autoloads nil "gnus-bookmark" "gnus/gnus-bookmark.el" (21607 -;;;;;; 56024 300834 853000)) +;;;### (autoloads nil "gnus-bookmark" "gnus/gnus-bookmark.el" (21645 +;;;;;; 29116 670141 789000)) ;;; Generated autoloads from gnus/gnus-bookmark.el (autoload 'gnus-bookmark-set "gnus-bookmark" "\ @@ -11884,8 +11863,8 @@ deletion, or > if it is flagged for displaying. ;;;*** -;;;### (autoloads nil "gnus-cache" "gnus/gnus-cache.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "gnus-cache" "gnus/gnus-cache.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/gnus-cache.el (autoload 'gnus-jog-cache "gnus-cache" "\ @@ -11926,8 +11905,8 @@ supported. ;;;*** -;;;### (autoloads nil "gnus-delay" "gnus/gnus-delay.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "gnus-delay" "gnus/gnus-delay.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/gnus-delay.el (autoload 'gnus-delay-article "gnus-delay" "\ @@ -11962,8 +11941,8 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil. ;;;*** -;;;### (autoloads nil "gnus-diary" "gnus/gnus-diary.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "gnus-diary" "gnus/gnus-diary.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/gnus-diary.el (autoload 'gnus-user-format-function-d "gnus-diary" "\ @@ -11978,8 +11957,8 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil. ;;;*** -;;;### (autoloads nil "gnus-dired" "gnus/gnus-dired.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "gnus-dired" "gnus/gnus-dired.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/gnus-dired.el (autoload 'turn-on-gnus-dired-mode "gnus-dired" "\ @@ -11989,8 +11968,8 @@ Convenience method to turn on gnus-dired-mode. ;;;*** -;;;### (autoloads nil "gnus-draft" "gnus/gnus-draft.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "gnus-draft" "gnus/gnus-draft.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/gnus-draft.el (autoload 'gnus-draft-reminder "gnus-draft" "\ @@ -12000,13 +11979,22 @@ Reminder user if there are unsent drafts. ;;;*** -;;;### (autoloads nil "gnus-fun" "gnus/gnus-fun.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "gnus-fun" "gnus/gnus-fun.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/gnus-fun.el +(autoload 'gnus--random-face-with-type "gnus-fun" "\ +Return file from DIR with extension EXT, omitting matches of OMIT, processed by FUN. + +\(fn DIR EXT OMIT FUN)" nil nil) + +(autoload 'message-goto-eoh "message" nil t) + (autoload 'gnus-random-x-face "gnus-fun" "\ Return X-Face header data chosen randomly from `gnus-x-face-directory'. +Files matching `gnus-x-face-omit-files' are not considered. + \(fn)" t nil) (autoload 'gnus-insert-random-x-face-header "gnus-fun" "\ @@ -12015,7 +12003,7 @@ Insert a random X-Face header from `gnus-x-face-directory'. \(fn)" t nil) (autoload 'gnus-x-face-from-file "gnus-fun" "\ -Insert an X-Face header based on an image file. +Insert an X-Face header based on an image FILE. Depending on `gnus-convert-image-to-x-face-command' it may accept different input formats. @@ -12023,7 +12011,7 @@ different input formats. \(fn FILE)" t nil) (autoload 'gnus-face-from-file "gnus-fun" "\ -Return a Face header based on an image file. +Return a Face header based on an image FILE. Depending on `gnus-convert-image-to-face-command' it may accept different input formats. @@ -12043,10 +12031,22 @@ FILE should be a PNG file that's 48x48 and smaller than or equal to \(fn FILE)" nil nil) +(autoload 'gnus-random-face "gnus-fun" "\ +Return randomly chosen Face from `gnus-face-directory'. + +Files matching `gnus-face-omit-files' are not considered. + +\(fn)" t nil) + +(autoload 'gnus-insert-random-face-header "gnus-fun" "\ +Insert a random Face header from `gnus-face-directory'. + +\(fn)" nil nil) + ;;;*** ;;;### (autoloads nil "gnus-gravatar" "gnus/gnus-gravatar.el" (21607 -;;;;;; 56024 300834 853000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from gnus/gnus-gravatar.el (autoload 'gnus-treat-from-gravatar "gnus-gravatar" "\ @@ -12063,8 +12063,8 @@ If gravatars are already displayed, remove them. ;;;*** -;;;### (autoloads nil "gnus-group" "gnus/gnus-group.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "gnus-group" "gnus/gnus-group.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/gnus-group.el (autoload 'gnus-fetch-group "gnus-group" "\ @@ -12081,8 +12081,8 @@ Pop up a frame and enter GROUP. ;;;*** -;;;### (autoloads nil "gnus-html" "gnus/gnus-html.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "gnus-html" "gnus/gnus-html.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/gnus-html.el (autoload 'gnus-article-html "gnus-html" "\ @@ -12097,8 +12097,8 @@ Pop up a frame and enter GROUP. ;;;*** -;;;### (autoloads nil "gnus-kill" "gnus/gnus-kill.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "gnus-kill" "gnus/gnus-kill.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/gnus-kill.el (defalias 'gnus-batch-kill 'gnus-batch-score) @@ -12111,8 +12111,8 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score ;;;*** -;;;### (autoloads nil "gnus-ml" "gnus/gnus-ml.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "gnus-ml" "gnus/gnus-ml.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from gnus/gnus-ml.el (autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" "\ @@ -12135,8 +12135,8 @@ Minor mode for providing mailing-list commands. ;;;*** -;;;### (autoloads nil "gnus-mlspl" "gnus/gnus-mlspl.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "gnus-mlspl" "gnus/gnus-mlspl.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/gnus-mlspl.el (autoload 'gnus-group-split-setup "gnus-mlspl" "\ @@ -12236,8 +12236,8 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns: ;;;*** -;;;### (autoloads nil "gnus-msg" "gnus/gnus-msg.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "gnus-msg" "gnus/gnus-msg.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/gnus-msg.el (autoload 'gnus-msg-mail "gnus-msg" "\ @@ -12264,7 +12264,7 @@ Like `message-reply'. ;;;*** ;;;### (autoloads nil "gnus-notifications" "gnus/gnus-notifications.el" -;;;;;; (21607 56059 303525 127000)) +;;;;;; (21607 54478 300138 641000)) ;;; Generated autoloads from gnus/gnus-notifications.el (autoload 'gnus-notifications "gnus-notifications" "\ @@ -12280,8 +12280,8 @@ This is typically a function to add in ;;;*** -;;;### (autoloads nil "gnus-picon" "gnus/gnus-picon.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "gnus-picon" "gnus/gnus-picon.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/gnus-picon.el (autoload 'gnus-treat-from-picon "gnus-picon" "\ @@ -12304,8 +12304,8 @@ If picons are already displayed, remove them. ;;;*** -;;;### (autoloads nil "gnus-range" "gnus/gnus-range.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "gnus-range" "gnus/gnus-range.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/gnus-range.el (autoload 'gnus-sorted-difference "gnus-range" "\ @@ -12372,8 +12372,8 @@ Add NUM into sorted LIST by side effect. ;;;*** -;;;### (autoloads nil "gnus-registry" "gnus/gnus-registry.el" (21607 -;;;;;; 56024 801559 72000)) +;;;### (autoloads nil "gnus-registry" "gnus/gnus-registry.el" (21652 +;;;;;; 2365 910127 752000)) ;;; Generated autoloads from gnus/gnus-registry.el (autoload 'gnus-registry-initialize "gnus-registry" "\ @@ -12388,8 +12388,8 @@ Install the registry hooks. ;;;*** -;;;### (autoloads nil "gnus-sieve" "gnus/gnus-sieve.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "gnus-sieve" "gnus/gnus-sieve.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/gnus-sieve.el (autoload 'gnus-sieve-update "gnus-sieve" "\ @@ -12416,8 +12416,8 @@ See the documentation for these variables and functions for details. ;;;*** -;;;### (autoloads nil "gnus-spec" "gnus/gnus-spec.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "gnus-spec" "gnus/gnus-spec.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/gnus-spec.el (autoload 'gnus-update-format "gnus-spec" "\ @@ -12427,8 +12427,8 @@ Update the format specification near point. ;;;*** -;;;### (autoloads nil "gnus-start" "gnus/gnus-start.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "gnus-start" "gnus/gnus-start.el" (21620 25920 +;;;;;; 601566 783000)) ;;; Generated autoloads from gnus/gnus-start.el (autoload 'gnus-declare-backend "gnus-start" "\ @@ -12438,8 +12438,8 @@ Declare back end NAME with ABILITIES as a Gnus back end. ;;;*** -;;;### (autoloads nil "gnus-sum" "gnus/gnus-sum.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "gnus-sum" "gnus/gnus-sum.el" (21623 2108 292281 +;;;;;; 129000)) ;;; Generated autoloads from gnus/gnus-sum.el (autoload 'gnus-summary-bookmark-jump "gnus-sum" "\ @@ -12450,8 +12450,8 @@ BOOKMARK is a bookmark name or a bookmark record. ;;;*** -;;;### (autoloads nil "gnus-sync" "gnus/gnus-sync.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "gnus-sync" "gnus/gnus-sync.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/gnus-sync.el (autoload 'gnus-sync-initialize "gnus-sync" "\ @@ -12466,8 +12466,8 @@ Install the sync hooks. ;;;*** -;;;### (autoloads nil "gnus-win" "gnus/gnus-win.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "gnus-win" "gnus/gnus-win.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/gnus-win.el (autoload 'gnus-add-configuration "gnus-win" "\ @@ -12477,8 +12477,8 @@ Add the window configuration CONF to `gnus-buffer-configuration'. ;;;*** -;;;### (autoloads nil "gnutls" "net/gnutls.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "gnutls" "net/gnutls.el" (21638 55899 942254 +;;;;;; 689000)) ;;; Generated autoloads from net/gnutls.el (defvar gnutls-min-prime-bits 256 "\ @@ -12494,8 +12494,8 @@ A value of nil says to use the default GnuTLS value.") ;;;*** -;;;### (autoloads nil "gomoku" "play/gomoku.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "gomoku" "play/gomoku.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from play/gomoku.el (autoload 'gomoku "gomoku" "\ @@ -12521,8 +12521,8 @@ Use \\[describe-mode] for more info. ;;;*** -;;;### (autoloads nil "goto-addr" "net/goto-addr.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "goto-addr" "net/goto-addr.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from net/goto-addr.el (define-obsolete-function-alias 'goto-address-at-mouse 'goto-address-at-point "22.1") @@ -12563,8 +12563,8 @@ Like `goto-address-mode', but only for comments and strings. ;;;*** -;;;### (autoloads nil "gravatar" "gnus/gravatar.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "gravatar" "gnus/gravatar.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/gravatar.el (autoload 'gravatar-retrieve "gravatar" "\ @@ -12580,8 +12580,8 @@ Retrieve MAIL-ADDRESS gravatar and returns it. ;;;*** -;;;### (autoloads nil "grep" "progmodes/grep.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "grep" "progmodes/grep.el" (21612 31801 50825 +;;;;;; 711000)) ;;; Generated autoloads from progmodes/grep.el (defvar grep-window-height nil "\ @@ -12614,7 +12614,7 @@ List of hook functions run by `grep-process-setup' (see `run-hooks').") (custom-autoload 'grep-setup-hook "grep" t) -(defconst grep-regexp-alist '(("^\\(.+?\\)\\(:[ ]*\\)\\([1-9][0-9]*\\)\\2" 1 3 ((lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face))) (when mbeg (- mbeg beg))))) lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face)) (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) (when mend (- mend beg)))))) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) "\ +(defconst grep-regexp-alist '(("^\\(.*?[^/\n]\\):[ ]*\\([1-9][0-9]*\\)[ ]*:" 1 2 ((lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face))) (when mbeg (- mbeg beg))))) lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face)) (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) (when mend (- mend beg)))))) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) "\ Regexp used to match grep hits. See `compilation-error-regexp-alist'.") (defvar grep-program (purecopy "grep") "\ @@ -12739,13 +12739,13 @@ Recursively grep for REGEXP in gzipped FILES in tree rooted at DIR. Like `rgrep' but uses `zgrep' for `grep-program', sets the default file name to `*.gz', and sets `grep-highlight-matches' to `always'. -\(fn REGEXP &optional FILES DIR CONFIRM GREP-FIND-TEMPLATE)" t nil) +\(fn REGEXP &optional FILES DIR CONFIRM TEMPLATE)" t nil) (defalias 'rzgrep 'zrgrep) ;;;*** -;;;### (autoloads nil "gs" "gs.el" (21607 56024 801559 72000)) +;;;### (autoloads nil "gs" "gs.el" (21607 54478 300138 641000)) ;;; Generated autoloads from gs.el (autoload 'gs-load-image "gs" "\ @@ -12758,8 +12758,8 @@ the form \"WINDOW-ID PIXMAP-ID\". Value is non-nil if successful. ;;;*** -;;;### (autoloads nil "gud" "progmodes/gud.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "gud" "progmodes/gud.el" (21638 55899 942254 +;;;;;; 689000)) ;;; Generated autoloads from progmodes/gud.el (autoload 'gud-gdb "gud" "\ @@ -12807,6 +12807,13 @@ and source-file directory for your debugger. \(fn COMMAND-LINE)" t nil) +(autoload 'guiler "gud" "\ +Run guiler on program FILE in buffer `*gud-FILE*'. +The directory containing FILE becomes the initial working directory +and source-file directory for your debugger. + +\(fn COMMAND-LINE)" t nil) + (autoload 'jdb "gud" "\ Run jdb with command line COMMAND-LINE in a buffer. The buffer is named \"*gud*\" if no initial class is given or @@ -12847,8 +12854,8 @@ it if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "gv" "emacs-lisp/gv.el" (21607 56058 801550 -;;;;;; 360000)) +;;;### (autoloads nil "gv" "emacs-lisp/gv.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from emacs-lisp/gv.el (autoload 'gv-get "gv" "\ @@ -12876,7 +12883,7 @@ all the parts of PLACE that can be evaluated and then runs E. \(fn (GETTER SETTER) PLACE &rest BODY)" nil t) -(put 'gv-letplace 'lisp-indent-function '2) +(function-put 'gv-letplace 'lisp-indent-function '2) (autoload 'gv-define-expander "gv" "\ Use HANDLER to handle NAME as a generalized var. @@ -12886,7 +12893,7 @@ arguments as NAME. DO is a function as defined in `gv-get'. \(fn NAME HANDLER)" nil t) -(put 'gv-define-expander 'lisp-indent-function '1) +(function-put 'gv-define-expander 'lisp-indent-function '1) (autoload 'gv--defun-declaration "gv" "\ @@ -12911,7 +12918,7 @@ to be pure and copyable. Example use: \(fn NAME ARGLIST &rest BODY)" nil t) -(put 'gv-define-setter 'lisp-indent-function '2) +(function-put 'gv-define-setter 'lisp-indent-function '2) (autoload 'gv-define-simple-setter "gv" "\ Define a simple setter method for generalized variable NAME. @@ -12950,8 +12957,8 @@ binding mode. ;;;*** -;;;### (autoloads nil "handwrite" "play/handwrite.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "handwrite" "play/handwrite.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from play/handwrite.el (autoload 'handwrite "handwrite" "\ @@ -12968,8 +12975,8 @@ Variables: `handwrite-linespace' (default 12) ;;;*** -;;;### (autoloads nil "hanoi" "play/hanoi.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "hanoi" "play/hanoi.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from play/hanoi.el (autoload 'hanoi "hanoi" "\ @@ -12996,8 +13003,8 @@ to be updated. ;;;*** -;;;### (autoloads nil "hashcash" "mail/hashcash.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "hashcash" "mail/hashcash.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from mail/hashcash.el (autoload 'hashcash-insert-payment "hashcash" "\ @@ -13039,8 +13046,8 @@ Prefix arg sets default accept amount temporarily. ;;;*** -;;;### (autoloads nil "help-at-pt" "help-at-pt.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "help-at-pt" "help-at-pt.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from help-at-pt.el (autoload 'help-at-pt-string "help-at-pt" "\ @@ -13167,8 +13174,8 @@ different regions. With numeric argument ARG, behaves like ;;;*** -;;;### (autoloads nil "help-fns" "help-fns.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "help-fns" "help-fns.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from help-fns.el (autoload 'describe-function "help-fns" "\ @@ -13247,8 +13254,8 @@ Produce a texinfo buffer with sorted doc-strings from the DOC file. ;;;*** -;;;### (autoloads nil "help-macro" "help-macro.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "help-macro" "help-macro.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from help-macro.el (defvar three-step-help nil "\ @@ -13262,8 +13269,8 @@ gives the window that lists the options.") ;;;*** -;;;### (autoloads nil "help-mode" "help-mode.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "help-mode" "help-mode.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from help-mode.el (autoload 'help-mode "help-mode" "\ @@ -13362,8 +13369,8 @@ BOOKMARK is a bookmark name or a bookmark record. ;;;*** -;;;### (autoloads nil "helper" "emacs-lisp/helper.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "helper" "emacs-lisp/helper.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from emacs-lisp/helper.el (autoload 'Helper-describe-bindings "helper" "\ @@ -13378,7 +13385,7 @@ Provide help for current mode. ;;;*** -;;;### (autoloads nil "hexl" "hexl.el" (21607 56024 801559 72000)) +;;;### (autoloads nil "hexl" "hexl.el" (21607 54478 300138 641000)) ;;; Generated autoloads from hexl.el (autoload 'hexl-mode "hexl" "\ @@ -13472,8 +13479,8 @@ This discards the buffer's undo information. ;;;*** -;;;### (autoloads nil "hi-lock" "hi-lock.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "hi-lock" "hi-lock.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from hi-lock.el (autoload 'hi-lock-mode "hi-lock" "\ @@ -13640,8 +13647,8 @@ be found in variable `hi-lock-interactive-patterns'. ;;;*** -;;;### (autoloads nil "hideif" "progmodes/hideif.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "hideif" "progmodes/hideif.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/hideif.el (autoload 'hide-ifdef-mode "hideif" "\ @@ -13656,27 +13663,31 @@ that the C preprocessor would eliminate may be hidden from view. Several variables affect how the hiding is done: `hide-ifdef-env' - An association list of defined and undefined symbols for the - current buffer. Initially, the global value of `hide-ifdef-env' - is used. + An association list of defined and undefined symbols for the + current project. Initially, the global value of `hide-ifdef-env' + is used. This variable was a buffer-local variable, which limits + hideif to parse only one C/C++ file at a time. We've extended + hideif to support parsing a C/C++ project containing multiple C/C++ + source files opened simultaneously in different buffers. Therefore + `hide-ifdef-env' can no longer be buffer local but must be global. `hide-ifdef-define-alist' - An association list of defined symbol lists. + An association list of defined symbol lists. Use `hide-ifdef-set-define-alist' to save the current `hide-ifdef-env' and `hide-ifdef-use-define-alist' to set the current `hide-ifdef-env' from one of the lists in `hide-ifdef-define-alist'. `hide-ifdef-lines' - Set to non-nil to not show #if, #ifdef, #ifndef, #else, and - #endif lines when hiding. + Set to non-nil to not show #if, #ifdef, #ifndef, #else, and + #endif lines when hiding. `hide-ifdef-initially' - Indicates whether `hide-ifdefs' should be called when Hide-Ifdef mode - is activated. + Indicates whether `hide-ifdefs' should be called when Hide-Ifdef mode + is activated. `hide-ifdef-read-only' - Set to non-nil if you want to make buffers read only while hiding. - After `show-ifdefs', read-only status is restored to previous value. + Set to non-nil if you want to make buffers read only while hiding. + After `show-ifdefs', read-only status is restored to previous value. \\{hide-ifdef-mode-map} @@ -13684,8 +13695,8 @@ Several variables affect how the hiding is done: ;;;*** -;;;### (autoloads nil "hideshow" "progmodes/hideshow.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "hideshow" "progmodes/hideshow.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/hideshow.el (defvar hs-special-modes-alist (mapcar 'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil))) "\ @@ -13747,8 +13758,8 @@ Unconditionally turn off `hs-minor-mode'. ;;;*** -;;;### (autoloads nil "hilit-chg" "hilit-chg.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "hilit-chg" "hilit-chg.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from hilit-chg.el (autoload 'highlight-changes-mode "hilit-chg" "\ @@ -13879,8 +13890,8 @@ See `highlight-changes-mode' for more information on Highlight-Changes mode. ;;;*** -;;;### (autoloads nil "hippie-exp" "hippie-exp.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "hippie-exp" "hippie-exp.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from hippie-exp.el (push (purecopy '(hippie-exp 1 6)) package--builtin-versions) @@ -13912,8 +13923,8 @@ argument VERBOSE non-nil makes the function verbose. ;;;*** -;;;### (autoloads nil "hl-line" "hl-line.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "hl-line" "hl-line.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from hl-line.el (autoload 'hl-line-mode "hl-line" "\ @@ -13962,12 +13973,10 @@ Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and ;;;*** -;;;### (autoloads nil "holidays" "calendar/holidays.el" (21607 56058 -;;;;;; 801550 360000)) +;;;### (autoloads nil "holidays" "calendar/holidays.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from calendar/holidays.el -(define-obsolete-variable-alias 'general-holidays 'holiday-general-holidays "23.1") - (defvar holiday-general-holidays (mapcar 'purecopy '((holiday-fixed 1 1 "New Year's Day") (holiday-float 1 1 3 "Martin Luther King Day") (holiday-fixed 2 2 "Groundhog Day") (holiday-fixed 2 14 "Valentine's Day") (holiday-float 2 1 3 "President's Day") (holiday-fixed 3 17 "St. Patrick's Day") (holiday-fixed 4 1 "April Fools' Day") (holiday-float 5 0 2 "Mother's Day") (holiday-float 5 1 -1 "Memorial Day") (holiday-fixed 6 14 "Flag Day") (holiday-float 6 0 3 "Father's Day") (holiday-fixed 7 4 "Independence Day") (holiday-float 9 1 1 "Labor Day") (holiday-float 10 1 2 "Columbus Day") (holiday-fixed 10 31 "Halloween") (holiday-fixed 11 11 "Veteran's Day") (holiday-float 11 4 4 "Thanksgiving"))) "\ General holidays. Default value is for the United States. See the documentation for `calendar-holidays' for details.") @@ -13976,8 +13985,6 @@ See the documentation for `calendar-holidays' for details.") (put 'holiday-general-holidays 'risky-local-variable t) -(define-obsolete-variable-alias 'oriental-holidays 'holiday-oriental-holidays "23.1") - (defvar holiday-oriental-holidays (mapcar 'purecopy '((holiday-chinese-new-year) (if calendar-chinese-all-holidays-flag (append (holiday-chinese 1 15 "Lantern Festival") (holiday-chinese-qingming) (holiday-chinese 5 5 "Dragon Boat Festival") (holiday-chinese 7 7 "Double Seventh Festival") (holiday-chinese 8 15 "Mid-Autumn Festival") (holiday-chinese 9 9 "Double Ninth Festival") (holiday-chinese-winter-solstice))))) "\ Oriental holidays. See the documentation for `calendar-holidays' for details.") @@ -13986,8 +13993,6 @@ See the documentation for `calendar-holidays' for details.") (put 'holiday-oriental-holidays 'risky-local-variable t) -(define-obsolete-variable-alias 'local-holidays 'holiday-local-holidays "23.1") - (defvar holiday-local-holidays nil "\ Local holidays. See the documentation for `calendar-holidays' for details.") @@ -13996,8 +14001,6 @@ See the documentation for `calendar-holidays' for details.") (put 'holiday-local-holidays 'risky-local-variable t) -(define-obsolete-variable-alias 'other-holidays 'holiday-other-holidays "23.1") - (defvar holiday-other-holidays nil "\ User defined holidays. See the documentation for `calendar-holidays' for details.") @@ -14006,28 +14009,6 @@ See the documentation for `calendar-holidays' for details.") (put 'holiday-other-holidays 'risky-local-variable t) -(defvar hebrew-holidays-1 (mapcar 'purecopy '((holiday-hebrew-rosh-hashanah) (if calendar-hebrew-all-holidays-flag (holiday-julian 11 (let ((m displayed-month) (y displayed-year) year) (calendar-increment-month m y -1) (setq year (calendar-extract-year (calendar-julian-from-absolute (calendar-absolute-from-gregorian (list m 1 y))))) (if (zerop (% (1+ year) 4)) 22 21)) "\"Tal Umatar\" (evening)")))) "\ -Component of the old default value of `holiday-hebrew-holidays'.") - -(put 'hebrew-holidays-1 'risky-local-variable t) - -(defvar hebrew-holidays-2 (mapcar 'purecopy '((holiday-hebrew-hanukkah) (if calendar-hebrew-all-holidays-flag (holiday-hebrew 10 (let ((h-year (calendar-extract-year (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian (list displayed-month 28 displayed-year)))))) (if (= 6 (% (calendar-hebrew-to-absolute (list 10 10 h-year)) 7)) 11 10)) "Tzom Teveth")) (if calendar-hebrew-all-holidays-flag (holiday-hebrew 11 15 "Tu B'Shevat")))) "\ -Component of the old default value of `holiday-hebrew-holidays'.") - -(put 'hebrew-holidays-2 'risky-local-variable t) - -(defvar hebrew-holidays-3 (mapcar 'purecopy '((if calendar-hebrew-all-holidays-flag (holiday-hebrew 11 (let* ((m displayed-month) (y displayed-year) (h-year (progn (calendar-increment-month m y 1) (calendar-extract-year (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian (list m (calendar-last-day-of-month m y) y)))))) (s-s (calendar-hebrew-from-absolute (if (= 6 (% (calendar-hebrew-to-absolute (list 7 1 h-year)) 7)) (calendar-dayname-on-or-before 6 (calendar-hebrew-to-absolute (list 11 17 h-year))) (calendar-dayname-on-or-before 6 (calendar-hebrew-to-absolute (list 11 16 h-year)))))) (day (calendar-extract-day s-s))) day) "Shabbat Shirah")))) "\ -Component of the old default value of `holiday-hebrew-holidays'.") - -(put 'hebrew-holidays-3 'risky-local-variable t) - -(defvar hebrew-holidays-4 (mapcar 'purecopy '((holiday-hebrew-passover) (and calendar-hebrew-all-holidays-flag (let* ((m displayed-month) (y displayed-year) (year (progn (calendar-increment-month m y -1) (calendar-extract-year (calendar-julian-from-absolute (calendar-absolute-from-gregorian (list m 1 y))))))) (= 21 (% year 28))) (holiday-julian 3 26 "Kiddush HaHamah")) (if calendar-hebrew-all-holidays-flag (holiday-hebrew-tisha-b-av)))) "\ -Component of the old default value of `holiday-hebrew-holidays'.") - -(put 'hebrew-holidays-4 'risky-local-variable t) - -(define-obsolete-variable-alias 'hebrew-holidays 'holiday-hebrew-holidays "23.1") - (defvar holiday-hebrew-holidays (mapcar 'purecopy '((holiday-hebrew-passover) (holiday-hebrew-rosh-hashanah) (holiday-hebrew-hanukkah) (if calendar-hebrew-all-holidays-flag (append (holiday-hebrew-tisha-b-av) (holiday-hebrew-misc))))) "\ Jewish holidays. See the documentation for `calendar-holidays' for details.") @@ -14036,8 +14017,6 @@ See the documentation for `calendar-holidays' for details.") (put 'holiday-hebrew-holidays 'risky-local-variable t) -(define-obsolete-variable-alias 'christian-holidays 'holiday-christian-holidays "23.1") - (defvar holiday-christian-holidays (mapcar 'purecopy '((holiday-easter-etc) (holiday-fixed 12 25 "Christmas") (if calendar-christian-all-holidays-flag (append (holiday-fixed 1 6 "Epiphany") (holiday-julian 12 25 "Christmas (Julian calendar)") (holiday-greek-orthodox-easter) (holiday-fixed 8 15 "Assumption") (holiday-advent 0 "Advent"))))) "\ Christian holidays. See the documentation for `calendar-holidays' for details.") @@ -14046,8 +14025,6 @@ See the documentation for `calendar-holidays' for details.") (put 'holiday-christian-holidays 'risky-local-variable t) -(define-obsolete-variable-alias 'islamic-holidays 'holiday-islamic-holidays "23.1") - (defvar holiday-islamic-holidays (mapcar 'purecopy '((holiday-islamic-new-year) (holiday-islamic 9 1 "Ramadan Begins") (if calendar-islamic-all-holidays-flag (append (holiday-islamic 1 10 "Ashura") (holiday-islamic 3 12 "Mulad-al-Nabi") (holiday-islamic 7 26 "Shab-e-Mi'raj") (holiday-islamic 8 15 "Shab-e-Bara't") (holiday-islamic 9 27 "Shab-e Qadr") (holiday-islamic 10 1 "Id-al-Fitr") (holiday-islamic 12 10 "Id-al-Adha"))))) "\ Islamic holidays. See the documentation for `calendar-holidays' for details.") @@ -14056,8 +14033,6 @@ See the documentation for `calendar-holidays' for details.") (put 'holiday-islamic-holidays 'risky-local-variable t) -(define-obsolete-variable-alias 'bahai-holidays 'holiday-bahai-holidays "23.1") - (defvar holiday-bahai-holidays (mapcar 'purecopy '((holiday-bahai-new-year) (holiday-bahai-ridvan) (holiday-fixed 5 23 "Declaration of the Báb") (holiday-fixed 5 29 "Ascension of Bahá'u'lláh") (holiday-fixed 7 9 "Martyrdom of the Báb") (holiday-fixed 10 20 "Birth of the Báb") (holiday-fixed 11 12 "Birth of Bahá'u'lláh") (if calendar-bahai-all-holidays-flag (append (holiday-fixed 11 26 "Day of the Covenant") (holiday-fixed 11 28 "Ascension of `Abdu'l-Bahá"))))) "\ Bahá'í holidays. See the documentation for `calendar-holidays' for details.") @@ -14066,8 +14041,6 @@ See the documentation for `calendar-holidays' for details.") (put 'holiday-bahai-holidays 'risky-local-variable t) -(define-obsolete-variable-alias 'solar-holidays 'holiday-solar-holidays "23.1") - (defvar holiday-solar-holidays (mapcar 'purecopy '((solar-equinoxes-solstices) (holiday-sexp calendar-daylight-savings-starts (format "Daylight Saving Time Begins %s" (solar-time-string (/ calendar-daylight-savings-starts-time (float 60)) calendar-standard-time-zone-name))) (holiday-sexp calendar-daylight-savings-ends (format "Daylight Saving Time Ends %s" (solar-time-string (/ calendar-daylight-savings-ends-time (float 60)) calendar-daylight-time-zone-name))))) "\ Sun-related holidays. See the documentation for `calendar-holidays' for details.") @@ -14111,8 +14084,8 @@ The optional LABEL is used to label the buffer created. ;;;*** -;;;### (autoloads nil "html2text" "gnus/html2text.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "html2text" "gnus/html2text.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/html2text.el (autoload 'html2text "html2text" "\ @@ -14122,8 +14095,8 @@ Convert HTML to plain text in the current buffer. ;;;*** -;;;### (autoloads nil "htmlfontify" "htmlfontify.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "htmlfontify" "htmlfontify.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from htmlfontify.el (push (purecopy '(htmlfontify 0 21)) package--builtin-versions) @@ -14156,8 +14129,8 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'. ;;;*** -;;;### (autoloads nil "ibuf-macs" "ibuf-macs.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "ibuf-macs" "ibuf-macs.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from ibuf-macs.el (autoload 'define-ibuffer-column "ibuf-macs" "\ @@ -14183,7 +14156,9 @@ inlined into the compiled format versions. This means that if you change its definition, you should explicitly call `ibuffer-recompile-formats'. -\(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)" nil (quote macro)) +\(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)" nil t) + +(function-put 'define-ibuffer-column 'lisp-indent-function 'defun) (autoload 'define-ibuffer-sorter "ibuf-macs" "\ Define a method of sorting named NAME. @@ -14195,7 +14170,11 @@ For sorting, the forms in BODY will be evaluated with `a' bound to one buffer object, and `b' bound to another. BODY should return a non-nil value if and only if `a' is \"less than\" `b'. -\(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" nil (quote macro)) +\(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" nil t) + +(function-put 'define-ibuffer-sorter 'lisp-indent-function '1) + +(function-put 'define-ibuffer-sorter 'doc-string-elt '2) (autoload 'define-ibuffer-op "ibuf-macs" "\ Generate a function which operates on a buffer. @@ -14228,7 +14207,11 @@ confirmation message, in the form: COMPLEX means this function is special; see the source code of this macro for exactly what it does. -\(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)" nil (quote macro)) +\(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)" nil t) + +(function-put 'define-ibuffer-op 'lisp-indent-function '2) + +(function-put 'define-ibuffer-op 'doc-string-elt '3) (autoload 'define-ibuffer-filter "ibuf-macs" "\ Define a filter named NAME. @@ -14241,12 +14224,16 @@ not a particular buffer should be displayed or not. The forms in BODY will be evaluated with BUF bound to the buffer object, and QUALIFIER bound to the current value of the filter. -\(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" nil (quote macro)) +\(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" nil t) + +(function-put 'define-ibuffer-filter 'lisp-indent-function '2) + +(function-put 'define-ibuffer-filter 'doc-string-elt '2) ;;;*** -;;;### (autoloads nil "ibuffer" "ibuffer.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "ibuffer" "ibuffer.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from ibuffer.el (autoload 'ibuffer-list-buffers "ibuffer" "\ @@ -14285,8 +14272,8 @@ FORMATS is the value to use for `ibuffer-formats'. ;;;*** -;;;### (autoloads nil "icalendar" "calendar/icalendar.el" (21607 -;;;;;; 56058 801550 360000)) +;;;### (autoloads nil "icalendar" "calendar/icalendar.el" (21611 +;;;;;; 10937 700236 3000)) ;;; Generated autoloads from calendar/icalendar.el (push (purecopy '(icalendar 0 19)) package--builtin-versions) @@ -14339,8 +14326,8 @@ buffer `*icalendar-errors*'. ;;;*** -;;;### (autoloads nil "icomplete" "icomplete.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "icomplete" "icomplete.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from icomplete.el (defvar icomplete-mode nil "\ @@ -14372,11 +14359,15 @@ completions: \\{icomplete-minibuffer-map} \(fn &optional ARG)" t nil) +(when (locate-library "obsolete/iswitchb") + (autoload 'iswitchb-mode "iswitchb" "Toggle Iswitchb mode." t) + (make-obsolete 'iswitchb-mode + "use `icomplete-mode' or `ido-mode' instead." "24.4")) ;;;*** -;;;### (autoloads nil "icon" "progmodes/icon.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "icon" "progmodes/icon.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from progmodes/icon.el (autoload 'icon-mode "icon" "\ @@ -14417,7 +14408,7 @@ with no args, if that value is non-nil. ;;;*** ;;;### (autoloads nil "idlw-shell" "progmodes/idlw-shell.el" (21607 -;;;;;; 56059 303525 127000)) +;;;;;; 54478 800121 42000)) ;;; Generated autoloads from progmodes/idlw-shell.el (autoload 'idlwave-shell "idlw-shell" "\ @@ -14442,8 +14433,8 @@ See also the variable `idlwave-shell-prompt-pattern'. ;;;*** -;;;### (autoloads nil "idlwave" "progmodes/idlwave.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "idlwave" "progmodes/idlwave.el" (21645 29117 +;;;;;; 170137 362000)) ;;; Generated autoloads from progmodes/idlwave.el (push (purecopy '(idlwave 6 1 22)) package--builtin-versions) @@ -14572,7 +14563,7 @@ The main features of this mode are ;;;*** -;;;### (autoloads nil "ido" "ido.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "ido" "ido.el" (21612 31801 50825 711000)) ;;; Generated autoloads from ido.el (defvar ido-mode nil "\ @@ -14834,7 +14825,7 @@ DEF, if non-nil, is the default value. ;;;*** -;;;### (autoloads nil "ielm" "ielm.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "ielm" "ielm.el" (21607 54478 300138 641000)) ;;; Generated autoloads from ielm.el (autoload 'ielm "ielm" "\ @@ -14846,7 +14837,7 @@ See `inferior-emacs-lisp-mode' for details. ;;;*** -;;;### (autoloads nil "iimage" "iimage.el" (21607 56024 801559 72000)) +;;;### (autoloads nil "iimage" "iimage.el" (21607 54478 300138 641000)) ;;; Generated autoloads from iimage.el (define-obsolete-function-alias 'turn-on-iimage-mode 'iimage-mode "24.1") @@ -14862,7 +14853,7 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. ;;;*** -;;;### (autoloads nil "image" "image.el" (21607 56024 801559 72000)) +;;;### (autoloads nil "image" "image.el" (21607 54478 300138 641000)) ;;; Generated autoloads from image.el (autoload 'image-type-from-data "image" "\ @@ -15037,7 +15028,7 @@ Example: \(fn SYMBOL SPECS &optional DOC)" nil t) -(put 'defimage 'doc-string-elt '3) +(function-put 'defimage 'doc-string-elt '3) (autoload 'imagemagick-register-types "image" "\ Register file types that can be handled by ImageMagick. @@ -15055,8 +15046,8 @@ If Emacs is compiled without ImageMagick support, this does nothing. ;;;*** -;;;### (autoloads nil "image-dired" "image-dired.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "image-dired" "image-dired.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from image-dired.el (push (purecopy '(image-dired 0 4 11)) package--builtin-versions) @@ -15193,8 +15184,8 @@ easy-to-use form. ;;;*** -;;;### (autoloads nil "image-file" "image-file.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "image-file" "image-file.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from image-file.el (defvar image-file-name-extensions (purecopy '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg")) "\ @@ -15256,8 +15247,8 @@ An image file is one whose name has an extension in ;;;*** -;;;### (autoloads nil "image-mode" "image-mode.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "image-mode" "image-mode.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from image-mode.el (autoload 'image-mode "image-mode" "\ @@ -15304,7 +15295,7 @@ on these modes. ;;;*** -;;;### (autoloads nil "imenu" "imenu.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "imenu" "imenu.el" (21607 54478 300138 641000)) ;;; Generated autoloads from imenu.el (defvar imenu-sort-function nil "\ @@ -15442,8 +15433,8 @@ for more information. ;;;*** -;;;### (autoloads nil "ind-util" "language/ind-util.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "ind-util" "language/ind-util.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from language/ind-util.el (autoload 'indian-compose-region "ind-util" "\ @@ -15473,8 +15464,8 @@ Convert old Emacs Devanagari characters to UCS. ;;;*** -;;;### (autoloads nil "inf-lisp" "progmodes/inf-lisp.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "inf-lisp" "progmodes/inf-lisp.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/inf-lisp.el (autoload 'inferior-lisp "inf-lisp" "\ @@ -15492,7 +15483,7 @@ of `inferior-lisp-program'). Runs the hooks from ;;;*** -;;;### (autoloads nil "info" "info.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "info" "info.el" (21669 11452 35624 425000)) ;;; Generated autoloads from info.el (defcustom Info-default-directory-list (let* ((config-dir (file-name-as-directory (or (and (featurep 'ns) (let ((dir (expand-file-name "../info" data-directory))) (if (file-directory-p dir) dir))) configure-info-directory))) (prefixes (prune-directory-list '("/usr/local/" "/usr/" "/opt/" "/"))) (suffixes '("share/" "" "gnu/" "gnu/lib/" "gnu/lib/emacs/" "emacs/" "lib/" "lib/emacs/")) (standard-info-dirs (apply #'nconc (mapcar (lambda (pfx) (let ((dirs (mapcar (lambda (sfx) (concat pfx sfx "info/")) suffixes))) (prune-directory-list dirs))) prefixes))) (dirs (if (member config-dir standard-info-dirs) (nconc standard-info-dirs (list config-dir)) (cons config-dir standard-info-dirs)))) (if (not (eq system-type 'windows-nt)) dirs (let* ((instdir (file-name-directory invocation-directory)) (dir1 (expand-file-name "../info/" instdir)) (dir2 (expand-file-name "../../../info/" instdir))) (cond ((file-exists-p dir1) (append dirs (list dir1))) ((file-exists-p dir2) (append dirs (list dir2))) (t dirs))))) "\ @@ -15696,14 +15687,16 @@ type returned by `Info-bookmark-make-record', which see. (autoload 'info-display-manual "info" "\ Display an Info buffer displaying MANUAL. If there is an existing Info buffer for MANUAL, display it. -Otherwise, visit the manual in a new Info buffer. +Otherwise, visit the manual in a new Info buffer. In interactive +use, a prefix argument directs this command to limit the +completion alternatives to currently visited manuals. \(fn MANUAL)" t nil) ;;;*** -;;;### (autoloads nil "info-look" "info-look.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "info-look" "info-look.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from info-look.el (autoload 'info-lookup-reset "info-look" "\ @@ -15750,8 +15743,8 @@ Perform completion on file preceding point. ;;;*** -;;;### (autoloads nil "info-xref" "info-xref.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "info-xref" "info-xref.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from info-xref.el (push (purecopy '(info-xref 3)) package--builtin-versions) @@ -15834,8 +15827,8 @@ the sources handy. ;;;*** -;;;### (autoloads nil "informat" "informat.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "informat" "informat.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from informat.el (autoload 'Info-tagify "informat" "\ @@ -15880,8 +15873,23 @@ For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\" ;;;*** -;;;### (autoloads nil "inversion" "cedet/inversion.el" (21607 56023 -;;;;;; 800854 237000)) +;;;### (autoloads nil "inline" "emacs-lisp/inline.el" (21632 17083 +;;;;;; 200835 890000)) +;;; Generated autoloads from emacs-lisp/inline.el + +(autoload 'define-inline "inline" "\ + + +\(fn NAME ARGS &rest BODY)" nil t) + +(function-put 'define-inline 'lisp-indent-function 'defun) + +(function-put 'define-inline 'doc-string-elt '3) + +;;;*** + +;;;### (autoloads nil "inversion" "cedet/inversion.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from cedet/inversion.el (push (purecopy '(inversion 1 3)) package--builtin-versions) @@ -15894,7 +15902,7 @@ Only checks one based on which kind of Emacs is being run. ;;;*** ;;;### (autoloads nil "isearch-x" "international/isearch-x.el" (21607 -;;;;;; 56024 801559 72000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from international/isearch-x.el (autoload 'isearch-toggle-specified-input-method "isearch-x" "\ @@ -15914,8 +15922,8 @@ Toggle input method in interactive search. ;;;*** -;;;### (autoloads nil "isearchb" "isearchb.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "isearchb" "isearchb.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from isearchb.el (push (purecopy '(isearchb 1 5)) package--builtin-versions) @@ -15930,7 +15938,7 @@ accessed via isearchb. ;;;*** ;;;### (autoloads nil "iso-cvt" "international/iso-cvt.el" (21607 -;;;;;; 56024 801559 72000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from international/iso-cvt.el (autoload 'iso-spanish "iso-cvt" "\ @@ -16021,15 +16029,15 @@ Add submenus to the File menu, to convert to and from various formats. ;;;*** ;;;### (autoloads nil "iso-transl" "international/iso-transl.el" -;;;;;; (21607 56024 801559 72000)) +;;;;;; (21607 54478 300138 641000)) ;;; Generated autoloads from international/iso-transl.el (define-key key-translation-map "\C-x8" 'iso-transl-ctl-x-8-map) (autoload 'iso-transl-ctl-x-8-map "iso-transl" "Keymap for C-x 8 prefix." t 'keymap) ;;;*** -;;;### (autoloads nil "ispell" "textmodes/ispell.el" (21607 56059 -;;;;;; 804396 982000)) +;;;### (autoloads nil "ispell" "textmodes/ispell.el" (21653 23227 +;;;;;; 760147 961000)) ;;; Generated autoloads from textmodes/ispell.el (put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t exclusive)))) @@ -16263,7 +16271,7 @@ You can bind this to the key C-c i in GNUS or mail by adding to ;;;*** ;;;### (autoloads nil "japan-util" "language/japan-util.el" (21607 -;;;;;; 56024 801559 72000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from language/japan-util.el (autoload 'setup-japanese-environment-internal "japan-util" "\ @@ -16340,8 +16348,8 @@ If non-nil, second arg INITIAL-INPUT is a string to insert before reading. ;;;*** -;;;### (autoloads nil "jka-compr" "jka-compr.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "jka-compr" "jka-compr.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from jka-compr.el (defvar jka-compr-inhibit nil "\ @@ -16364,8 +16372,7 @@ by `jka-compr-installed'. ;;;*** -;;;### (autoloads nil "js" "progmodes/js.el" (21609 59210 634406 -;;;;;; 998000)) +;;;### (autoloads nil "js" "progmodes/js.el" (21663 59071 96337 184000)) ;;; Generated autoloads from progmodes/js.el (push (purecopy '(js 9)) package--builtin-versions) @@ -16375,16 +16382,18 @@ Major mode for editing JavaScript. \(fn)" t nil) (defalias 'javascript-mode 'js-mode) +(dolist (name (list "node" "nodejs" "gjs" "rhino")) (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'js-mode))) + ;;;*** -;;;### (autoloads nil "json" "json.el" (21607 56024 801559 72000)) +;;;### (autoloads nil "json" "json.el" (21607 54478 300138 641000)) ;;; Generated autoloads from json.el (push (purecopy '(json 1 4)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "keypad" "emulation/keypad.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "keypad" "emulation/keypad.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from emulation/keypad.el (defvar keypad-setup nil "\ @@ -16440,7 +16449,7 @@ the decimal key on the keypad is mapped to DECIMAL instead of `.' ;;;*** ;;;### (autoloads nil "kinsoku" "international/kinsoku.el" (21607 -;;;;;; 56024 801559 72000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from international/kinsoku.el (autoload 'kinsoku "kinsoku" "\ @@ -16461,8 +16470,8 @@ the context of text formatting. ;;;*** -;;;### (autoloads nil "kkc" "international/kkc.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "kkc" "international/kkc.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from international/kkc.el (defvar kkc-after-update-conversion-functions nil "\ @@ -16484,7 +16493,7 @@ and the return value is the length of the conversion. ;;;*** -;;;### (autoloads nil "kmacro" "kmacro.el" (21607 56024 801559 72000)) +;;;### (autoloads nil "kmacro" "kmacro.el" (21607 54478 300138 641000)) ;;; Generated autoloads from kmacro.el (global-set-key "\C-x(" 'kmacro-start-macro) (global-set-key "\C-x)" 'kmacro-end-macro) @@ -16597,7 +16606,7 @@ If kbd macro currently being defined end it before activating it. ;;;*** ;;;### (autoloads nil "korea-util" "language/korea-util.el" (21607 -;;;;;; 56024 801559 72000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from language/korea-util.el (defvar default-korean-keyboard (purecopy (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) "3" "")) "\ @@ -16611,9 +16620,10 @@ The kind of Korean keyboard for Korean input method. ;;;*** -;;;### (autoloads nil "landmark" "play/landmark.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "landmark" "play/landmark.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from play/landmark.el +(push (purecopy '(landmark 1 0)) package--builtin-versions) (defalias 'landmark-repeat 'landmark-test-run) @@ -16642,8 +16652,8 @@ Use \\[describe-mode] for more info. ;;;*** -;;;### (autoloads nil "lao-util" "language/lao-util.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "lao-util" "language/lao-util.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from language/lao-util.el (autoload 'lao-compose-string "lao-util" "\ @@ -16681,7 +16691,7 @@ Transcribe Romanized Lao string STR to Lao character string. ;;;*** ;;;### (autoloads nil "latexenc" "international/latexenc.el" (21607 -;;;;;; 56024 801559 72000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from international/latexenc.el (defvar latex-inputenc-coding-alist (purecopy '(("ansinew" . windows-1252) ("applemac" . mac-roman) ("ascii" . us-ascii) ("cp1250" . windows-1250) ("cp1252" . windows-1252) ("cp1257" . cp1257) ("cp437de" . cp437) ("cp437" . cp437) ("cp850" . cp850) ("cp852" . cp852) ("cp858" . cp858) ("cp865" . cp865) ("latin1" . iso-8859-1) ("latin2" . iso-8859-2) ("latin3" . iso-8859-3) ("latin4" . iso-8859-4) ("latin5" . iso-8859-5) ("latin9" . iso-8859-15) ("next" . next) ("utf8" . utf-8) ("utf8x" . utf-8))) "\ @@ -16713,7 +16723,7 @@ coding system names is determined from `latex-inputenc-coding-alist'. ;;;*** ;;;### (autoloads nil "latin1-disp" "international/latin1-disp.el" -;;;;;; (21607 56024 801559 72000)) +;;;;;; (21607 54478 300138 641000)) ;;; Generated autoloads from international/latin1-disp.el (defvar latin1-display nil "\ @@ -16755,7 +16765,7 @@ use either \\[customize] or the function `latin1-display'.") ;;;*** ;;;### (autoloads nil "ld-script" "progmodes/ld-script.el" (21607 -;;;;;; 56025 301574 889000)) +;;;;;; 54478 800121 42000)) ;;; Generated autoloads from progmodes/ld-script.el (autoload 'ld-script-mode "ld-script" "\ @@ -16765,7 +16775,47 @@ A major mode to edit GNU ld script files ;;;*** -;;;### (autoloads nil "life" "play/life.el" (21607 56025 301574 889000)) +;;;### (autoloads nil "let-alist" "let-alist.el" (21661 17341 365638 +;;;;;; 429000)) +;;; Generated autoloads from let-alist.el +(push (purecopy '(let-alist 1 0 3)) package--builtin-versions) + +(autoload 'let-alist "let-alist" "\ +Let-bind dotted symbols to their cdrs in ALIST and execute BODY. +Dotted symbol is any symbol starting with a `.'. Only those present +in BODY are let-bound and this search is done at compile time. + +For instance, the following code + + (let-alist alist + (if (and .title .body) + .body + .site + .site.contents)) + +essentially expands to + + (let ((.title (cdr (assq 'title alist))) + (.body (cdr (assq 'body alist))) + (.site (cdr (assq 'site alist))) + (.site.contents (cdr (assq 'contents (cdr (assq 'site alist)))))) + (if (and .title .body) + .body + .site + .site.contents)) + +If you nest `let-alist' invocations, the inner one can't access +the variables of the outer one. You can, however, access alists +inside the original alist by using dots inside the symbol, as +displayed in the example above. + +\(fn ALIST &rest BODY)" nil t) + +(function-put 'let-alist 'lisp-indent-function '1) + +;;;*** + +;;;### (autoloads nil "life" "play/life.el" (21607 54478 800121 42000)) ;;; Generated autoloads from play/life.el (autoload 'life "life" "\ @@ -16778,7 +16828,7 @@ generations (this defaults to 1). ;;;*** -;;;### (autoloads nil "linum" "linum.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "linum" "linum.el" (21652 2366 414435 564000)) ;;; Generated autoloads from linum.el (push (purecopy '(linum 0 9 24)) package--builtin-versions) @@ -16815,8 +16865,8 @@ See `linum-mode' for more information on Linum mode. ;;;*** -;;;### (autoloads nil "loadhist" "loadhist.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "loadhist" "loadhist.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from loadhist.el (autoload 'unload-feature "loadhist" "\ @@ -16847,7 +16897,7 @@ something strange, such as redefining an Emacs function. ;;;*** -;;;### (autoloads nil "locate" "locate.el" (21607 56024 801559 72000)) +;;;### (autoloads nil "locate" "locate.el" (21607 54478 300138 641000)) ;;; Generated autoloads from locate.el (defvar locate-ls-subdir-switches (purecopy "-al") "\ @@ -16899,8 +16949,8 @@ except that FILTER is not optional. ;;;*** -;;;### (autoloads nil "log-edit" "vc/log-edit.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "log-edit" "vc/log-edit.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from vc/log-edit.el (autoload 'log-edit "log-edit" "\ @@ -16931,8 +16981,8 @@ done. Otherwise, it uses the current buffer. ;;;*** -;;;### (autoloads nil "log-view" "vc/log-view.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "log-view" "vc/log-view.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from vc/log-view.el (autoload 'log-view-mode "log-view" "\ @@ -16942,7 +16992,7 @@ Major mode for browsing CVS log output. ;;;*** -;;;### (autoloads nil "lpr" "lpr.el" (21607 56024 801559 72000)) +;;;### (autoloads nil "lpr" "lpr.el" (21607 54478 300138 641000)) ;;; Generated autoloads from lpr.el (defvar lpr-windows-system (memq system-type '(ms-dos windows-nt)) "\ @@ -17037,8 +17087,8 @@ for further customization of the printer command. ;;;*** -;;;### (autoloads nil "ls-lisp" "ls-lisp.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "ls-lisp" "ls-lisp.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from ls-lisp.el (defvar ls-lisp-support-shell-wildcards t "\ @@ -17049,8 +17099,8 @@ Otherwise they are treated as Emacs regexps (for backward compatibility).") ;;;*** -;;;### (autoloads nil "lunar" "calendar/lunar.el" (21607 56058 801550 -;;;;;; 360000)) +;;;### (autoloads nil "lunar" "calendar/lunar.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from calendar/lunar.el (autoload 'lunar-phases "lunar" "\ @@ -17060,12 +17110,10 @@ This function is suitable for execution in an init file. \(fn &optional ARG)" t nil) -(define-obsolete-function-alias 'phases-of-moon 'lunar-phases "23.1") - ;;;*** -;;;### (autoloads nil "m4-mode" "progmodes/m4-mode.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "m4-mode" "progmodes/m4-mode.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/m4-mode.el (autoload 'm4-mode "m4-mode" "\ @@ -17075,7 +17123,7 @@ A major mode to edit m4 macro files. ;;;*** -;;;### (autoloads nil "macros" "macros.el" (21607 56024 801559 72000)) +;;;### (autoloads nil "macros" "macros.el" (21607 54478 300138 641000)) ;;; Generated autoloads from macros.el (autoload 'name-last-kbd-macro "macros" "\ @@ -17164,8 +17212,8 @@ and then select the region of un-tablified names and use ;;;*** -;;;### (autoloads nil "mail-extr" "mail/mail-extr.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "mail-extr" "mail/mail-extr.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from mail/mail-extr.el (autoload 'mail-extract-address-components "mail-extr" "\ @@ -17195,8 +17243,8 @@ Convert mail domain DOMAIN to the country it corresponds to. ;;;*** -;;;### (autoloads nil "mail-hist" "mail/mail-hist.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "mail-hist" "mail/mail-hist.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from mail/mail-hist.el (autoload 'mail-hist-define-keys "mail-hist" "\ @@ -17225,8 +17273,8 @@ This function normally would be called when the message is sent. ;;;*** -;;;### (autoloads nil "mail-utils" "mail/mail-utils.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "mail-utils" "mail/mail-utils.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from mail/mail-utils.el (defvar mail-use-rfc822 nil "\ @@ -17300,8 +17348,8 @@ matches may be returned from the message body. ;;;*** -;;;### (autoloads nil "mailabbrev" "mail/mailabbrev.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "mailabbrev" "mail/mailabbrev.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from mail/mailabbrev.el (defvar mail-abbrevs-mode nil "\ @@ -17350,8 +17398,8 @@ double-quotes. ;;;*** -;;;### (autoloads nil "mailalias" "mail/mailalias.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "mailalias" "mail/mailalias.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from mail/mailalias.el (defvar mail-complete-style 'angles "\ @@ -17404,8 +17452,8 @@ current header, calls `mail-complete-function' and passes prefix ARG if any. ;;;*** -;;;### (autoloads nil "mailclient" "mail/mailclient.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "mailclient" "mail/mailclient.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from mail/mailclient.el (autoload 'mailclient-send-it "mailclient" "\ @@ -17418,7 +17466,7 @@ The mail client is taken to be the handler of mailto URLs. ;;;*** ;;;### (autoloads nil "make-mode" "progmodes/make-mode.el" (21607 -;;;;;; 56025 301574 889000)) +;;;;;; 54478 800121 42000)) ;;; Generated autoloads from progmodes/make-mode.el (autoload 'makefile-mode "make-mode" "\ @@ -17535,8 +17583,8 @@ An adapted `makefile-mode' that knows about imake. ;;;*** -;;;### (autoloads nil "makesum" "makesum.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "makesum" "makesum.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from makesum.el (autoload 'make-command-summary "makesum" "\ @@ -17547,19 +17595,21 @@ Previous contents of that buffer are killed first. ;;;*** -;;;### (autoloads nil "man" "man.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "man" "man.el" (21607 54478 300138 641000)) ;;; Generated autoloads from man.el (defalias 'manual-entry 'man) (autoload 'man "man" "\ Get a Un*x manual page and put it in a buffer. -This command is the top-level command in the man package. It -runs a Un*x command to retrieve and clean a manpage in the +This command is the top-level command in the man package. +It runs a Un*x command to retrieve and clean a manpage in the background and places the results in a `Man-mode' browsing -buffer. See variable `Man-notify-method' for what happens when -the buffer is ready. If a buffer already exists for this man -page, it will display immediately. +buffer. The variable `Man-width' defines the number of columns in +formatted manual pages. The buffer is displayed immediately. +The variable `Man-notify-method' defines how the buffer is displayed. +If a buffer already exists for this man page, it will be displayed +without running the man command. For a manpage from a particular section, use either of the following. \"cat(1)\" is how cross-references appear and is @@ -17601,7 +17651,7 @@ Default bookmark handler for Man buffers. ;;;*** -;;;### (autoloads nil "master" "master.el" (21607 56024 801559 72000)) +;;;### (autoloads nil "master" "master.el" (21607 54478 300138 641000)) ;;; Generated autoloads from master.el (push (purecopy '(master 1 0 2)) package--builtin-versions) @@ -17624,8 +17674,8 @@ yourself the value of `master-of' by calling `master-show-slave'. ;;;*** -;;;### (autoloads nil "mb-depth" "mb-depth.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "mb-depth" "mb-depth.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from mb-depth.el (defvar minibuffer-depth-indicate-mode nil "\ @@ -17652,14 +17702,14 @@ recursion depth in the minibuffer prompt. This is only useful if ;;;*** -;;;### (autoloads nil "md4" "md4.el" (21607 56024 801559 72000)) +;;;### (autoloads nil "md4" "md4.el" (21607 54478 300138 641000)) ;;; Generated autoloads from md4.el (push (purecopy '(md4 1 0)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "message" "gnus/message.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "message" "gnus/message.el" (21666 35265 825623 +;;;;;; 21000)) ;;; Generated autoloads from gnus/message.el (define-mail-user-agent 'message-user-agent 'message-mail 'message-send-and-exit 'message-kill-buffer 'message-send-hook) @@ -17825,7 +17875,7 @@ which specify the range to operate on. ;;;*** ;;;### (autoloads nil "meta-mode" "progmodes/meta-mode.el" (21607 -;;;;;; 56025 301574 889000)) +;;;;;; 54478 800121 42000)) ;;; Generated autoloads from progmodes/meta-mode.el (push (purecopy '(meta-mode 1 0)) package--builtin-versions) @@ -17841,8 +17891,8 @@ Major mode for editing MetaPost sources. ;;;*** -;;;### (autoloads nil "metamail" "mail/metamail.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "metamail" "mail/metamail.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from mail/metamail.el (autoload 'metamail-interpret-header "metamail" "\ @@ -17885,8 +17935,8 @@ redisplayed as output is inserted. ;;;*** -;;;### (autoloads nil "mh-comp" "mh-e/mh-comp.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "mh-comp" "mh-e/mh-comp.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from mh-e/mh-comp.el (autoload 'mh-smail "mh-comp" "\ @@ -17976,7 +18026,7 @@ delete the draft message. ;;;*** -;;;### (autoloads nil "mh-e" "mh-e/mh-e.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "mh-e" "mh-e/mh-e.el" (21607 54478 300138 641000)) ;;; Generated autoloads from mh-e/mh-e.el (push (purecopy '(mh-e 8 6)) package--builtin-versions) @@ -17993,8 +18043,8 @@ Display version information about MH-E and the MH mail handling system. ;;;*** -;;;### (autoloads nil "mh-folder" "mh-e/mh-folder.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "mh-folder" "mh-e/mh-folder.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from mh-e/mh-folder.el (autoload 'mh-rmail "mh-folder" "\ @@ -18075,8 +18125,8 @@ perform the operation on all messages in that region. ;;;*** -;;;### (autoloads nil "midnight" "midnight.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "midnight" "midnight.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from midnight.el (autoload 'clean-buffer-list "midnight" "\ @@ -18102,8 +18152,8 @@ to its second argument TM. ;;;*** -;;;### (autoloads nil "minibuf-eldef" "minibuf-eldef.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "minibuf-eldef" "minibuf-eldef.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from minibuf-eldef.el (defvar minibuffer-electric-default-mode nil "\ @@ -18132,7 +18182,7 @@ is modified to remove the default indication. ;;;*** -;;;### (autoloads nil "misc" "misc.el" (21607 56024 801559 72000)) +;;;### (autoloads nil "misc" "misc.el" (21607 54478 300138 641000)) ;;; Generated autoloads from misc.el (autoload 'butterfly "misc" "\ @@ -18160,8 +18210,8 @@ The return value is always nil. ;;;*** -;;;### (autoloads nil "misearch" "misearch.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "misearch" "misearch.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from misearch.el (add-hook 'isearch-mode-hook 'multi-isearch-setup) @@ -18196,6 +18246,10 @@ Isearch starts.") The buffer where the search is currently searching. The value is nil when the search still is in the initial buffer.") +(defvar multi-isearch-buffer-list nil) + +(defvar multi-isearch-file-list nil) + (autoload 'multi-isearch-setup "misearch" "\ Set up isearch to search multiple buffers. Intended to be added to `isearch-mode-hook'. @@ -18243,7 +18297,7 @@ whose file names match the specified wildcard. ;;;*** ;;;### (autoloads nil "mixal-mode" "progmodes/mixal-mode.el" (21607 -;;;;;; 56025 301574 889000)) +;;;;;; 54478 800121 42000)) ;;; Generated autoloads from progmodes/mixal-mode.el (push (purecopy '(mixal-mode 0 1)) package--builtin-versions) @@ -18254,8 +18308,8 @@ Major mode for the mixal asm language. ;;;*** -;;;### (autoloads nil "mm-encode" "gnus/mm-encode.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "mm-encode" "gnus/mm-encode.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/mm-encode.el (autoload 'mm-default-file-encoding "mm-encode" "\ @@ -18265,8 +18319,8 @@ Return a default encoding for FILE. ;;;*** -;;;### (autoloads nil "mm-extern" "gnus/mm-extern.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "mm-extern" "gnus/mm-extern.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/mm-extern.el (autoload 'mm-extern-cache-contents "mm-extern" "\ @@ -18284,8 +18338,8 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing. ;;;*** -;;;### (autoloads nil "mm-partial" "gnus/mm-partial.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "mm-partial" "gnus/mm-partial.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/mm-partial.el (autoload 'mm-inline-partial "mm-partial" "\ @@ -18298,8 +18352,8 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing. ;;;*** -;;;### (autoloads nil "mm-url" "gnus/mm-url.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "mm-url" "gnus/mm-url.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from gnus/mm-url.el (autoload 'mm-url-insert-file-contents "mm-url" "\ @@ -18315,8 +18369,8 @@ Insert file contents of URL using `mm-url-program'. ;;;*** -;;;### (autoloads nil "mm-uu" "gnus/mm-uu.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "mm-uu" "gnus/mm-uu.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from gnus/mm-uu.el (autoload 'mm-uu-dissect "mm-uu" "\ @@ -18335,7 +18389,7 @@ Assume text has been decoded if DECODED is non-nil. ;;;*** -;;;### (autoloads nil "mml" "gnus/mml.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "mml" "gnus/mml.el" (21607 54478 300138 641000)) ;;; Generated autoloads from gnus/mml.el (autoload 'mml-to-mime "mml" "\ @@ -18360,8 +18414,8 @@ body) or \"attachment\" (separate from the body). ;;;*** -;;;### (autoloads nil "mml1991" "gnus/mml1991.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "mml1991" "gnus/mml1991.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from gnus/mml1991.el (autoload 'mml1991-encrypt "mml1991" "\ @@ -18376,8 +18430,8 @@ body) or \"attachment\" (separate from the body). ;;;*** -;;;### (autoloads nil "mml2015" "gnus/mml2015.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "mml2015" "gnus/mml2015.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from gnus/mml2015.el (autoload 'mml2015-decrypt "mml2015" "\ @@ -18417,16 +18471,16 @@ body) or \"attachment\" (separate from the body). ;;;*** -;;;### (autoloads nil "mode-local" "cedet/mode-local.el" (21607 56023 -;;;;;; 800854 237000)) +;;;### (autoloads nil "mode-local" "cedet/mode-local.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from cedet/mode-local.el (put 'define-overloadable-function 'doc-string-elt 3) ;;;*** -;;;### (autoloads nil "modula2" "progmodes/modula2.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "modula2" "progmodes/modula2.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/modula2.el (defalias 'modula-2-mode 'm2-mode) @@ -18459,8 +18513,8 @@ followed by the first character of the construct. ;;;*** -;;;### (autoloads nil "morse" "play/morse.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "morse" "play/morse.el" (21616 28857 81577 +;;;;;; 239000)) ;;; Generated autoloads from play/morse.el (autoload 'morse-region "morse" "\ @@ -18485,8 +18539,8 @@ Convert NATO phonetic alphabet in region to ordinary ASCII text. ;;;*** -;;;### (autoloads nil "mouse-drag" "mouse-drag.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "mouse-drag" "mouse-drag.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from mouse-drag.el (autoload 'mouse-drag-throw "mouse-drag" "\ @@ -18533,7 +18587,7 @@ To test this function, evaluate: ;;;*** -;;;### (autoloads nil "mpc" "mpc.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "mpc" "mpc.el" (21607 54478 300138 641000)) ;;; Generated autoloads from mpc.el (autoload 'mpc "mpc" "\ @@ -18543,7 +18597,7 @@ Main entry point for MPC. ;;;*** -;;;### (autoloads nil "mpuz" "play/mpuz.el" (21607 56025 301574 889000)) +;;;### (autoloads nil "mpuz" "play/mpuz.el" (21607 54478 800121 42000)) ;;; Generated autoloads from play/mpuz.el (autoload 'mpuz "mpuz" "\ @@ -18553,7 +18607,7 @@ Multiplication puzzle with GNU Emacs. ;;;*** -;;;### (autoloads nil "msb" "msb.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "msb" "msb.el" (21607 54478 300138 641000)) ;;; Generated autoloads from msb.el (defvar msb-mode nil "\ @@ -18578,8 +18632,8 @@ different buffer menu using the function `msb'. ;;;*** -;;;### (autoloads nil "mule-diag" "international/mule-diag.el" (21607 -;;;;;; 56024 801559 72000)) +;;;### (autoloads nil "mule-diag" "international/mule-diag.el" (21652 +;;;;;; 2366 414435 564000)) ;;; Generated autoloads from international/mule-diag.el (autoload 'list-character-sets "mule-diag" "\ @@ -18712,7 +18766,7 @@ The default is 20. If LIMIT is negative, do not limit the listing. ;;;*** ;;;### (autoloads nil "mule-util" "international/mule-util.el" (21607 -;;;;;; 56059 303525 127000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from international/mule-util.el (defsubst string-to-list (string) "\ @@ -18748,7 +18802,7 @@ If ELLIPSIS is non-nil, it should be a string which will replace the end of STR (including any padding) if it extends beyond END-COLUMN, unless the display width of STR is equal to or less than the display width of ELLIPSIS. If it is non-nil and not a string, then ELLIPSIS -defaults to \"...\". +defaults to `truncate-string-ellipsis'. \(fn STR END-COLUMN &optional START-COLUMN PADDING ELLIPSIS)" nil nil) @@ -18843,8 +18897,8 @@ per-character basis, this may not be accurate. ;;;*** -;;;### (autoloads nil "net-utils" "net/net-utils.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "net-utils" "net/net-utils.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from net/net-utils.el (autoload 'ifconfig "net-utils" "\ @@ -18938,8 +18992,8 @@ Open a network connection to HOST on PORT. ;;;*** -;;;### (autoloads nil "netrc" "net/netrc.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "netrc" "net/netrc.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from net/netrc.el (autoload 'netrc-credentials "netrc" "\ @@ -18951,8 +19005,8 @@ listed in the PORTS list. ;;;*** -;;;### (autoloads nil "network-stream" "net/network-stream.el" (21607 -;;;;;; 56025 301574 889000)) +;;;### (autoloads nil "network-stream" "net/network-stream.el" (21644 +;;;;;; 8251 830117 252000)) ;;; Generated autoloads from net/network-stream.el (autoload 'open-network-stream "network-stream" "\ @@ -19033,11 +19087,14 @@ values: :use-starttls-if-possible is a boolean that says to do opportunistic STARTTLS upgrades even if Emacs doesn't have built-in TLS functionality. +:warn-unless-encrypted is a boolean which, if :return-list is +non-nil, is used warn the user if the connection isn't encrypted. + :nogreeting is a boolean that can be used to inhibit waiting for a greeting from the server. :nowait is a boolean that says the connection should be made - asynchronously, if possible. +asynchronously, if possible. \(fn NAME BUFFER HOST SERVICE &rest PARAMETERS)" nil nil) @@ -19045,8 +19102,8 @@ a greeting from the server. ;;;*** -;;;### (autoloads nil "newst-backend" "net/newst-backend.el" (21607 -;;;;;; 56059 303525 127000)) +;;;### (autoloads nil "newst-backend" "net/newst-backend.el" (21628 +;;;;;; 45530 160140 360000)) ;;; Generated autoloads from net/newst-backend.el (autoload 'newsticker-running-p "newst-backend" "\ @@ -19068,7 +19125,7 @@ Run `newsticker-start-hook' if newsticker was not running already. ;;;*** ;;;### (autoloads nil "newst-plainview" "net/newst-plainview.el" -;;;;;; (21607 56059 303525 127000)) +;;;;;; (21607 54478 300138 641000)) ;;; Generated autoloads from net/newst-plainview.el (autoload 'newsticker-plainview "newst-plainview" "\ @@ -19079,7 +19136,7 @@ Start newsticker plainview. ;;;*** ;;;### (autoloads nil "newst-reader" "net/newst-reader.el" (21607 -;;;;;; 56059 303525 127000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from net/newst-reader.el (autoload 'newsticker-show-news "newst-reader" "\ @@ -19090,7 +19147,7 @@ Start reading news. You may want to bind this to a key. ;;;*** ;;;### (autoloads nil "newst-ticker" "net/newst-ticker.el" (21607 -;;;;;; 56059 303525 127000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from net/newst-ticker.el (autoload 'newsticker-ticker-running-p "newst-ticker" "\ @@ -19110,8 +19167,8 @@ running already. ;;;*** -;;;### (autoloads nil "newst-treeview" "net/newst-treeview.el" (21607 -;;;;;; 56059 303525 127000)) +;;;### (autoloads nil "newst-treeview" "net/newst-treeview.el" (21636 +;;;;;; 14149 750837 46000)) ;;; Generated autoloads from net/newst-treeview.el (autoload 'newsticker-treeview "newst-treeview" "\ @@ -19121,15 +19178,8 @@ Start newsticker treeview. ;;;*** -;;;### (autoloads nil "newsticker" "net/newsticker.el" (21607 56059 -;;;;;; 303525 127000)) -;;; Generated autoloads from net/newsticker.el -(push (purecopy '(newsticker 1 99)) package--builtin-versions) - -;;;*** - -;;;### (autoloads nil "nndiary" "gnus/nndiary.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "nndiary" "gnus/nndiary.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from gnus/nndiary.el (autoload 'nndiary-generate-nov-databases "nndiary" "\ @@ -19139,8 +19189,8 @@ Generate NOV databases in all nndiary directories. ;;;*** -;;;### (autoloads nil "nndoc" "gnus/nndoc.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "nndoc" "gnus/nndoc.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from gnus/nndoc.el (autoload 'nndoc-add-type "nndoc" "\ @@ -19154,8 +19204,8 @@ symbol in the alist. ;;;*** -;;;### (autoloads nil "nnfolder" "gnus/nnfolder.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "nnfolder" "gnus/nnfolder.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/nnfolder.el (autoload 'nnfolder-generate-active-file "nnfolder" "\ @@ -19166,7 +19216,7 @@ This command does not work if you use short group names. ;;;*** -;;;### (autoloads nil "nnml" "gnus/nnml.el" (21607 56024 801559 72000)) +;;;### (autoloads nil "nnml" "gnus/nnml.el" (21607 54478 300138 641000)) ;;; Generated autoloads from gnus/nnml.el (autoload 'nnml-generate-nov-databases "nnml" "\ @@ -19176,7 +19226,7 @@ Generate NOV databases in all nnml directories. ;;;*** -;;;### (autoloads nil "novice" "novice.el" (21607 56025 301574 889000)) +;;;### (autoloads nil "novice" "novice.el" (21607 54478 300138 641000)) ;;; Generated autoloads from novice.el (define-obsolete-variable-alias 'disabled-command-hook 'disabled-command-function "22.1") @@ -19209,7 +19259,7 @@ future sessions. ;;;*** ;;;### (autoloads nil "nroff-mode" "textmodes/nroff-mode.el" (21607 -;;;;;; 56025 801549 101000)) +;;;;;; 54478 800121 42000)) ;;; Generated autoloads from textmodes/nroff-mode.el (autoload 'nroff-mode "nroff-mode" "\ @@ -19223,14 +19273,14 @@ closing requests for requests that are used in matched pairs. ;;;*** -;;;### (autoloads nil "ntlm" "net/ntlm.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "ntlm" "net/ntlm.el" (21607 54478 300138 641000)) ;;; Generated autoloads from net/ntlm.el (push (purecopy '(ntlm 1 0)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "nxml-glyph" "nxml/nxml-glyph.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "nxml-glyph" "nxml/nxml-glyph.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from nxml/nxml-glyph.el (autoload 'nxml-glyph-display-string "nxml-glyph" "\ @@ -19242,8 +19292,8 @@ Return nil if the face cannot display a glyph for N. ;;;*** -;;;### (autoloads nil "nxml-mode" "nxml/nxml-mode.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "nxml-mode" "nxml/nxml-mode.el" (21611 10937 +;;;;;; 700236 3000)) ;;; Generated autoloads from nxml/nxml-mode.el (autoload 'nxml-mode "nxml-mode" "\ @@ -19303,8 +19353,8 @@ Many aspects this mode can be customized using ;;;*** -;;;### (autoloads nil "nxml-uchnm" "nxml/nxml-uchnm.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "nxml-uchnm" "nxml/nxml-uchnm.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from nxml/nxml-uchnm.el (autoload 'nxml-enable-unicode-char-name-sets "nxml-uchnm" "\ @@ -19316,8 +19366,8 @@ the variable `nxml-enabled-unicode-blocks'. ;;;*** -;;;### (autoloads nil "octave" "progmodes/octave.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "octave" "progmodes/octave.el" (21632 17083 +;;;;;; 200835 890000)) ;;; Generated autoloads from progmodes/octave.el (autoload 'octave-mode "octave" "\ @@ -19354,8 +19404,8 @@ startup file, `~/.emacs-octave'. ;;;*** -;;;### (autoloads nil "opascal" "progmodes/opascal.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "opascal" "progmodes/opascal.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/opascal.el (define-obsolete-function-alias 'delphi-mode 'opascal-mode "24.4") @@ -19390,7 +19440,7 @@ Coloring: ;;;*** -;;;### (autoloads nil "org" "org/org.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "org" "org/org.el" (21645 29117 170137 362000)) ;;; Generated autoloads from org/org.el (autoload 'org-babel-do-load-languages "org" "\ @@ -19611,8 +19661,8 @@ Call the customize function with org as argument. ;;;*** -;;;### (autoloads nil "org-agenda" "org/org-agenda.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "org-agenda" "org/org-agenda.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from org/org-agenda.el (autoload 'org-toggle-sticky-agenda "org-agenda" "\ @@ -19885,8 +19935,8 @@ to override `appt-message-warning-time'. ;;;*** -;;;### (autoloads nil "org-capture" "org/org-capture.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "org-capture" "org/org-capture.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from org/org-capture.el (autoload 'org-capture-string "org-capture" "\ @@ -19928,8 +19978,8 @@ Set `org-capture-templates' to be similar to `org-remember-templates'. ;;;*** -;;;### (autoloads nil "org-colview" "org/org-colview.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "org-colview" "org/org-colview.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from org/org-colview.el (autoload 'org-columns-remove-overlays "org-colview" "\ @@ -19992,8 +20042,8 @@ Turn on or update column view in the agenda. ;;;*** -;;;### (autoloads nil "org-compat" "org/org-compat.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "org-compat" "org/org-compat.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from org/org-compat.el (autoload 'org-check-version "org-compat" "\ @@ -20003,8 +20053,8 @@ Try very hard to provide sensible version strings. ;;;*** -;;;### (autoloads nil "org-macs" "org/org-macs.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "org-macs" "org/org-macs.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from org/org-macs.el (autoload 'org-load-noerror-mustsuffix "org-macs" "\ @@ -20014,8 +20064,8 @@ Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX a ;;;*** -;;;### (autoloads nil "org-version" "org/org-version.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "org-version" "org/org-version.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from org/org-version.el (autoload 'org-release "org-version" "\ @@ -20032,7 +20082,8 @@ The Git version of org-mode. ;;;*** -;;;### (autoloads nil "outline" "outline.el" (21623 5708 80843 798000)) +;;;### (autoloads nil "outline" "outline.el" (21626 64704 823711 +;;;;;; 579000)) ;;; Generated autoloads from outline.el (put 'outline-regexp 'safe-local-variable 'stringp) (put 'outline-heading-end-regexp 'safe-local-variable 'stringp) @@ -20093,8 +20144,8 @@ See the command `outline-mode' for more information on this mode. ;;;*** -;;;### (autoloads nil "package" "emacs-lisp/package.el" (21607 56058 -;;;;;; 801550 360000)) +;;;### (autoloads nil "package" "emacs-lisp/package.el" (21652 2365 +;;;;;; 910127 752000)) ;;; Generated autoloads from emacs-lisp/package.el (push (purecopy '(package 1 0 1)) package--builtin-versions) @@ -20166,7 +20217,7 @@ The list is displayed in a buffer named `*Packages*'. ;;;*** -;;;### (autoloads nil "paren" "paren.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "paren" "paren.el" (21607 54478 800121 42000)) ;;; Generated autoloads from paren.el (defvar show-paren-mode nil "\ @@ -20193,7 +20244,7 @@ matching parenthesis is highlighted in `show-paren-style' after ;;;*** ;;;### (autoloads nil "parse-time" "calendar/parse-time.el" (21607 -;;;;;; 56058 801550 360000)) +;;;;;; 54477 800124 118000)) ;;; Generated autoloads from calendar/parse-time.el (put 'parse-time-rules 'risky-local-variable t) @@ -20206,8 +20257,8 @@ unknown are returned as nil. ;;;*** -;;;### (autoloads nil "pascal" "progmodes/pascal.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "pascal" "progmodes/pascal.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/pascal.el (autoload 'pascal-mode "pascal" "\ @@ -20257,7 +20308,7 @@ See also the user variables `pascal-type-keywords', `pascal-start-keywords' and ;;;*** ;;;### (autoloads nil "password-cache" "password-cache.el" (21607 -;;;;;; 56025 301574 889000)) +;;;;;; 54478 800121 42000)) ;;; Generated autoloads from password-cache.el (defvar password-cache t "\ @@ -20278,8 +20329,8 @@ Check if KEY is in the cache. ;;;*** -;;;### (autoloads nil "pcase" "emacs-lisp/pcase.el" (21607 56058 -;;;;;; 801550 360000)) +;;;### (autoloads nil "pcase" "emacs-lisp/pcase.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from emacs-lisp/pcase.el (autoload 'pcase "pcase" "\ @@ -20292,33 +20343,45 @@ UPatterns can take the following forms: SYMBOL matches anything and binds it to SYMBOL. (or UPAT...) matches if any of the patterns matches. (and UPAT...) matches if all the patterns match. + 'VAL matches if the object is `equal' to VAL `QPAT matches if the QPattern QPAT matches. - (pred PRED) matches if PRED applied to the object returns non-nil. + (pred FUN) matches if FUN applied to the object returns non-nil. (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. (let UPAT EXP) matches if EXP matches UPAT. + (app FUN UPAT) matches if FUN applied to the object matches UPAT. If a SYMBOL is used twice in the same pattern (i.e. the pattern is \"non-linear\"), then the second occurrence is turned into an `eq'uality test. QPatterns can take the following forms: - (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. - ,UPAT matches if the UPattern UPAT matches. - STRING matches if the object is `equal' to STRING. - ATOM matches if the object is `eq' to ATOM. -QPatterns for vectors are not implemented yet. - -PRED can take the form - FUNCTION in which case it gets called with one argument. - (FUN ARG1 .. ARGN) in which case it gets called with an N+1'th argument + (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. + [QPAT1 QPAT2..QPATn] matches a vector of length n and QPAT1..QPATn match + its 0..(n-1)th elements, respectively. + ,UPAT matches if the UPattern UPAT matches. + STRING matches if the object is `equal' to STRING. + ATOM matches if the object is `eq' to ATOM. + +FUN can take the form + SYMBOL or (lambda ARGS BODY) in which case it's called with one argument. + (F ARG1 .. ARGn) in which case F gets called with an n+1'th argument which is the value being matched. -A PRED of the form FUNCTION is equivalent to one of the form (FUNCTION). -PRED patterns can refer to variables bound earlier in the pattern. +So a FUN of the form SYMBOL is equivalent to one of the form (FUN). +FUN can refer to variables bound earlier in the pattern. +FUN is assumed to be pure, i.e. it can be dropped if its result is not used, +and two identical calls can be merged into one. E.g. you can match pairs where the cdr is larger than the car with a pattern like `(,a . ,(pred (< a))) or, with more checks: `(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a)))) \(fn EXP &rest CASES)" nil t) -(put 'pcase 'lisp-indent-function '1) +(function-put 'pcase 'lisp-indent-function '1) + +(autoload 'pcase-exhaustive "pcase" "\ +The exhaustive version of `pcase' (which see). + +\(fn EXP &rest CASES)" nil t) + +(function-put 'pcase-exhaustive 'lisp-indent-function '1) (autoload 'pcase-let* "pcase" "\ Like `let*' but where you can use `pcase' patterns for bindings. @@ -20327,7 +20390,7 @@ of the form (UPAT EXP). \(fn BINDINGS &rest BODY)" nil t) -(put 'pcase-let* 'lisp-indent-function '1) +(function-put 'pcase-let* 'lisp-indent-function '1) (autoload 'pcase-let "pcase" "\ Like `let' but where you can use `pcase' patterns for bindings. @@ -20336,12 +20399,21 @@ of the form (UPAT EXP). \(fn BINDINGS &rest BODY)" nil t) -(put 'pcase-let 'lisp-indent-function '1) +(function-put 'pcase-let 'lisp-indent-function '1) + +(autoload 'pcase-defmacro "pcase" "\ +Define a pcase UPattern macro. + +\(fn NAME ARGS &rest BODY)" nil t) + +(function-put 'pcase-defmacro 'lisp-indent-function '2) + +(function-put 'pcase-defmacro 'doc-string-elt '3) ;;;*** -;;;### (autoloads nil "pcmpl-cvs" "pcmpl-cvs.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "pcmpl-cvs" "pcmpl-cvs.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from pcmpl-cvs.el (autoload 'pcomplete/cvs "pcmpl-cvs" "\ @@ -20351,8 +20423,8 @@ Completion rules for the `cvs' command. ;;;*** -;;;### (autoloads nil "pcmpl-gnu" "pcmpl-gnu.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "pcmpl-gnu" "pcmpl-gnu.el" (21632 17083 200835 +;;;;;; 890000)) ;;; Generated autoloads from pcmpl-gnu.el (autoload 'pcomplete/gzip "pcmpl-gnu" "\ @@ -20379,8 +20451,8 @@ Completion for the GNU tar utility. ;;;*** -;;;### (autoloads nil "pcmpl-linux" "pcmpl-linux.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "pcmpl-linux" "pcmpl-linux.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from pcmpl-linux.el (autoload 'pcomplete/kill "pcmpl-linux" "\ @@ -20400,8 +20472,8 @@ Completion for GNU/Linux `mount'. ;;;*** -;;;### (autoloads nil "pcmpl-rpm" "pcmpl-rpm.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "pcmpl-rpm" "pcmpl-rpm.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from pcmpl-rpm.el (autoload 'pcomplete/rpm "pcmpl-rpm" "\ @@ -20411,8 +20483,8 @@ Completion for the `rpm' command. ;;;*** -;;;### (autoloads nil "pcmpl-unix" "pcmpl-unix.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "pcmpl-unix" "pcmpl-unix.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from pcmpl-unix.el (autoload 'pcomplete/cd "pcmpl-unix" "\ @@ -20467,8 +20539,8 @@ Includes files as well as host names followed by a colon. ;;;*** -;;;### (autoloads nil "pcmpl-x" "pcmpl-x.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "pcmpl-x" "pcmpl-x.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from pcmpl-x.el (autoload 'pcomplete/tlmgr "pcmpl-x" "\ @@ -20492,8 +20564,8 @@ Completion for the `ag' command. ;;;*** -;;;### (autoloads nil "pcomplete" "pcomplete.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "pcomplete" "pcomplete.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from pcomplete.el (autoload 'pcomplete "pcomplete" "\ @@ -20550,7 +20622,7 @@ Setup `shell-mode' to use pcomplete. ;;;*** -;;;### (autoloads nil "pcvs" "vc/pcvs.el" (21607 56025 801549 101000)) +;;;### (autoloads nil "pcvs" "vc/pcvs.el" (21607 54478 800121 42000)) ;;; Generated autoloads from vc/pcvs.el (autoload 'cvs-checkout "pcvs" "\ @@ -20625,8 +20697,8 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp d ;;;*** -;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from vc/pcvs-defs.el (defvar cvs-global-menu (let ((m (make-sparse-keymap "PCL-CVS"))) (define-key m [status] `(menu-item ,(purecopy "Directory Status") cvs-status :help ,(purecopy "A more verbose status of a workarea"))) (define-key m [checkout] `(menu-item ,(purecopy "Checkout Module") cvs-checkout :help ,(purecopy "Check out a module from the repository"))) (define-key m [update] `(menu-item ,(purecopy "Update Directory") cvs-update :help ,(purecopy "Fetch updates from the repository"))) (define-key m [examine] `(menu-item ,(purecopy "Examine Directory") cvs-examine :help ,(purecopy "Examine the current state of a workarea"))) (fset 'cvs-global-menu m)) "\ @@ -20635,7 +20707,7 @@ Global menu used by PCL-CVS.") ;;;*** ;;;### (autoloads nil "perl-mode" "progmodes/perl-mode.el" (21607 -;;;;;; 56059 303525 127000)) +;;;;;; 54478 800121 42000)) ;;; Generated autoloads from progmodes/perl-mode.el (put 'perl-indent-level 'safe-local-variable 'integerp) (put 'perl-continued-statement-offset 'safe-local-variable 'integerp) @@ -20696,8 +20768,8 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'. ;;;*** -;;;### (autoloads nil "picture" "textmodes/picture.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "picture" "textmodes/picture.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from textmodes/picture.el (autoload 'picture-mode "picture" "\ @@ -20777,8 +20849,8 @@ they are not by default assigned to keys. ;;;*** -;;;### (autoloads nil "plstore" "gnus/plstore.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "plstore" "gnus/plstore.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from gnus/plstore.el (autoload 'plstore-open "plstore" "\ @@ -20793,8 +20865,8 @@ Major mode for editing PLSTORE files. ;;;*** -;;;### (autoloads nil "po" "textmodes/po.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "po" "textmodes/po.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from textmodes/po.el (autoload 'po-find-file-coding-system "po" "\ @@ -20805,7 +20877,7 @@ Called through `file-coding-system-alist', before the file is visited for real. ;;;*** -;;;### (autoloads nil "pong" "play/pong.el" (21607 56025 301574 889000)) +;;;### (autoloads nil "pong" "play/pong.el" (21607 54478 800121 42000)) ;;; Generated autoloads from play/pong.el (autoload 'pong "pong" "\ @@ -20821,7 +20893,7 @@ pong-mode keybindings:\\<pong-mode-map> ;;;*** -;;;### (autoloads nil "pop3" "gnus/pop3.el" (21607 56024 801559 72000)) +;;;### (autoloads nil "pop3" "gnus/pop3.el" (21619 5051 260148 536000)) ;;; Generated autoloads from gnus/pop3.el (autoload 'pop3-movemail "pop3" "\ @@ -20832,8 +20904,8 @@ Use streaming commands. ;;;*** -;;;### (autoloads nil "pp" "emacs-lisp/pp.el" (21607 56058 801550 -;;;;;; 360000)) +;;;### (autoloads nil "pp" "emacs-lisp/pp.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from emacs-lisp/pp.el (autoload 'pp-to-string "pp" "\ @@ -20883,8 +20955,8 @@ Ignores leading comment characters. ;;;*** -;;;### (autoloads nil "printing" "printing.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "printing" "printing.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from printing.el (push (purecopy '(printing 6 9 3)) package--builtin-versions) @@ -21472,7 +21544,7 @@ are both set to t. ;;;*** -;;;### (autoloads nil "proced" "proced.el" (21607 56025 301574 889000)) +;;;### (autoloads nil "proced" "proced.el" (21609 55608 852266 580000)) ;;; Generated autoloads from proced.el (autoload 'proced "proced" "\ @@ -21490,8 +21562,8 @@ Proced buffers. ;;;*** -;;;### (autoloads nil "profiler" "profiler.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "profiler" "profiler.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from profiler.el (autoload 'profiler-start "profiler" "\ @@ -21519,8 +21591,8 @@ Open profile FILENAME. ;;;*** -;;;### (autoloads nil "prolog" "progmodes/prolog.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "prolog" "progmodes/prolog.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/prolog.el (autoload 'prolog-mode "prolog" "\ @@ -21553,7 +21625,7 @@ With prefix argument ARG, restart the Prolog process if running before. ;;;*** -;;;### (autoloads nil "ps-bdf" "ps-bdf.el" (21607 56025 801549 101000)) +;;;### (autoloads nil "ps-bdf" "ps-bdf.el" (21607 54478 800121 42000)) ;;; Generated autoloads from ps-bdf.el (defvar bdf-directory-list (if (memq system-type '(ms-dos windows-nt)) (list (expand-file-name "fonts/bdf" installation-directory)) '("/usr/local/share/emacs/fonts/bdf")) "\ @@ -21564,8 +21636,8 @@ The default value is '(\"/usr/local/share/emacs/fonts/bdf\").") ;;;*** -;;;### (autoloads nil "ps-mode" "progmodes/ps-mode.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "ps-mode" "progmodes/ps-mode.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/ps-mode.el (push (purecopy '(ps-mode 1 1 9)) package--builtin-versions) @@ -21577,7 +21649,6 @@ Entry to this mode calls `ps-mode-hook'. The following variables hold user options, and can be set through the `customize' command: - `ps-mode-auto-indent' `ps-mode-tab' `ps-mode-paper-size' `ps-mode-print-function' @@ -21612,8 +21683,8 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number ;;;*** -;;;### (autoloads nil "ps-print" "ps-print.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "ps-print" "ps-print.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from ps-print.el (push (purecopy '(ps-print 7 3 5)) package--builtin-versions) @@ -21810,15 +21881,15 @@ If EXTENSION is any other symbol, it is ignored. ;;;*** -;;;### (autoloads nil "pulse" "cedet/pulse.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "pulse" "cedet/pulse.el" (21638 55899 942254 +;;;;;; 689000)) ;;; Generated autoloads from cedet/pulse.el (push (purecopy '(pulse 1 0)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "python" "progmodes/python.el" (21627 2757 -;;;;;; 110119 58000)) +;;;### (autoloads nil "python" "progmodes/python.el" (21663 59071 +;;;;;; 96337 184000)) ;;; Generated autoloads from progmodes/python.el (push (purecopy '(python 0 24 4)) package--builtin-versions) @@ -21828,20 +21899,23 @@ If EXTENSION is any other symbol, it is ignored. (autoload 'run-python "python" "\ Run an inferior Python process. -Input and output via buffer named after -`python-shell-buffer-name'. If there is a process already -running in that buffer, just switch to it. -With argument, allows you to define CMD so you can edit the -command used to call the interpreter and define DEDICATED, so a -dedicated process for the current buffer is open. When numeric -prefix arg is other than 0 or 4 do not SHOW. +Argument CMD defaults to `python-shell-calculate-command' return +value. When called interactively with `prefix-arg', it allows +the user to edit such value and choose whether the interpreter +should be DEDICATED for the current buffer. When numeric prefix +arg is other than 0 or 4 do not SHOW. + +For a given buffer and same values of DEDICATED, if a process is +already running for it, it will do nothing. This means that if +the current buffer is using a global process, the user is still +able to switch it to use a dedicated one. Runs the hook `inferior-python-mode-hook' after `comint-mode-hook' is run. (Type \\[describe-mode] in the process buffer for a list of commands.) -\(fn CMD &optional DEDICATED SHOW)" t nil) +\(fn &optional CMD DEDICATED SHOW)" t nil) (autoload 'python-mode "python" "\ Major mode for editing Python files. @@ -21852,7 +21926,7 @@ Major mode for editing Python files. ;;;*** -;;;### (autoloads nil "qp" "gnus/qp.el" (21607 56024 801559 72000)) +;;;### (autoloads nil "qp" "gnus/qp.el" (21607 54478 300138 641000)) ;;; Generated autoloads from gnus/qp.el (autoload 'quoted-printable-decode-region "qp" "\ @@ -21871,8 +21945,8 @@ them into characters should be done separately. ;;;*** -;;;### (autoloads nil "quail" "international/quail.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "quail" "international/quail.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from international/quail.el (autoload 'quail-title "quail" "\ @@ -22103,7 +22177,7 @@ of each directory. ;;;*** ;;;### (autoloads nil "quail/hangul" "leim/quail/hangul.el" (21607 -;;;;;; 56024 801559 72000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from leim/quail/hangul.el (autoload 'hangul-input-method-activate "quail/hangul" "\ @@ -22116,7 +22190,7 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'. ;;;*** ;;;### (autoloads nil "quail/uni-input" "leim/quail/uni-input.el" -;;;;;; (21607 56024 801559 72000)) +;;;;;; (21607 54478 300138 641000)) ;;; Generated autoloads from leim/quail/uni-input.el (autoload 'ucs-input-activate "quail/uni-input" "\ @@ -22130,8 +22204,8 @@ While this input method is active, the variable ;;;*** -;;;### (autoloads nil "quickurl" "net/quickurl.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "quickurl" "net/quickurl.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from net/quickurl.el (defconst quickurl-reread-hook-postfix "\n;; Local Variables:\n;; eval: (progn (require 'quickurl) (add-hook 'local-write-file-hooks (lambda () (quickurl-read) nil)))\n;; End:\n" "\ @@ -22202,8 +22276,8 @@ Display `quickurl-list' as a formatted list using `quickurl-list-mode'. ;;;*** -;;;### (autoloads nil "rcirc" "net/rcirc.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "rcirc" "net/rcirc.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from net/rcirc.el (autoload 'rcirc "rcirc" "\ @@ -22242,7 +22316,7 @@ if ARG is omitted or nil. ;;;*** ;;;### (autoloads nil "re-builder" "emacs-lisp/re-builder.el" (21607 -;;;;;; 56024 300834 853000)) +;;;;;; 54477 800124 118000)) ;;; Generated autoloads from emacs-lisp/re-builder.el (defalias 'regexp-builder 're-builder) @@ -22260,8 +22334,8 @@ matching parts of the target buffer will be highlighted. ;;;*** -;;;### (autoloads nil "recentf" "recentf.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "recentf" "recentf.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from recentf.el (defvar recentf-mode nil "\ @@ -22287,7 +22361,7 @@ were operated on recently. ;;;*** -;;;### (autoloads nil "rect" "rect.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "rect" "rect.el" (21607 54478 800121 42000)) ;;; Generated autoloads from rect.el (autoload 'delete-rectangle "rect" "\ @@ -22427,8 +22501,8 @@ Activates the region if needed. Only lasts until the region is deactivated. ;;;*** -;;;### (autoloads nil "refill" "textmodes/refill.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "refill" "textmodes/refill.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from textmodes/refill.el (autoload 'refill-mode "refill" "\ @@ -22448,9 +22522,13 @@ For true \"word wrap\" behavior, use `visual-line-mode' instead. ;;;*** -;;;### (autoloads nil "reftex" "textmodes/reftex.el" (21607 56059 -;;;;;; 804396 982000)) +;;;### (autoloads nil "reftex" "textmodes/reftex.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from textmodes/reftex.el +(autoload 'reftex-citation "reftex-cite" nil t) +(autoload 'reftex-all-document-files "reftex-parse") +(autoload 'reftex-isearch-minor-mode "reftex-global" nil t) +(autoload 'reftex-index-phrases-mode "reftex-index" nil t) (autoload 'turn-on-reftex "reftex" "\ Turn on RefTeX mode. @@ -22498,101 +22576,8 @@ This enforces rescanning the buffer on next use. ;;;*** -;;;### (autoloads nil "reftex-cite" "textmodes/reftex-cite.el" (21607 -;;;;;; 56059 804396 982000)) -;;; Generated autoloads from textmodes/reftex-cite.el - -(autoload 'reftex-citation "reftex-cite" "\ -Make a citation using BibTeX database files. -After prompting for a regular expression, scans the buffers with -bibtex entries (taken from the \\bibliography command) and offers the -matching entries for selection. The selected entry is formatted according -to `reftex-cite-format' and inserted into the buffer. - -If NO-INSERT is non-nil, nothing is inserted, only the selected key returned. - -FORMAT-KEY can be used to pre-select a citation format. - -When called with a `C-u' prefix, prompt for optional arguments in -cite macros. When called with a numeric prefix, make that many -citations. When called with point inside the braces of a `\\cite' -command, it will add another key, ignoring the value of -`reftex-cite-format'. - -The regular expression uses an expanded syntax: && is interpreted as `and'. -Thus, `aaaa&&bbb' matches entries which contain both `aaaa' and `bbb'. -While entering the regexp, completion on knows citation keys is possible. -`=' is a good regular expression to match all entries in all files. - -\(fn &optional NO-INSERT FORMAT-KEY)" t nil) - -;;;*** - -;;;### (autoloads nil "reftex-global" "textmodes/reftex-global.el" -;;;;;; (21607 56059 804396 982000)) -;;; Generated autoloads from textmodes/reftex-global.el - -(autoload 'reftex-isearch-minor-mode "reftex-global" "\ -When on, isearch searches the whole document, not only the current file. -This minor mode allows isearch to search through all the files of -the current TeX document. - -With no argument, this command toggles -`reftex-isearch-minor-mode'. With a prefix argument ARG, turn -`reftex-isearch-minor-mode' on if ARG is positive, otherwise turn it off. - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads nil "reftex-index" "textmodes/reftex-index.el" -;;;;;; (21607 56059 804396 982000)) -;;; Generated autoloads from textmodes/reftex-index.el - -(autoload 'reftex-index-phrases-mode "reftex-index" "\ -Major mode for managing the Index phrases of a LaTeX document. -This buffer was created with RefTeX. - -To insert new phrases, use - - `C-c \\' in the LaTeX document to copy selection or word - - `\\[reftex-index-new-phrase]' in the phrases buffer. - -To index phrases use one of: - -\\[reftex-index-this-phrase] index current phrase -\\[reftex-index-next-phrase] index next phrase (or N with prefix arg) -\\[reftex-index-all-phrases] index all phrases -\\[reftex-index-remaining-phrases] index current and following phrases -\\[reftex-index-region-phrases] index the phrases in the region - -You can sort the phrases in this buffer with \\[reftex-index-sort-phrases]. -To display information about the phrase at point, use \\[reftex-index-phrases-info]. - -For more information see the RefTeX User Manual. - -Here are all local bindings. - -\\{reftex-index-phrases-mode-map} - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil "reftex-parse" "textmodes/reftex-parse.el" -;;;;;; (21623 5708 80843 798000)) -;;; Generated autoloads from textmodes/reftex-parse.el - -(autoload 'reftex-all-document-files "reftex-parse" "\ -Return a list of all files belonging to the current document. -When RELATIVE is non-nil, give file names relative to directory -of master file. - -\(fn &optional RELATIVE)" nil nil) - -;;;*** - ;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (21607 -;;;;;; 56025 801549 101000)) +;;;;;; 54478 800121 42000)) ;;; Generated autoloads from textmodes/reftex-vars.el (put 'reftex-vref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x)))) (put 'reftex-fref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x)))) @@ -22602,7 +22587,7 @@ of master file. ;;;*** ;;;### (autoloads nil "regexp-opt" "emacs-lisp/regexp-opt.el" (21607 -;;;;;; 56058 801550 360000)) +;;;;;; 54477 800124 118000)) ;;; Generated autoloads from emacs-lisp/regexp-opt.el (autoload 'regexp-opt "regexp-opt" "\ @@ -22631,15 +22616,15 @@ This means the number of non-shy regexp grouping constructs ;;;*** -;;;### (autoloads nil "regi" "emacs-lisp/regi.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "regi" "emacs-lisp/regi.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from emacs-lisp/regi.el (push (purecopy '(regi 1 8)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "remember" "textmodes/remember.el" (21607 56059 -;;;;;; 804396 982000)) +;;;### (autoloads nil "remember" "textmodes/remember.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from textmodes/remember.el (push (purecopy '(remember 2 0)) package--builtin-versions) @@ -22693,7 +22678,7 @@ to turn the *scratch* buffer into your notes buffer. ;;;*** -;;;### (autoloads nil "repeat" "repeat.el" (21607 56025 801549 101000)) +;;;### (autoloads nil "repeat" "repeat.el" (21607 54478 800121 42000)) ;;; Generated autoloads from repeat.el (push (purecopy '(repeat 0 51)) package--builtin-versions) @@ -22716,8 +22701,8 @@ recently executed command not bound to an input event\". ;;;*** -;;;### (autoloads nil "reporter" "mail/reporter.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "reporter" "mail/reporter.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from mail/reporter.el (autoload 'reporter-submit-bug-report "reporter" "\ @@ -22748,8 +22733,8 @@ mail-sending package is used for editing and sending the message. ;;;*** -;;;### (autoloads nil "reposition" "reposition.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "reposition" "reposition.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from reposition.el (autoload 'reposition-window "reposition" "\ @@ -22775,7 +22760,7 @@ first comment line visible (if point is in a comment). ;;;*** -;;;### (autoloads nil "reveal" "reveal.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "reveal" "reveal.el" (21607 54478 800121 42000)) ;;; Generated autoloads from reveal.el (autoload 'reveal-mode "reveal" "\ @@ -22810,8 +22795,8 @@ the mode if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "ring" "emacs-lisp/ring.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "ring" "emacs-lisp/ring.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from emacs-lisp/ring.el (autoload 'ring-p "ring" "\ @@ -22826,8 +22811,8 @@ Make a ring that can contain SIZE elements. ;;;*** -;;;### (autoloads nil "rlogin" "net/rlogin.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "rlogin" "net/rlogin.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from net/rlogin.el (autoload 'rlogin "rlogin" "\ @@ -22871,8 +22856,8 @@ variable. ;;;*** -;;;### (autoloads nil "rmail" "mail/rmail.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "rmail" "mail/rmail.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from mail/rmail.el (defvar rmail-file-name (purecopy "~/RMAIL") "\ @@ -23069,8 +23054,8 @@ Set PASSWORD to be used for retrieving mail from a POP or IMAP server. ;;;*** -;;;### (autoloads nil "rmailout" "mail/rmailout.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "rmailout" "mail/rmailout.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from mail/rmailout.el (put 'rmail-output-file-alist 'risky-local-variable t) @@ -23134,8 +23119,8 @@ than appending to it. Deletes the message after writing if ;;;*** -;;;### (autoloads nil "rng-cmpct" "nxml/rng-cmpct.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "rng-cmpct" "nxml/rng-cmpct.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from nxml/rng-cmpct.el (autoload 'rng-c-load-schema "rng-cmpct" "\ @@ -23146,8 +23131,8 @@ Return a pattern. ;;;*** -;;;### (autoloads nil "rng-nxml" "nxml/rng-nxml.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "rng-nxml" "nxml/rng-nxml.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from nxml/rng-nxml.el (autoload 'rng-nxml-mode-init "rng-nxml" "\ @@ -23159,8 +23144,8 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil. ;;;*** -;;;### (autoloads nil "rng-valid" "nxml/rng-valid.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "rng-valid" "nxml/rng-valid.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from nxml/rng-valid.el (autoload 'rng-validate-mode "rng-valid" "\ @@ -23190,8 +23175,8 @@ to use for finding the schema. ;;;*** -;;;### (autoloads nil "rng-xsd" "nxml/rng-xsd.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "rng-xsd" "nxml/rng-xsd.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from nxml/rng-xsd.el (put 'http://www\.w3\.org/2001/XMLSchema-datatypes 'rng-dt-compile 'rng-xsd-compile) @@ -23218,8 +23203,8 @@ must be equal. ;;;*** -;;;### (autoloads nil "robin" "international/robin.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "robin" "international/robin.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from international/robin.el (autoload 'robin-define-package "robin" "\ @@ -23251,7 +23236,7 @@ Start using robin package NAME, which is a string. ;;;*** -;;;### (autoloads nil "rot13" "rot13.el" (21607 56025 801549 101000)) +;;;### (autoloads nil "rot13" "rot13.el" (21607 54478 800121 42000)) ;;; Generated autoloads from rot13.el (autoload 'rot13 "rot13" "\ @@ -23288,8 +23273,8 @@ Toggle the use of ROT13 encoding for the current window. ;;;*** -;;;### (autoloads nil "rst" "textmodes/rst.el" (21607 56059 804396 -;;;;;; 982000)) +;;;### (autoloads nil "rst" "textmodes/rst.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from textmodes/rst.el (add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode))) @@ -23319,8 +23304,8 @@ for modes derived from Text mode, like Mail mode. ;;;*** -;;;### (autoloads nil "ruby-mode" "progmodes/ruby-mode.el" (21607 -;;;;;; 56025 801549 101000)) +;;;### (autoloads nil "ruby-mode" "progmodes/ruby-mode.el" (21657 +;;;;;; 20283 330825 807000)) ;;; Generated autoloads from progmodes/ruby-mode.el (push (purecopy '(ruby-mode 1 2)) package--builtin-versions) @@ -23331,14 +23316,14 @@ Major mode for editing Ruby code. \(fn)" t nil) -(add-to-list 'auto-mode-alist (cons (purecopy (concat "\\(?:\\." "rb\\|ru\\|rake\\|thor" "\\|jbuilder\\|gemspec\\|podspec" "\\|/" "\\(?:Gem\\|Rake\\|Cap\\|Thor" "\\|Vagrant\\|Guard\\|Pod\\)file" "\\)\\'")) 'ruby-mode)) +(add-to-list 'auto-mode-alist (cons (purecopy (concat "\\(?:\\." "rb\\|ru\\|rake\\|thor" "\\|jbuilder\\|rabl\\|gemspec\\|podspec" "\\|/" "\\(?:Gem\\|Rake\\|Cap\\|Thor" "\\|Puppet\\|Berks" "\\|Vagrant\\|Guard\\|Pod\\)file" "\\)\\'")) 'ruby-mode)) (dolist (name (list "ruby" "rbx" "jruby" "ruby1.9" "ruby1.8")) (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'ruby-mode))) ;;;*** -;;;### (autoloads nil "ruler-mode" "ruler-mode.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "ruler-mode" "ruler-mode.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from ruler-mode.el (push (purecopy '(ruler-mode 1 6)) package--builtin-versions) @@ -23356,8 +23341,8 @@ if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "rx" "emacs-lisp/rx.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "rx" "emacs-lisp/rx.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from emacs-lisp/rx.el (autoload 'rx-to-string "rx" "\ @@ -23668,15 +23653,15 @@ enclosed in `(and ...)'. ;;;*** -;;;### (autoloads nil "sasl-ntlm" "net/sasl-ntlm.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "sasl-ntlm" "net/sasl-ntlm.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from net/sasl-ntlm.el (push (purecopy '(sasl 1 0)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "savehist" "savehist.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "savehist" "savehist.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from savehist.el (push (purecopy '(savehist 24)) package--builtin-versions) @@ -23708,8 +23693,8 @@ histories, which is probably undesirable. ;;;*** -;;;### (autoloads nil "scheme" "progmodes/scheme.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "scheme" "progmodes/scheme.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/scheme.el (autoload 'scheme-mode "scheme" "\ @@ -23748,8 +23733,8 @@ that variable's value is a string. ;;;*** -;;;### (autoloads nil "score-mode" "gnus/score-mode.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "score-mode" "gnus/score-mode.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/score-mode.el (autoload 'gnus-score-mode "score-mode" "\ @@ -23762,8 +23747,8 @@ This mode is an extended emacs-lisp mode. ;;;*** -;;;### (autoloads nil "scroll-all" "scroll-all.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "scroll-all" "scroll-all.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from scroll-all.el (defvar scroll-all-mode nil "\ @@ -23788,8 +23773,8 @@ one window apply to all visible windows in the same frame. ;;;*** -;;;### (autoloads nil "scroll-lock" "scroll-lock.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "scroll-lock" "scroll-lock.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from scroll-lock.el (autoload 'scroll-lock-mode "scroll-lock" "\ @@ -23805,16 +23790,16 @@ vertically fixed relative to window boundaries during scrolling. ;;;*** -;;;### (autoloads nil "secrets" "net/secrets.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "secrets" "net/secrets.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from net/secrets.el (when (featurep 'dbusbind) (autoload 'secrets-show-secrets "secrets" nil t)) ;;;*** -;;;### (autoloads nil "semantic" "cedet/semantic.el" (21607 56058 -;;;;;; 801550 360000)) +;;;### (autoloads nil "semantic" "cedet/semantic.el" (21645 29116 +;;;;;; 670141 789000)) ;;; Generated autoloads from cedet/semantic.el (push (purecopy '(semantic 2 2)) package--builtin-versions) @@ -23872,7 +23857,7 @@ Semantic mode. ;;;*** ;;;### (autoloads nil "semantic/bovine/grammar" "cedet/semantic/bovine/grammar.el" -;;;;;; (21607 56058 801550 360000)) +;;;;;; (21607 54477 800124 118000)) ;;; Generated autoloads from cedet/semantic/bovine/grammar.el (autoload 'bovine-grammar-mode "semantic/bovine/grammar" "\ @@ -23883,7 +23868,7 @@ Major mode for editing Bovine grammars. ;;;*** ;;;### (autoloads nil "semantic/wisent/grammar" "cedet/semantic/wisent/grammar.el" -;;;;;; (21607 56023 800854 237000)) +;;;;;; (21607 54477 800124 118000)) ;;; Generated autoloads from cedet/semantic/wisent/grammar.el (autoload 'wisent-grammar-mode "semantic/wisent/grammar" "\ @@ -23893,8 +23878,8 @@ Major mode for editing Wisent grammars. ;;;*** -;;;### (autoloads nil "sendmail" "mail/sendmail.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "sendmail" "mail/sendmail.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from mail/sendmail.el (defvar mail-from-style 'default "\ @@ -24175,7 +24160,14 @@ Like `mail' command, but display mail buffer in another frame. ;;;*** -;;;### (autoloads nil "server" "server.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "seq" "emacs-lisp/seq.el" (21649 26173 700491 +;;;;;; 498000)) +;;; Generated autoloads from emacs-lisp/seq.el +(push (purecopy '(seq 1 0)) package--builtin-versions) + +;;;*** + +;;;### (autoloads nil "server" "server.el" (21607 54478 800121 42000)) ;;; Generated autoloads from server.el (put 'server-host 'risky-local-variable t) @@ -24242,7 +24234,7 @@ only these files will be asked to be saved. ;;;*** -;;;### (autoloads nil "ses" "ses.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "ses" "ses.el" (21607 54478 800121 42000)) ;;; Generated autoloads from ses.el (autoload 'ses-mode "ses" "\ @@ -24286,8 +24278,8 @@ formula: ;;;*** -;;;### (autoloads nil "sgml-mode" "textmodes/sgml-mode.el" (21607 -;;;;;; 56059 804396 982000)) +;;;### (autoloads nil "sgml-mode" "textmodes/sgml-mode.el" (21623 +;;;;;; 2108 292281 129000)) ;;; Generated autoloads from textmodes/sgml-mode.el (autoload 'sgml-mode "sgml-mode" "\ @@ -24352,8 +24344,8 @@ To work around that, do: ;;;*** -;;;### (autoloads nil "sh-script" "progmodes/sh-script.el" (21607 -;;;;;; 56059 303525 127000)) +;;;### (autoloads nil "sh-script" "progmodes/sh-script.el" (21663 +;;;;;; 59071 96337 184000)) ;;; Generated autoloads from progmodes/sh-script.el (push (purecopy '(sh-script 2 0 6)) package--builtin-versions) (put 'sh-shell 'safe-local-variable 'symbolp) @@ -24417,8 +24409,8 @@ with your script for an edit-interpret-debug cycle. ;;;*** -;;;### (autoloads nil "shadow" "emacs-lisp/shadow.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "shadow" "emacs-lisp/shadow.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from emacs-lisp/shadow.el (autoload 'list-load-path-shadows "shadow" "\ @@ -24467,8 +24459,8 @@ function, `load-path-shadows-find'. ;;;*** -;;;### (autoloads nil "shadowfile" "shadowfile.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "shadowfile" "shadowfile.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from shadowfile.el (autoload 'shadow-define-cluster "shadowfile" "\ @@ -24506,7 +24498,7 @@ Set up file shadowing. ;;;*** -;;;### (autoloads nil "shell" "shell.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "shell" "shell.el" (21658 41149 155622 310000)) ;;; Generated autoloads from shell.el (defvar shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") "\ @@ -24554,7 +24546,7 @@ Otherwise, one argument `-i' is passed to the shell. ;;;*** -;;;### (autoloads nil "shr" "net/shr.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "shr" "net/shr.el" (21666 35265 825623 21000)) ;;; Generated autoloads from net/shr.el (autoload 'shr-render-region "shr" "\ @@ -24571,8 +24563,8 @@ DOM should be a parse tree as generated by ;;;*** -;;;### (autoloads nil "sieve" "gnus/sieve.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "sieve" "gnus/sieve.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from gnus/sieve.el (autoload 'sieve-manage "sieve" "\ @@ -24597,8 +24589,8 @@ DOM should be a parse tree as generated by ;;;*** -;;;### (autoloads nil "sieve-mode" "gnus/sieve-mode.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "sieve-mode" "gnus/sieve-mode.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/sieve-mode.el (autoload 'sieve-mode "sieve-mode" "\ @@ -24613,8 +24605,8 @@ Turning on Sieve mode runs `sieve-mode-hook'. ;;;*** -;;;### (autoloads nil "simula" "progmodes/simula.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "simula" "progmodes/simula.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/simula.el (autoload 'simula-mode "simula" "\ @@ -24662,8 +24654,8 @@ with no arguments, if that value is non-nil. ;;;*** -;;;### (autoloads nil "skeleton" "skeleton.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "skeleton" "skeleton.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from skeleton.el (defvar skeleton-filter-function 'identity "\ @@ -24676,7 +24668,7 @@ SKELETON is as defined under `skeleton-insert'. \(fn COMMAND DOCUMENTATION &rest SKELETON)" nil t) -(put 'define-skeleton 'doc-string-elt '2) +(function-put 'define-skeleton 'doc-string-elt '2) (autoload 'skeleton-proxy-new "skeleton" "\ Insert SKELETON. @@ -24781,8 +24773,8 @@ symmetrical ones, and the same character twice for the others. ;;;*** -;;;### (autoloads nil "smerge-mode" "vc/smerge-mode.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "smerge-mode" "vc/smerge-mode.el" (21628 45530 +;;;;;; 160140 360000)) ;;; Generated autoloads from vc/smerge-mode.el (autoload 'smerge-ediff "smerge-mode" "\ @@ -24809,8 +24801,8 @@ If no conflict maker is found, turn off `smerge-mode'. ;;;*** -;;;### (autoloads nil "smiley" "gnus/smiley.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "smiley" "gnus/smiley.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from gnus/smiley.el (autoload 'smiley-region "smiley" "\ @@ -24827,8 +24819,8 @@ interactively. If there's no argument, do it at the current buffer. ;;;*** -;;;### (autoloads nil "smtpmail" "mail/smtpmail.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "smtpmail" "mail/smtpmail.el" (21619 5051 260148 +;;;;;; 536000)) ;;; Generated autoloads from mail/smtpmail.el (autoload 'smtpmail-send-it "smtpmail" "\ @@ -24843,8 +24835,8 @@ Send mail that was queued as a result of setting `smtpmail-queue-mail'. ;;;*** -;;;### (autoloads nil "snake" "play/snake.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "snake" "play/snake.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from play/snake.el (autoload 'snake "snake" "\ @@ -24867,8 +24859,8 @@ Snake mode keybindings: ;;;*** -;;;### (autoloads nil "snmp-mode" "net/snmp-mode.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "snmp-mode" "net/snmp-mode.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from net/snmp-mode.el (autoload 'snmp-mode "snmp-mode" "\ @@ -24897,8 +24889,8 @@ then `snmpv2-mode-hook'. ;;;*** -;;;### (autoloads nil "solar" "calendar/solar.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "solar" "calendar/solar.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from calendar/solar.el (autoload 'sunrise-sunset "solar" "\ @@ -24913,8 +24905,8 @@ This function is suitable for execution in an init file. ;;;*** -;;;### (autoloads nil "solitaire" "play/solitaire.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "solitaire" "play/solitaire.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from play/solitaire.el (autoload 'solitaire "solitaire" "\ @@ -24989,7 +24981,7 @@ Pick your favorite shortcuts: ;;;*** -;;;### (autoloads nil "sort" "sort.el" (21607 56025 801549 101000)) +;;;### (autoloads nil "sort" "sort.el" (21607 54478 800121 42000)) ;;; Generated autoloads from sort.el (put 'sort-fold-case 'safe-local-variable 'booleanp) @@ -25164,7 +25156,7 @@ is non-nil, it also prints a message describing the number of deletions. ;;;*** -;;;### (autoloads nil "spam" "gnus/spam.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "spam" "gnus/spam.el" (21607 54478 300138 641000)) ;;; Generated autoloads from gnus/spam.el (autoload 'spam-initialize "spam" "\ @@ -25179,7 +25171,7 @@ installed through `spam-necessary-extra-headers'. ;;;*** ;;;### (autoloads nil "spam-report" "gnus/spam-report.el" (21607 -;;;;;; 56024 801559 72000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from gnus/spam-report.el (autoload 'spam-report-process-queue "spam-report" "\ @@ -25221,8 +25213,8 @@ Spam reports will be queued with the method used when ;;;*** -;;;### (autoloads nil "speedbar" "speedbar.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "speedbar" "speedbar.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from speedbar.el (defalias 'speedbar 'speedbar-frame-mode) @@ -25246,8 +25238,8 @@ selected. If the speedbar frame is active, then select the attached frame. ;;;*** -;;;### (autoloads nil "spook" "play/spook.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "spook" "play/spook.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from play/spook.el (autoload 'spook "spook" "\ @@ -25262,8 +25254,8 @@ Return a vector containing the lines from `spook-phrases-file'. ;;;*** -;;;### (autoloads nil "sql" "progmodes/sql.el" (21607 56059 303525 -;;;;;; 127000)) +;;;### (autoloads nil "sql" "progmodes/sql.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from progmodes/sql.el (push (purecopy '(sql 3 4)) package--builtin-versions) @@ -25722,17 +25714,22 @@ buffer. \(fn &optional BUFFER)" t nil) +(autoload 'sql-vertica "sql" "\ +Run vsql as an inferior process. + +\(fn &optional BUFFER)" t nil) + ;;;*** -;;;### (autoloads nil "srecode" "cedet/srecode.el" (21607 56023 800854 -;;;;;; 237000)) +;;;### (autoloads nil "srecode" "cedet/srecode.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from cedet/srecode.el (push (purecopy '(srecode 1 2)) package--builtin-versions) ;;;*** ;;;### (autoloads nil "srecode/srt-mode" "cedet/srecode/srt-mode.el" -;;;;;; (21607 56023 800854 237000)) +;;;;;; (21657 20283 330825 807000)) ;;; Generated autoloads from cedet/srecode/srt-mode.el (autoload 'srecode-template-mode "srecode/srt-mode" "\ @@ -25744,8 +25741,8 @@ Major-mode for writing SRecode macros. ;;;*** -;;;### (autoloads nil "starttls" "gnus/starttls.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "starttls" "gnus/starttls.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from gnus/starttls.el (autoload 'starttls-open-stream "starttls" "\ @@ -25768,8 +25765,8 @@ GnuTLS requires a port number. ;;;*** -;;;### (autoloads nil "strokes" "strokes.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "strokes" "strokes.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from strokes.el (autoload 'strokes-global-set-stroke "strokes" "\ @@ -25882,8 +25879,8 @@ Read a complex stroke and insert its glyph into the current buffer. ;;;*** -;;;### (autoloads nil "studly" "play/studly.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "studly" "play/studly.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from play/studly.el (autoload 'studlify-region "studly" "\ @@ -25903,18 +25900,20 @@ Studlify-case the current buffer. ;;;*** -;;;### (autoloads nil "subword" "progmodes/subword.el" (21607 56059 -;;;;;; 303525 127000)) +;;;### (autoloads nil "subword" "progmodes/subword.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from progmodes/subword.el +(define-obsolete-function-alias 'capitalized-words-mode 'subword-mode "25.1") + (autoload 'subword-mode "subword" "\ Toggle subword movement and editing (Subword mode). With a prefix argument ARG, enable Subword mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -Subword mode is a buffer-local minor mode. Enabling it remaps -word-based editing commands to subword-based commands that handle +Subword mode is a buffer-local minor mode. Enabling it changes +the definition of a word so that word-based commands stop inside symbols with mixed uppercase and lowercase letters, e.g. \"GtkWidget\", \"EmacsFrameClass\", \"NSGraphicsContext\". @@ -25928,9 +25927,8 @@ called a `subword'. Here are some examples: EmacsFrameClass => \"Emacs\", \"Frame\" and \"Class\" NSGraphicsContext => \"NS\", \"Graphics\" and \"Context\" -The subword oriented commands activated in this minor mode recognize -subwords in a nomenclature to move between subwords and to edit them -as words. +This mode changes the definition of a word so that word commands +treat nomenclature boundaries as word boundaries. \\{subword-mode-map} @@ -25963,13 +25961,10 @@ With a prefix argument ARG, enable Superword mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -Superword mode is a buffer-local minor mode. Enabling it remaps -word-based editing commands to superword-based commands that -treat symbols as words, e.g. \"this_is_a_symbol\". - -The superword oriented commands activated in this minor mode -recognize symbols as superwords to move between superwords and to -edit them as words. +Superword mode is a buffer-local minor mode. Enabling it changes +the definition of words such that symbols characters are treated +as parts of words: e.g., in `superword-mode', +\"this_is_a_symbol\" counts as one word. \\{superword-mode-map} @@ -25998,8 +25993,8 @@ See `superword-mode' for more information on Superword mode. ;;;*** -;;;### (autoloads nil "supercite" "mail/supercite.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "supercite" "mail/supercite.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from mail/supercite.el (autoload 'sc-cite-original "supercite" "\ @@ -26031,8 +26026,8 @@ and `sc-post-hook' is run after the guts of this function. ;;;*** -;;;### (autoloads nil "t-mouse" "t-mouse.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "t-mouse" "t-mouse.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from t-mouse.el (define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1") @@ -26060,7 +26055,7 @@ It relies on the `gpm' daemon being activated. ;;;*** -;;;### (autoloads nil "tabify" "tabify.el" (21607 56025 801549 101000)) +;;;### (autoloads nil "tabify" "tabify.el" (21607 54478 800121 42000)) ;;; Generated autoloads from tabify.el (autoload 'untabify "tabify" "\ @@ -26089,8 +26084,8 @@ The variable `tab-width' controls the spacing of tab stops. ;;;*** -;;;### (autoloads nil "table" "textmodes/table.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "table" "textmodes/table.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from textmodes/table.el (defvar table-cell-map-hook nil "\ @@ -26682,7 +26677,7 @@ converts a table into plain text without frames. It is a companion to ;;;*** -;;;### (autoloads nil "talk" "talk.el" (21607 56025 801549 101000)) +;;;### (autoloads nil "talk" "talk.el" (21607 54478 800121 42000)) ;;; Generated autoloads from talk.el (autoload 'talk-connect "talk" "\ @@ -26697,8 +26692,8 @@ Connect to the Emacs talk group from the current X display or tty frame. ;;;*** -;;;### (autoloads nil "tar-mode" "tar-mode.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "tar-mode" "tar-mode.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from tar-mode.el (autoload 'tar-mode "tar-mode" "\ @@ -26721,8 +26716,8 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. ;;;*** -;;;### (autoloads nil "tcl" "progmodes/tcl.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "tcl" "progmodes/tcl.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from progmodes/tcl.el (autoload 'tcl-mode "tcl" "\ @@ -26770,8 +26765,8 @@ Prefix argument means invert sense of `tcl-use-smart-word-finder'. ;;;*** -;;;### (autoloads nil "telnet" "net/telnet.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "telnet" "net/telnet.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from net/telnet.el (autoload 'telnet "telnet" "\ @@ -26796,7 +26791,7 @@ Normally input is edited in Emacs and sent a line at a time. ;;;*** -;;;### (autoloads nil "term" "term.el" (21607 56059 303525 127000)) +;;;### (autoloads nil "term" "term.el" (21607 54478 800121 42000)) ;;; Generated autoloads from term.el (autoload 'make-term "term" "\ @@ -26839,7 +26834,7 @@ use in that buffer. ;;;*** ;;;### (autoloads nil "testcover" "emacs-lisp/testcover.el" (21607 -;;;;;; 56024 300834 853000)) +;;;;;; 54477 800124 118000)) ;;; Generated autoloads from emacs-lisp/testcover.el (autoload 'testcover-this-defun "testcover" "\ @@ -26849,8 +26844,8 @@ Start coverage on function under point. ;;;*** -;;;### (autoloads nil "tetris" "play/tetris.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "tetris" "play/tetris.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from play/tetris.el (push (purecopy '(tetris 2 1)) package--builtin-versions) @@ -26875,8 +26870,8 @@ tetris-mode keybindings: ;;;*** -;;;### (autoloads nil "tex-mode" "textmodes/tex-mode.el" (21607 56059 -;;;;;; 804396 982000)) +;;;### (autoloads nil "tex-mode" "textmodes/tex-mode.el" (21663 59071 +;;;;;; 96337 184000)) ;;; Generated autoloads from textmodes/tex-mode.el (defvar tex-shell-file-name nil "\ @@ -27177,8 +27172,8 @@ Major mode to edit DocTeX files. ;;;*** -;;;### (autoloads nil "texinfmt" "textmodes/texinfmt.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "texinfmt" "textmodes/texinfmt.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from textmodes/texinfmt.el (autoload 'texinfo-format-buffer "texinfmt" "\ @@ -27217,8 +27212,8 @@ if large. You can use `Info-split' to do this manually. ;;;*** -;;;### (autoloads nil "texinfo" "textmodes/texinfo.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "texinfo" "textmodes/texinfo.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from textmodes/texinfo.el (defvar texinfo-open-quote (purecopy "``") "\ @@ -27303,7 +27298,7 @@ value of `texinfo-mode-hook'. ;;;*** ;;;### (autoloads nil "thai-util" "language/thai-util.el" (21607 -;;;;;; 56024 801559 72000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from language/thai-util.el (autoload 'thai-compose-region "thai-util" "\ @@ -27330,8 +27325,8 @@ Compose Thai characters in the current buffer. ;;;*** -;;;### (autoloads nil "thingatpt" "thingatpt.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "thingatpt" "thingatpt.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from thingatpt.el (autoload 'forward-thing "thingatpt" "\ @@ -27395,7 +27390,7 @@ Return the Lisp list at point, or nil if none is found. ;;;*** -;;;### (autoloads nil "thumbs" "thumbs.el" (21607 56025 801549 101000)) +;;;### (autoloads nil "thumbs" "thumbs.el" (21607 54478 800121 42000)) ;;; Generated autoloads from thumbs.el (autoload 'thumbs-find-thumb "thumbs" "\ @@ -27430,7 +27425,7 @@ In dired, call the setroot program on the image at point. ;;;*** ;;;### (autoloads nil "tibet-util" "language/tibet-util.el" (21607 -;;;;;; 56024 801559 72000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from language/tibet-util.el (autoload 'tibetan-char-p "tibet-util" "\ @@ -27503,32 +27498,36 @@ See also docstring of the function tibetan-compose-region. ;;;*** -;;;### (autoloads nil "tildify" "textmodes/tildify.el" (21607 56059 -;;;;;; 804396 982000)) +;;;### (autoloads nil "tildify" "textmodes/tildify.el" (21611 10938 +;;;;;; 204397 226000)) ;;; Generated autoloads from textmodes/tildify.el -(push (purecopy '(tildify 4 5)) package--builtin-versions) +(push (purecopy '(tildify 4 5 7)) package--builtin-versions) (autoload 'tildify-region "tildify" "\ Add hard spaces in the region between BEG and END. -See variables `tildify-pattern-alist', `tildify-string-alist', and +See variables `tildify-pattern', `tildify-space-string', and `tildify-ignored-environments-alist' for information about configuration parameters. This function performs no refilling of the changed text. +If DONT-ASK is set, or called interactively with prefix argument, user +won't be prompted for confirmation of each substitution. -\(fn BEG END)" t nil) +\(fn BEG END &optional DONT-ASK)" t nil) (autoload 'tildify-buffer "tildify" "\ Add hard spaces in the current buffer. -See variables `tildify-pattern-alist', `tildify-string-alist', and +See variables `tildify-pattern', `tildify-space-string', and `tildify-ignored-environments-alist' for information about configuration parameters. This function performs no refilling of the changed text. +If DONT-ASK is set, or called interactively with prefix argument, user +won't be prompted for confirmation of each substitution. -\(fn)" t nil) +\(fn &optional DONT-ASK)" t nil) ;;;*** -;;;### (autoloads nil "time" "time.el" (21607 56025 801549 101000)) +;;;### (autoloads nil "time" "time.el" (21607 54478 800121 42000)) ;;; Generated autoloads from time.el (defvar display-time-day-and-date nil "\ @@ -27590,8 +27589,8 @@ Return a string giving the duration of the Emacs initialization. ;;;*** -;;;### (autoloads nil "time-date" "calendar/time-date.el" (21607 -;;;;;; 56058 801550 360000)) +;;;### (autoloads nil "time-date" "calendar/time-date.el" (21611 +;;;;;; 10937 700236 3000)) ;;; Generated autoloads from calendar/time-date.el (autoload 'date-to-time "time-date" "\ @@ -27606,15 +27605,10 @@ If DATE lacks timezone information, GMT is assumed. (autoload 'time-to-seconds "time-date")) (autoload 'seconds-to-time "time-date" "\ -Convert SECONDS (a floating point number) to a time value. +Convert SECONDS to a time value. \(fn SECONDS)" nil nil) -(autoload 'time-less-p "time-date" "\ -Return non-nil if time value T1 is earlier than time value T2. - -\(fn T1 T2)" nil nil) - (autoload 'days-to-time "time-date" "\ Convert DAYS into a time value. @@ -27627,17 +27621,9 @@ TIME should be either a time value or a date-time string. \(fn TIME)" nil nil) (defalias 'subtract-time 'time-subtract) - -(autoload 'time-subtract "time-date" "\ -Subtract two time values, T1 minus T2. -Return the difference in the format of a time value. - -\(fn T1 T2)" nil nil) - -(autoload 'time-add "time-date" "\ -Add two time values T1 and T2. One should represent a time difference. - -\(fn T1 T2)" nil nil) +(autoload 'time-add "time-date") +(autoload 'time-subtract "time-date") +(autoload 'time-less-p "time-date") (autoload 'date-to-day "time-date" "\ Return the number of days between year 1 and DATE. @@ -27700,10 +27686,15 @@ This function does not work for SECONDS greater than `most-positive-fixnum'. \(fn STRING SECONDS)" nil nil) +(autoload 'seconds-to-string "time-date" "\ +Convert the time interval in seconds to a short string. + +\(fn DELAY)" nil nil) + ;;;*** -;;;### (autoloads nil "time-stamp" "time-stamp.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "time-stamp" "time-stamp.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from time-stamp.el (put 'time-stamp-format 'safe-local-variable 'stringp) (put 'time-stamp-time-zone 'safe-local-variable 'string-or-null-p) @@ -27744,7 +27735,7 @@ With ARG, turn time stamping on if and only if arg is positive. ;;;*** ;;;### (autoloads nil "timeclock" "calendar/timeclock.el" (21607 -;;;;;; 56058 801550 360000)) +;;;;;; 54477 800124 118000)) ;;; Generated autoloads from calendar/timeclock.el (push (purecopy '(timeclock 2 6 1)) package--builtin-versions) @@ -27854,7 +27845,7 @@ relative only to the time worked today, and not to past time. ;;;*** ;;;### (autoloads nil "titdic-cnv" "international/titdic-cnv.el" -;;;;;; (21607 56024 801559 72000)) +;;;;;; (21607 54478 300138 641000)) ;;; Generated autoloads from international/titdic-cnv.el (autoload 'titdic-convert "titdic-cnv" "\ @@ -27876,7 +27867,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\". ;;;*** -;;;### (autoloads nil "tmm" "tmm.el" (21607 56025 801549 101000)) +;;;### (autoloads nil "tmm" "tmm.el" (21652 2366 414435 564000)) ;;; Generated autoloads from tmm.el (define-key global-map "\M-`" 'tmm-menubar) (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse) @@ -27918,8 +27909,8 @@ Its value should be an event that has a binding in MENU. ;;;*** -;;;### (autoloads nil "todo-mode" "calendar/todo-mode.el" (21623 -;;;;;; 5708 80843 798000)) +;;;### (autoloads nil "todo-mode" "calendar/todo-mode.el" (21625 +;;;;;; 43838 483701 627000)) ;;; Generated autoloads from calendar/todo-mode.el (autoload 'todo-show "todo-mode" "\ @@ -27986,8 +27977,8 @@ Mode for displaying and reprioritizing top priority Todo. ;;;*** -;;;### (autoloads nil "tool-bar" "tool-bar.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "tool-bar" "tool-bar.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from tool-bar.el (autoload 'toggle-tool-bar-mode-from-frame "tool-bar" "\ @@ -28057,8 +28048,8 @@ holds a keymap. ;;;*** -;;;### (autoloads nil "tq" "emacs-lisp/tq.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "tq" "emacs-lisp/tq.el" (21607 54477 800124 +;;;;;; 118000)) ;;; Generated autoloads from emacs-lisp/tq.el (autoload 'tq-create "tq" "\ @@ -28071,8 +28062,8 @@ to a tcp server on another machine. ;;;*** -;;;### (autoloads nil "trace" "emacs-lisp/trace.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "trace" "emacs-lisp/trace.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from emacs-lisp/trace.el (defvar trace-buffer "*trace-output*" "\ @@ -28117,8 +28108,7 @@ the output buffer or changing the window configuration. ;;;*** -;;;### (autoloads nil "tramp" "net/tramp.el" (21617 53323 210147 -;;;;;; 705000)) +;;;### (autoloads nil "tramp" "net/tramp.el" (21663 59071 96337 184000)) ;;; Generated autoloads from net/tramp.el (defvar tramp-mode t "\ @@ -28233,8 +28223,8 @@ Discard Tramp from loading remote files. ;;;*** -;;;### (autoloads nil "tramp-ftp" "net/tramp-ftp.el" (21607 56025 -;;;;;; 301574 889000)) +;;;### (autoloads nil "tramp-ftp" "net/tramp-ftp.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from net/tramp-ftp.el (autoload 'tramp-ftp-enable-ange-ftp "tramp-ftp" "\ @@ -28244,8 +28234,8 @@ Discard Tramp from loading remote files. ;;;*** -;;;### (autoloads nil "tutorial" "tutorial.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "tutorial" "tutorial.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from tutorial.el (autoload 'help-with-tutorial "tutorial" "\ @@ -28269,8 +28259,8 @@ resumed later. ;;;*** -;;;### (autoloads nil "tv-util" "language/tv-util.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "tv-util" "language/tv-util.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from language/tv-util.el (autoload 'tai-viet-composition-function "tv-util" "\ @@ -28281,7 +28271,7 @@ resumed later. ;;;*** ;;;### (autoloads nil "two-column" "textmodes/two-column.el" (21607 -;;;;;; 56025 801549 101000)) +;;;;;; 54478 800121 42000)) ;;; Generated autoloads from textmodes/two-column.el (autoload '2C-command "two-column" () t 'keymap) (global-set-key "\C-x6" '2C-command) @@ -28328,8 +28318,8 @@ First column's text sSs Second column's text ;;;*** -;;;### (autoloads nil "type-break" "type-break.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "type-break" "type-break.el" (21609 55608 852266 +;;;;;; 580000)) ;;; Generated autoloads from type-break.el (defvar type-break-mode nil "\ @@ -28461,7 +28451,7 @@ FRAC should be the inverse of the fractional value; for example, a value of ;;;*** -;;;### (autoloads nil "uce" "mail/uce.el" (21607 56024 801559 72000)) +;;;### (autoloads nil "uce" "mail/uce.el" (21607 54478 300138 641000)) ;;; Generated autoloads from mail/uce.el (autoload 'uce-reply-to-uce "uce" "\ @@ -28475,7 +28465,7 @@ You might need to set `uce-mail-reader' before using this. ;;;*** ;;;### (autoloads nil "ucs-normalize" "international/ucs-normalize.el" -;;;;;; (21607 56024 801559 72000)) +;;;;;; (21607 54478 300138 641000)) ;;; Generated autoloads from international/ucs-normalize.el (autoload 'ucs-normalize-NFD-region "ucs-normalize" "\ @@ -28541,7 +28531,7 @@ Normalize the string STR by the Unicode NFC and Mac OS's HFS Plus. ;;;*** ;;;### (autoloads nil "underline" "textmodes/underline.el" (21607 -;;;;;; 56025 801549 101000)) +;;;;;; 54478 800121 42000)) ;;; Generated autoloads from textmodes/underline.el (autoload 'underline-region "underline" "\ @@ -28561,8 +28551,8 @@ which specify the range to operate on. ;;;*** -;;;### (autoloads nil "unrmail" "mail/unrmail.el" (21607 56024 801559 -;;;;;; 72000)) +;;;### (autoloads nil "unrmail" "mail/unrmail.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from mail/unrmail.el (autoload 'batch-unrmail "unrmail" "\ @@ -28582,8 +28572,8 @@ The variable `unrmail-mbox-format' controls which mbox format to use. ;;;*** -;;;### (autoloads nil "unsafep" "emacs-lisp/unsafep.el" (21607 56024 -;;;;;; 300834 853000)) +;;;### (autoloads nil "unsafep" "emacs-lisp/unsafep.el" (21607 54477 +;;;;;; 800124 118000)) ;;; Generated autoloads from emacs-lisp/unsafep.el (autoload 'unsafep "unsafep" "\ @@ -28595,7 +28585,7 @@ UNSAFEP-VARS is a list of symbols with local bindings. ;;;*** -;;;### (autoloads nil "url" "url/url.el" (21607 56059 804396 982000)) +;;;### (autoloads nil "url" "url/url.el" (21607 54478 800121 42000)) ;;; Generated autoloads from url/url.el (autoload 'url-retrieve "url" "\ @@ -28642,8 +28632,8 @@ no further processing). URL is either a string or a parsed URL. ;;;*** -;;;### (autoloads nil "url-auth" "url/url-auth.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "url-auth" "url/url-auth.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from url/url-auth.el (autoload 'url-get-authentication "url-auth" "\ @@ -28684,8 +28674,8 @@ RATING a rating between 1 and 10 of the strength of the authentication. ;;;*** -;;;### (autoloads nil "url-cache" "url/url-cache.el" (21607 56059 -;;;;;; 804396 982000)) +;;;### (autoloads nil "url-cache" "url/url-cache.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from url/url-cache.el (autoload 'url-store-in-cache "url-cache" "\ @@ -28706,8 +28696,8 @@ Extract FNAM from the local disk cache. ;;;*** -;;;### (autoloads nil "url-cid" "url/url-cid.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "url-cid" "url/url-cid.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from url/url-cid.el (autoload 'url-cid "url-cid" "\ @@ -28717,8 +28707,8 @@ Extract FNAM from the local disk cache. ;;;*** -;;;### (autoloads nil "url-dav" "url/url-dav.el" (21607 56059 804396 -;;;;;; 982000)) +;;;### (autoloads nil "url-dav" "url/url-dav.el" (21634 58813 400848 +;;;;;; 500000)) ;;; Generated autoloads from url/url-dav.el (autoload 'url-dav-supported-p "url-dav" "\ @@ -28752,8 +28742,8 @@ added to this list, so most requests can just pass in nil. ;;;*** -;;;### (autoloads nil "url-file" "url/url-file.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "url-file" "url/url-file.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from url/url-file.el (autoload 'url-file "url-file" "\ @@ -28763,8 +28753,8 @@ Handle file: and ftp: URLs. ;;;*** -;;;### (autoloads nil "url-gw" "url/url-gw.el" (21607 56059 804396 -;;;;;; 982000)) +;;;### (autoloads nil "url-gw" "url/url-gw.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from url/url-gw.el (autoload 'url-gateway-nslookup-host "url-gw" "\ @@ -28778,12 +28768,15 @@ Args per `open-network-stream'. Will not make a connection if `url-gateway-unplugged' is non-nil. Might do a non-blocking connection; use `process-status' to check. -\(fn NAME BUFFER HOST SERVICE)" nil nil) +Optional arg GATEWAY-METHOD specifies the gateway to be used, +overriding the value of `url-gateway-method'. + +\(fn NAME BUFFER HOST SERVICE &optional GATEWAY-METHOD)" nil nil) ;;;*** ;;;### (autoloads nil "url-handlers" "url/url-handlers.el" (21607 -;;;;;; 56059 804396 982000)) +;;;;;; 54478 800121 42000)) ;;; Generated autoloads from url/url-handlers.el (defvar url-handler-mode nil "\ @@ -28837,8 +28830,8 @@ accessible. ;;;*** -;;;### (autoloads nil "url-http" "url/url-http.el" (21607 56059 804396 -;;;;;; 982000)) +;;;### (autoloads nil "url-http" "url/url-http.el" (21638 55900 442275 +;;;;;; 524000)) ;;; Generated autoloads from url/url-http.el (autoload 'url-default-expander "url-expand") @@ -28850,8 +28843,8 @@ accessible. ;;;*** -;;;### (autoloads nil "url-irc" "url/url-irc.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "url-irc" "url/url-irc.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from url/url-irc.el (autoload 'url-irc "url-irc" "\ @@ -28861,8 +28854,8 @@ accessible. ;;;*** -;;;### (autoloads nil "url-ldap" "url/url-ldap.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "url-ldap" "url/url-ldap.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from url/url-ldap.el (autoload 'url-ldap "url-ldap" "\ @@ -28875,8 +28868,8 @@ URL can be a URL string, or a URL vector of the type returned by ;;;*** -;;;### (autoloads nil "url-mailto" "url/url-mailto.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "url-mailto" "url/url-mailto.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from url/url-mailto.el (autoload 'url-mail "url-mailto" "\ @@ -28891,8 +28884,8 @@ Handle the mailto: URL syntax. ;;;*** -;;;### (autoloads nil "url-misc" "url/url-misc.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "url-misc" "url/url-misc.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from url/url-misc.el (autoload 'url-man "url-misc" "\ @@ -28923,8 +28916,8 @@ Fetch a data URL (RFC 2397). ;;;*** -;;;### (autoloads nil "url-news" "url/url-news.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "url-news" "url/url-news.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from url/url-news.el (autoload 'url-news "url-news" "\ @@ -28939,8 +28932,8 @@ Fetch a data URL (RFC 2397). ;;;*** -;;;### (autoloads nil "url-ns" "url/url-ns.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "url-ns" "url/url-ns.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from url/url-ns.el (autoload 'isPlainHostName "url-ns" "\ @@ -28980,8 +28973,8 @@ Fetch a data URL (RFC 2397). ;;;*** -;;;### (autoloads nil "url-parse" "url/url-parse.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "url-parse" "url/url-parse.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from url/url-parse.el (autoload 'url-recreate-url "url-parse" "\ @@ -29032,8 +29025,8 @@ parses to ;;;*** -;;;### (autoloads nil "url-privacy" "url/url-privacy.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "url-privacy" "url/url-privacy.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from url/url-privacy.el (autoload 'url-setup-privacy-info "url-privacy" "\ @@ -29043,8 +29036,8 @@ Setup variables that expose info about you and your system. ;;;*** -;;;### (autoloads nil "url-queue" "url/url-queue.el" (21607 56025 -;;;;;; 801549 101000)) +;;;### (autoloads nil "url-queue" "url/url-queue.el" (21619 5051 +;;;;;; 260148 536000)) ;;; Generated autoloads from url/url-queue.el (autoload 'url-queue-retrieve "url-queue" "\ @@ -29058,8 +29051,27 @@ The variable `url-queue-timeout' sets a timeout. ;;;*** -;;;### (autoloads nil "url-util" "url/url-util.el" (21607 56059 804396 -;;;;;; 982000)) +;;;### (autoloads nil "url-tramp" "url/url-tramp.el" (21607 54478 +;;;;;; 800121 42000)) +;;; Generated autoloads from url/url-tramp.el + +(defvar url-tramp-protocols '("ftp" "ssh" "scp" "rsync" "telnet") "\ +List of URL protocols the work is handled by Tramp. +They must also be covered by `url-handler-regexp'.") + +(custom-autoload 'url-tramp-protocols "url-tramp" t) + +(autoload 'url-tramp-file-handler "url-tramp" "\ +Function called from the `file-name-handler-alist' routines. +OPERATION is what needs to be done. ARGS are the arguments that +would have been passed to OPERATION. + +\(fn OPERATION &rest ARGS)" nil nil) + +;;;*** + +;;;### (autoloads nil "url-util" "url/url-util.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from url/url-util.el (defvar url-debug nil "\ @@ -29227,8 +29239,8 @@ This uses `url-current-object', set locally to the buffer. ;;;*** -;;;### (autoloads nil "userlock" "userlock.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "userlock" "userlock.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from userlock.el (autoload 'ask-user-about-lock "userlock" "\ @@ -29256,8 +29268,8 @@ The buffer in question is current when this function is called. ;;;*** -;;;### (autoloads nil "utf-7" "international/utf-7.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "utf-7" "international/utf-7.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from international/utf-7.el (autoload 'utf-7-post-read-conversion "utf-7" "\ @@ -29282,7 +29294,7 @@ The buffer in question is current when this function is called. ;;;*** -;;;### (autoloads nil "utf7" "gnus/utf7.el" (21607 56024 801559 72000)) +;;;### (autoloads nil "utf7" "gnus/utf7.el" (21607 54478 300138 641000)) ;;; Generated autoloads from gnus/utf7.el (autoload 'utf7-encode "utf7" "\ @@ -29292,8 +29304,8 @@ Encode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil. ;;;*** -;;;### (autoloads nil "uudecode" "mail/uudecode.el" (21607 56024 -;;;;;; 801559 72000)) +;;;### (autoloads nil "uudecode" "mail/uudecode.el" (21607 54478 +;;;;;; 300138 641000)) ;;; Generated autoloads from mail/uudecode.el (autoload 'uudecode-decode-region-external "uudecode" "\ @@ -29317,7 +29329,7 @@ If FILE-NAME is non-nil, save the result to FILE-NAME. ;;;*** -;;;### (autoloads nil "vc" "vc/vc.el" (21613 56261 180128 217000)) +;;;### (autoloads nil "vc" "vc/vc.el" (21649 26173 700491 498000)) ;;; Generated autoloads from vc/vc.el (defvar vc-checkout-hook nil "\ @@ -29356,8 +29368,7 @@ For old-style locking-based version control systems, like RCS: If every file is registered and unlocked, check out (lock) the file(s) for editing. If every file is locked by you and has changes, pop up a - *vc-log* buffer to check in the changes. If the variable - `vc-keep-workfiles' is non-nil (the default), leave a + *vc-log* buffer to check in the changes. Leave a read-only copy of each changed file after checking in. If every file is locked by you and unchanged, unlock them. If every file is locked by someone else, offer to steal the lock. @@ -29368,8 +29379,7 @@ For old-style locking-based version control systems, like RCS: Register into a version control system. If VC-FILESET is given, register the files in that fileset. Otherwise register the current file. -With prefix argument SET-REVISION, allow user to specify initial revision -level. If COMMENT is present, use that as an initial comment. +If COMMENT is present, use that as an initial comment. The version control system to use is found by cycling through the list `vc-handled-backends'. The first backend in that list which declares @@ -29378,7 +29388,7 @@ directory are already registered under that backend) will be used to register the file. If no backend declares itself responsible, the first backend that could register the file is used. -\(fn &optional SET-REVISION VC-FILESET COMMENT)" t nil) +\(fn &optional VC-FILESET COMMENT)" t nil) (autoload 'vc-version-diff "vc" "\ Report diffs between revisions of the fileset in the repository history. @@ -29425,6 +29435,12 @@ saving the buffer. \(fn HISTORIC &optional NOT-URGENT)" t nil) +(autoload 'vc-root-dir "vc" "\ +Return the root directory for the current VC tree. +Return nil if the root directory cannot be identified. + +\(fn)" nil nil) + (autoload 'vc-revision-other-window "vc" "\ Visit revision REV of the current file in another window. If the current file is named `F', the revision is named `F.~REV~'. @@ -29510,6 +29526,11 @@ When called interactively with a prefix argument, prompt for REMOTE-LOCATION. \(fn &optional REMOTE-LOCATION)" t nil) +(autoload 'vc-region-history "vc" "\ +Show the history of the region FROM..TO. + +\(fn FROM TO)" t nil) + (autoload 'vc-revert "vc" "\ Revert working copies of the selected fileset to their repository contents. This asks for confirmation if the buffer contents are not identical @@ -29517,13 +29538,6 @@ to the working revision (except for keyword expansion). \(fn)" t nil) -(autoload 'vc-rollback "vc" "\ -Roll back (remove) the most recent changeset committed to the repository. -This may be either a file-level or a repository-level operation, -depending on the underlying version-control system. - -\(fn)" t nil) - (define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1") (autoload 'vc-pull "vc" "\ @@ -29602,8 +29616,8 @@ Return the branch part of a revision number REV. ;;;*** -;;;### (autoloads nil "vc-annotate" "vc/vc-annotate.el" (21607 56059 -;;;;;; 804396 982000)) +;;;### (autoloads nil "vc-annotate" "vc/vc-annotate.el" (21607 54478 +;;;;;; 800121 42000)) ;;; Generated autoloads from vc/vc-annotate.el (autoload 'vc-annotate "vc-annotate" "\ @@ -29635,24 +29649,15 @@ Customization variables: mode-specific menu. `vc-annotate-color-map' and `vc-annotate-very-old-color' define the mapping of time to colors. `vc-annotate-background' specifies the background color. +`vc-annotate-background-mode' specifies whether the color map +should be applied to the background or to the foreground. \(fn FILE REV &optional DISPLAY-MODE BUF MOVE-POINT-TO VC-BK)" t nil) ;;;*** -;;;### (autoloads nil "vc-arch" "vc/vc-arch.el" (21607 56025 801549 -;;;;;; 101000)) -;;; Generated autoloads from vc/vc-arch.el - (defun vc-arch-registered (file) - (if (vc-find-root file "{arch}/=tagging-method") - (progn - (load "vc-arch" nil t) - (vc-arch-registered file)))) - -;;;*** - -;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (21619 8648 550151 -;;;;;; 780000)) +;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (21645 29117 170137 +;;;;;; 362000)) ;;; Generated autoloads from vc/vc-bzr.el (defconst vc-bzr-admin-dirname ".bzr" "\ @@ -29668,8 +29673,8 @@ Name of the format file in a .bzr directory.") ;;;*** -;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (21607 56059 804396 -;;;;;; 982000)) +;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (21645 29117 170137 +;;;;;; 362000)) ;;; Generated autoloads from vc/vc-cvs.el (defun vc-cvs-registered (f) "Return non-nil if file F is registered with CVS." @@ -29680,8 +29685,8 @@ Name of the format file in a .bzr directory.") ;;;*** -;;;### (autoloads nil "vc-dir" "vc/vc-dir.el" (21607 56059 804396 -;;;;;; 982000)) +;;;### (autoloads nil "vc-dir" "vc/vc-dir.el" (21665 14401 955623 +;;;;;; 556000)) ;;; Generated autoloads from vc/vc-dir.el (autoload 'vc-dir "vc-dir" "\ @@ -29705,8 +29710,8 @@ These are the commands available for use in the file status buffer: ;;;*** -;;;### (autoloads nil "vc-dispatcher" "vc/vc-dispatcher.el" (21607 -;;;;;; 56059 804396 982000)) +;;;### (autoloads nil "vc-dispatcher" "vc/vc-dispatcher.el" (21640 +;;;;;; 46919 650145 897000)) ;;; Generated autoloads from vc/vc-dispatcher.el (autoload 'vc-do-command "vc-dispatcher" "\ @@ -29729,8 +29734,8 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-git" "vc/vc-git.el" (21615 11593 522981 -;;;;;; 49000)) +;;;### (autoloads nil "vc-git" "vc/vc-git.el" (21663 59071 96337 +;;;;;; 184000)) ;;; Generated autoloads from vc/vc-git.el (defun vc-git-registered (file) "Return non-nil if FILE is registered with git." @@ -29741,7 +29746,7 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (21619 8648 550151 780000)) +;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (21645 29117 170137 362000)) ;;; Generated autoloads from vc/vc-hg.el (defun vc-hg-registered (file) "Return non-nil if FILE is registered with hg." @@ -29752,8 +29757,8 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (21645 29117 170137 +;;;;;; 362000)) ;;; Generated autoloads from vc/vc-mtn.el (defconst vc-mtn-admin-dir "_MTN" "\ @@ -29769,8 +29774,8 @@ Name of the monotone directory's format file.") ;;;*** -;;;### (autoloads nil "vc-rcs" "vc/vc-rcs.el" (21607 56059 804396 -;;;;;; 982000)) +;;;### (autoloads nil "vc-rcs" "vc/vc-rcs.el" (21645 29117 170137 +;;;;;; 362000)) ;;; Generated autoloads from vc/vc-rcs.el (defvar vc-rcs-master-templates (purecopy '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) "\ @@ -29783,8 +29788,8 @@ For a description of possible values, see `vc-check-master-templates'.") ;;;*** -;;;### (autoloads nil "vc-sccs" "vc/vc-sccs.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "vc-sccs" "vc/vc-sccs.el" (21645 29117 170137 +;;;;;; 362000)) ;;; Generated autoloads from vc/vc-sccs.el (defvar vc-sccs-master-templates (purecopy '("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir)) "\ @@ -29802,8 +29807,22 @@ find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir) ;;;*** -;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "vc-src" "vc/vc-src.el" (21645 29117 170137 +;;;;;; 362000)) +;;; Generated autoloads from vc/vc-src.el + +(defvar vc-src-master-templates (purecopy '("%s.src/%s,v")) "\ +Where to look for SRC master files. +For a description of possible values, see `vc-check-master-templates'.") + +(custom-autoload 'vc-src-master-templates "vc-src" t) + +(defun vc-src-registered (f) (vc-default-registered 'src f)) + +;;;*** + +;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (21652 2366 414435 +;;;;;; 564000)) ;;; Generated autoloads from vc/vc-svn.el (defun vc-svn-registered (f) (let ((admin-dir (cond ((and (eq system-type 'windows-nt) @@ -29817,7 +29836,7 @@ find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir) ;;;*** ;;;### (autoloads nil "vera-mode" "progmodes/vera-mode.el" (21607 -;;;;;; 56059 303525 127000)) +;;;;;; 54478 800121 42000)) ;;; Generated autoloads from progmodes/vera-mode.el (push (purecopy '(vera-mode 2 28)) package--builtin-versions) (add-to-list 'auto-mode-alist (cons (purecopy "\\.vr[hi]?\\'") 'vera-mode)) @@ -29876,7 +29895,7 @@ Key bindings: ;;;*** ;;;### (autoloads nil "verilog-mode" "progmodes/verilog-mode.el" -;;;;;; (21607 56059 303525 127000)) +;;;;;; (21644 8251 830117 252000)) ;;; Generated autoloads from progmodes/verilog-mode.el (autoload 'verilog-mode "verilog-mode" "\ @@ -30015,8 +30034,8 @@ Key bindings specific to `verilog-mode-map' are: ;;;*** -;;;### (autoloads nil "vhdl-mode" "progmodes/vhdl-mode.el" (21607 -;;;;;; 56059 303525 127000)) +;;;### (autoloads nil "vhdl-mode" "progmodes/vhdl-mode.el" (21638 +;;;;;; 55900 442275 524000)) ;;; Generated autoloads from progmodes/vhdl-mode.el (autoload 'vhdl-mode "vhdl-mode" "\ @@ -30571,7 +30590,7 @@ Key bindings: ;;;*** ;;;### (autoloads nil "viet-util" "language/viet-util.el" (21607 -;;;;;; 56024 801559 72000)) +;;;;;; 54478 300138 641000)) ;;; Generated autoloads from language/viet-util.el (autoload 'viet-encode-viscii-char "viet-util" "\ @@ -30615,7 +30634,7 @@ Convert Vietnamese characters of the current buffer to `VIQR' mnemonics. ;;;*** -;;;### (autoloads nil "view" "view.el" (21607 56025 801549 101000)) +;;;### (autoloads nil "view" "view.el" (21607 54478 800121 42000)) ;;; Generated autoloads from view.el (defvar view-remove-frame-by-deleting t "\ @@ -30871,8 +30890,8 @@ Exit View mode and make the current buffer editable. ;;;*** -;;;### (autoloads nil "viper" "emulation/viper.el" (21607 56024 300834 -;;;;;; 853000)) +;;;### (autoloads nil "viper" "emulation/viper.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from emulation/viper.el (push (purecopy '(viper 3 14 1)) package--builtin-versions) @@ -30890,7 +30909,7 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'. ;;;*** ;;;### (autoloads nil "warnings" "emacs-lisp/warnings.el" (21607 -;;;;;; 56024 300834 853000)) +;;;;;; 54477 800124 118000)) ;;; Generated autoloads from emacs-lisp/warnings.el (defvar warning-prefix-function nil "\ @@ -30980,7 +30999,7 @@ this is equivalent to `display-warning', using ;;;*** -;;;### (autoloads nil "wdired" "wdired.el" (21607 56025 801549 101000)) +;;;### (autoloads nil "wdired" "wdired.el" (21607 54478 800121 42000)) ;;; Generated autoloads from wdired.el (push (purecopy '(wdired 2 0)) package--builtin-versions) @@ -30998,8 +31017,8 @@ See `wdired-mode'. ;;;*** -;;;### (autoloads nil "webjump" "net/webjump.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "webjump" "net/webjump.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from net/webjump.el (autoload 'webjump "webjump" "\ @@ -31016,7 +31035,7 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke ;;;*** ;;;### (autoloads nil "which-func" "progmodes/which-func.el" (21607 -;;;;;; 56059 303525 127000)) +;;;;;; 54478 800121 42000)) ;;; Generated autoloads from progmodes/which-func.el (put 'which-func-format 'risky-local-variable t) (put 'which-func-current 'risky-local-variable t) @@ -31046,8 +31065,8 @@ in certain major modes. ;;;*** -;;;### (autoloads nil "whitespace" "whitespace.el" (21607 56059 804396 -;;;;;; 982000)) +;;;### (autoloads nil "whitespace" "whitespace.el" (21630 19673 940150 +;;;;;; 833000)) ;;; Generated autoloads from whitespace.el (push (purecopy '(whitespace 13 2 2)) package--builtin-versions) @@ -31145,6 +31164,7 @@ Interactively, it reads one of the following chars: C-i toggle indentation SPACEs visualization (via `indent-tabs-mode') I toggle indentation SPACEs visualization i toggle indentation TABs visualization + C-t toggle big indentation visualization C-a toggle SPACEs after TAB visualization (via `indent-tabs-mode') A toggle SPACEs after TAB: SPACEs visualization a toggle SPACEs after TAB: TABs visualization @@ -31174,6 +31194,7 @@ The valid symbols are: indentation toggle indentation SPACEs visualization indentation::tab toggle indentation SPACEs visualization indentation::space toggle indentation TABs visualization + big-indent toggle big indentation visualization space-after-tab toggle SPACEs after TAB visualization space-after-tab::tab toggle SPACEs after TAB: SPACEs visualization space-after-tab::space toggle SPACEs after TAB: TABs visualization @@ -31215,6 +31236,7 @@ Interactively, it accepts one of the following chars: C-i toggle indentation SPACEs visualization (via `indent-tabs-mode') I toggle indentation SPACEs visualization i toggle indentation TABs visualization + C-t toggle big indentation visualization C-a toggle SPACEs after TAB visualization (via `indent-tabs-mode') A toggle SPACEs after TAB: SPACEs visualization a toggle SPACEs after TAB: TABs visualization @@ -31244,6 +31266,7 @@ The valid symbols are: indentation toggle indentation SPACEs visualization indentation::tab toggle indentation SPACEs visualization indentation::space toggle indentation TABs visualization + big-indent toggle big indentation visualization space-after-tab toggle SPACEs after TAB visualization space-after-tab::tab toggle SPACEs after TAB: SPACEs visualization space-after-tab::space toggle SPACEs after TAB: TABs visualization @@ -31361,43 +31384,7 @@ documentation. (autoload 'whitespace-report "whitespace" "\ Report some whitespace problems in buffer. -Return nil if there is no whitespace problem; otherwise, return -non-nil. - -If FORCE is non-nil or \\[universal-argument] was pressed just -before calling `whitespace-report' interactively, it forces -`whitespace-style' to have: - - empty - trailing - indentation - space-before-tab - space-after-tab - -If REPORT-IF-BOGUS is non-nil, it reports only when there are any -whitespace problems in buffer. - -Report if some of the following whitespace problems exist: - -* If `indent-tabs-mode' is non-nil: - empty 1. empty lines at beginning of buffer. - empty 2. empty lines at end of buffer. - trailing 3. SPACEs or TABs at end of line. - indentation 4. 8 or more SPACEs at beginning of line. - space-before-tab 5. SPACEs before TAB. - space-after-tab 6. 8 or more SPACEs after TAB. - -* If `indent-tabs-mode' is nil: - empty 1. empty lines at beginning of buffer. - empty 2. empty lines at end of buffer. - trailing 3. SPACEs or TABs at end of line. - indentation 4. TABS at beginning of line. - space-before-tab 5. SPACEs before TAB. - space-after-tab 6. 8 or more SPACEs after TAB. - -See `whitespace-style' for documentation. -See also `whitespace-cleanup' and `whitespace-cleanup-region' for -cleaning up these problems. +Perform `whitespace-report-region' on the current buffer. \(fn &optional FORCE REPORT-IF-BOGUS)" t nil) @@ -31412,13 +31399,14 @@ before calling `whitespace-report-region' interactively, it forces `whitespace-style' to have: empty + trailing indentation space-before-tab - trailing space-after-tab -If REPORT-IF-BOGUS is non-nil, it reports only when there are any -whitespace problems in buffer. +If REPORT-IF-BOGUS is t, it reports only when there are any +whitespace problems in buffer; if it is `never', it does not +report problems. Report if some of the following whitespace problems exist: @@ -31446,8 +31434,8 @@ cleaning up these problems. ;;;*** -;;;### (autoloads nil "wid-browse" "wid-browse.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "wid-browse" "wid-browse.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from wid-browse.el (autoload 'widget-browse-at "wid-browse" "\ @@ -31475,8 +31463,8 @@ if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "wid-edit" "wid-edit.el" (21607 56059 804396 -;;;;;; 982000)) +;;;### (autoloads nil "wid-edit" "wid-edit.el" (21634 58813 900130 +;;;;;; 256000)) ;;; Generated autoloads from wid-edit.el (autoload 'widgetp "wid-edit" "\ @@ -31518,8 +31506,8 @@ Setup current buffer so editing string widgets works. ;;;*** -;;;### (autoloads nil "windmove" "windmove.el" (21607 56025 801549 -;;;;;; 101000)) +;;;### (autoloads nil "windmove" "windmove.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from windmove.el (autoload 'windmove-left "windmove" "\ @@ -31571,7 +31559,7 @@ Default MODIFIER is 'shift. ;;;*** -;;;### (autoloads nil "winner" "winner.el" (21607 56059 804396 982000)) +;;;### (autoloads nil "winner" "winner.el" (21607 54478 800121 42000)) ;;; Generated autoloads from winner.el (defvar winner-mode nil "\ @@ -31594,7 +31582,7 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. ;;;*** -;;;### (autoloads nil "woman" "woman.el" (21607 56059 804396 982000)) +;;;### (autoloads nil "woman" "woman.el" (21607 54478 800121 42000)) ;;; Generated autoloads from woman.el (push (purecopy '(woman 0 551)) package--builtin-versions) @@ -31643,7 +31631,7 @@ Default bookmark handler for Woman buffers. ;;;*** -;;;### (autoloads nil "xml" "xml.el" (21607 56025 801549 101000)) +;;;### (autoloads nil "xml" "xml.el" (21607 54478 800121 42000)) ;;; Generated autoloads from xml.el (autoload 'xml-parse-file "xml" "\ @@ -31699,8 +31687,8 @@ Both features can be combined by providing a cons cell ;;;*** -;;;### (autoloads nil "xmltok" "nxml/xmltok.el" (21607 56025 301574 -;;;;;; 889000)) +;;;### (autoloads nil "xmltok" "nxml/xmltok.el" (21607 54478 300138 +;;;;;; 641000)) ;;; Generated autoloads from nxml/xmltok.el (autoload 'xmltok-get-declared-encoding-position "xmltok" "\ @@ -31718,8 +31706,53 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT. ;;;*** -;;;### (autoloads nil "xt-mouse" "xt-mouse.el" (21607 56059 804396 -;;;;;; 982000)) +;;;### (autoloads nil "xref" "progmodes/xref.el" (21667 56163 185621 +;;;;;; 290000)) +;;; Generated autoloads from progmodes/xref.el + +(autoload 'xref-pop-marker-stack "xref" "\ +Pop back to where \\[xref-find-definitions] was last invoked. + +\(fn)" t nil) + +(autoload 'xref-find-definitions "xref" "\ +Find the definition of the identifier at point. +With prefix argument or when there's no identifier at point, +prompt for it. + +\(fn IDENTIFIER)" t nil) + +(autoload 'xref-find-definitions-other-window "xref" "\ +Like `xref-find-definitions' but switch to the other window. + +\(fn IDENTIFIER)" t nil) + +(autoload 'xref-find-definitions-other-frame "xref" "\ +Like `xref-find-definitions' but switch to the other frame. + +\(fn IDENTIFIER)" t nil) + +(autoload 'xref-find-references "xref" "\ +Find references to the identifier at point. +With prefix argument, prompt for the identifier. + +\(fn IDENTIFIER)" t nil) + +(autoload 'xref-find-apropos "xref" "\ +Find all meaningful symbols that match PATTERN. +The argument has the same meaning as in `apropos'. + +\(fn PATTERN)" t nil) + (define-key esc-map "." #'xref-find-definitions) + (define-key esc-map "," #'xref-pop-marker-stack) + (define-key esc-map [?\C-.] #'xref-find-apropos) + (define-key ctl-x-4-map "." #'xref-find-definitions-other-window) + (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame) + +;;;*** + +;;;### (autoloads nil "xt-mouse" "xt-mouse.el" (21607 54478 800121 +;;;;;; 42000)) ;;; Generated autoloads from xt-mouse.el (defvar xterm-mouse-mode nil "\ @@ -31748,7 +31781,7 @@ down the SHIFT key while pressing the mouse button. ;;;*** -;;;### (autoloads nil "yenc" "gnus/yenc.el" (21607 56024 801559 72000)) +;;;### (autoloads nil "yenc" "gnus/yenc.el" (21607 54478 300138 641000)) ;;; Generated autoloads from gnus/yenc.el (autoload 'yenc-decode-region "yenc" "\ @@ -31763,7 +31796,7 @@ Extract file name from an yenc header. ;;;*** -;;;### (autoloads nil "zone" "play/zone.el" (21607 56025 301574 889000)) +;;;### (autoloads nil "zone" "play/zone.el" (21607 54478 800121 42000)) ;;; Generated autoloads from play/zone.el (autoload 'zone "zone" "\ @@ -31795,21 +31828,21 @@ Zone out, completely. ;;;;;; "calendar/diary-loaddefs.el" "calendar/hol-loaddefs.el" "cdl.el" ;;;;;; "cedet/cedet-cscope.el" "cedet/cedet-files.el" "cedet/cedet-global.el" ;;;;;; "cedet/cedet-idutils.el" "cedet/ede/auto.el" "cedet/ede/autoconf-edit.el" -;;;;;; "cedet/ede/base.el" "cedet/ede/cpp-root.el" "cedet/ede/custom.el" -;;;;;; "cedet/ede/dired.el" "cedet/ede/emacs.el" "cedet/ede/files.el" -;;;;;; "cedet/ede/generic.el" "cedet/ede/linux.el" "cedet/ede/loaddefs.el" -;;;;;; "cedet/ede/locate.el" "cedet/ede/make.el" "cedet/ede/makefile-edit.el" -;;;;;; "cedet/ede/pconf.el" "cedet/ede/pmake.el" "cedet/ede/proj-archive.el" -;;;;;; "cedet/ede/proj-aux.el" "cedet/ede/proj-comp.el" "cedet/ede/proj-elisp.el" -;;;;;; "cedet/ede/proj-info.el" "cedet/ede/proj-misc.el" "cedet/ede/proj-obj.el" -;;;;;; "cedet/ede/proj-prog.el" "cedet/ede/proj-scheme.el" "cedet/ede/proj-shared.el" -;;;;;; "cedet/ede/proj.el" "cedet/ede/project-am.el" "cedet/ede/shell.el" -;;;;;; "cedet/ede/simple.el" "cedet/ede/source.el" "cedet/ede/speedbar.el" -;;;;;; "cedet/ede/srecode.el" "cedet/ede/system.el" "cedet/ede/util.el" -;;;;;; "cedet/semantic/analyze.el" "cedet/semantic/analyze/complete.el" -;;;;;; "cedet/semantic/analyze/debug.el" "cedet/semantic/analyze/fcn.el" -;;;;;; "cedet/semantic/analyze/refs.el" "cedet/semantic/bovine.el" -;;;;;; "cedet/semantic/bovine/c.el" "cedet/semantic/bovine/debug.el" +;;;;;; "cedet/ede/base.el" "cedet/ede/config.el" "cedet/ede/cpp-root.el" +;;;;;; "cedet/ede/custom.el" "cedet/ede/detect.el" "cedet/ede/dired.el" +;;;;;; "cedet/ede/emacs.el" "cedet/ede/files.el" "cedet/ede/generic.el" +;;;;;; "cedet/ede/linux.el" "cedet/ede/loaddefs.el" "cedet/ede/locate.el" +;;;;;; "cedet/ede/make.el" "cedet/ede/makefile-edit.el" "cedet/ede/pconf.el" +;;;;;; "cedet/ede/pmake.el" "cedet/ede/proj-archive.el" "cedet/ede/proj-aux.el" +;;;;;; "cedet/ede/proj-comp.el" "cedet/ede/proj-elisp.el" "cedet/ede/proj-info.el" +;;;;;; "cedet/ede/proj-misc.el" "cedet/ede/proj-obj.el" "cedet/ede/proj-prog.el" +;;;;;; "cedet/ede/proj-scheme.el" "cedet/ede/proj-shared.el" "cedet/ede/proj.el" +;;;;;; "cedet/ede/project-am.el" "cedet/ede/shell.el" "cedet/ede/simple.el" +;;;;;; "cedet/ede/source.el" "cedet/ede/speedbar.el" "cedet/ede/srecode.el" +;;;;;; "cedet/ede/system.el" "cedet/ede/util.el" "cedet/semantic/analyze.el" +;;;;;; "cedet/semantic/analyze/complete.el" "cedet/semantic/analyze/debug.el" +;;;;;; "cedet/semantic/analyze/fcn.el" "cedet/semantic/analyze/refs.el" +;;;;;; "cedet/semantic/bovine.el" "cedet/semantic/bovine/c.el" "cedet/semantic/bovine/debug.el" ;;;;;; "cedet/semantic/bovine/el.el" "cedet/semantic/bovine/gcc.el" ;;;;;; "cedet/semantic/bovine/make.el" "cedet/semantic/bovine/scm.el" ;;;;;; "cedet/semantic/chart.el" "cedet/semantic/complete.el" "cedet/semantic/ctxt.el" @@ -31843,14 +31876,13 @@ Zone out, completely. ;;;;;; "cedet/srecode/loaddefs.el" "cedet/srecode/map.el" "cedet/srecode/mode.el" ;;;;;; "cedet/srecode/semantic.el" "cedet/srecode/srt.el" "cedet/srecode/table.el" ;;;;;; "cedet/srecode/template.el" "cedet/srecode/texi.el" "cus-dep.el" -;;;;;; "dframe.el" "dired-aux.el" "dired-x.el" "dos-fns.el" "dos-vars.el" -;;;;;; "dos-w32.el" "dynamic-setting.el" "emacs-lisp/authors.el" -;;;;;; "emacs-lisp/avl-tree.el" "emacs-lisp/bindat.el" "emacs-lisp/byte-opt.el" -;;;;;; "emacs-lisp/cl-extra.el" "emacs-lisp/cl-loaddefs.el" "emacs-lisp/cl-macs.el" -;;;;;; "emacs-lisp/cl-seq.el" "emacs-lisp/cl.el" "emacs-lisp/eieio-base.el" -;;;;;; "emacs-lisp/eieio-custom.el" "emacs-lisp/eieio-datadebug.el" -;;;;;; "emacs-lisp/eieio-opt.el" "emacs-lisp/eieio-speedbar.el" -;;;;;; "emacs-lisp/gulp.el" "emacs-lisp/lisp-mnt.el" "emacs-lisp/package-x.el" +;;;;;; "dframe.el" "dired-aux.el" "dired-x.el" "dom.el" "dos-fns.el" +;;;;;; "dos-vars.el" "dos-w32.el" "dynamic-setting.el" "emacs-lisp/avl-tree.el" +;;;;;; "emacs-lisp/bindat.el" "emacs-lisp/byte-opt.el" "emacs-lisp/cl-extra.el" +;;;;;; "emacs-lisp/cl-loaddefs.el" "emacs-lisp/cl-macs.el" "emacs-lisp/cl-seq.el" +;;;;;; "emacs-lisp/cl.el" "emacs-lisp/eieio-base.el" "emacs-lisp/eieio-custom.el" +;;;;;; "emacs-lisp/eieio-datadebug.el" "emacs-lisp/eieio-opt.el" +;;;;;; "emacs-lisp/eieio-speedbar.el" "emacs-lisp/lisp-mnt.el" "emacs-lisp/package-x.el" ;;;;;; "emacs-lisp/smie.el" "emacs-lisp/subr-x.el" "emacs-lisp/tcover-ses.el" ;;;;;; "emacs-lisp/tcover-unsafep.el" "emulation/cua-gmrk.el" "emulation/edt-lk201.el" ;;;;;; "emulation/edt-mapper.el" "emulation/edt-pc.el" "emulation/edt-vt100.el" @@ -31868,11 +31900,11 @@ Zone out, completely. ;;;;;; "eshell/esh-module.el" "eshell/esh-opt.el" "eshell/esh-proc.el" ;;;;;; "eshell/esh-util.el" "eshell/esh-var.el" "ezimage.el" "format-spec.el" ;;;;;; "fringe.el" "generic-x.el" "gnus/compface.el" "gnus/gnus-async.el" -;;;;;; "gnus/gnus-bcklg.el" "gnus/gnus-cite.el" "gnus/gnus-cus.el" -;;;;;; "gnus/gnus-demon.el" "gnus/gnus-dup.el" "gnus/gnus-eform.el" -;;;;;; "gnus/gnus-ems.el" "gnus/gnus-icalendar.el" "gnus/gnus-int.el" -;;;;;; "gnus/gnus-logic.el" "gnus/gnus-mh.el" "gnus/gnus-salt.el" -;;;;;; "gnus/gnus-score.el" "gnus/gnus-setup.el" "gnus/gnus-srvr.el" +;;;;;; "gnus/gnus-bcklg.el" "gnus/gnus-cite.el" "gnus/gnus-cloud.el" +;;;;;; "gnus/gnus-cus.el" "gnus/gnus-demon.el" "gnus/gnus-dup.el" +;;;;;; "gnus/gnus-eform.el" "gnus/gnus-ems.el" "gnus/gnus-icalendar.el" +;;;;;; "gnus/gnus-int.el" "gnus/gnus-logic.el" "gnus/gnus-mh.el" +;;;;;; "gnus/gnus-salt.el" "gnus/gnus-score.el" "gnus/gnus-srvr.el" ;;;;;; "gnus/gnus-topic.el" "gnus/gnus-undo.el" "gnus/gnus-util.el" ;;;;;; "gnus/gnus-uu.el" "gnus/gnus-vm.el" "gnus/gssapi.el" "gnus/ietf-drums.el" ;;;;;; "gnus/legacy-gnus-agent.el" "gnus/mail-parse.el" "gnus/mail-prsvr.el" @@ -31915,11 +31947,11 @@ Zone out, completely. ;;;;;; "mh-e/mh-loaddefs.el" "mh-e/mh-mime.el" "mh-e/mh-print.el" ;;;;;; "mh-e/mh-scan.el" "mh-e/mh-search.el" "mh-e/mh-seq.el" "mh-e/mh-show.el" ;;;;;; "mh-e/mh-speed.el" "mh-e/mh-thread.el" "mh-e/mh-tool-bar.el" -;;;;;; "mh-e/mh-utils.el" "mh-e/mh-xface.el" "mouse-copy.el" "mouse.el" -;;;;;; "mwheel.el" "net/dns.el" "net/eudc-vars.el" "net/eudcb-bbdb.el" -;;;;;; "net/eudcb-ldap.el" "net/eudcb-mab.el" "net/eudcb-ph.el" -;;;;;; "net/hmac-def.el" "net/hmac-md5.el" "net/imap.el" "net/ldap.el" -;;;;;; "net/mairix.el" "net/sasl-cram.el" "net/sasl-digest.el" "net/sasl.el" +;;;;;; "mh-e/mh-utils.el" "mh-e/mh-xface.el" "mouse-copy.el" "mwheel.el" +;;;;;; "net/dns.el" "net/eudc-vars.el" "net/eudcb-bbdb.el" "net/eudcb-ldap.el" +;;;;;; "net/eudcb-mab.el" "net/eudcb-ph.el" "net/hmac-def.el" "net/hmac-md5.el" +;;;;;; "net/imap.el" "net/ldap.el" "net/mairix.el" "net/newsticker.el" +;;;;;; "net/nsm.el" "net/sasl-cram.el" "net/sasl-digest.el" "net/sasl.el" ;;;;;; "net/shr-color.el" "net/soap-client.el" "net/soap-inspect.el" ;;;;;; "net/socks.el" "net/tls.el" "net/tramp-adb.el" "net/tramp-cache.el" ;;;;;; "net/tramp-cmds.el" "net/tramp-compat.el" "net/tramp-gvfs.el" @@ -31965,22 +31997,23 @@ Zone out, completely. ;;;;;; "progmodes/ebnf-otz.el" "progmodes/ebnf-yac.el" "progmodes/idlw-complete-structtag.el" ;;;;;; "progmodes/idlw-help.el" "progmodes/idlw-toolbar.el" "progmodes/mantemp.el" ;;;;;; "progmodes/xscheme.el" "ps-def.el" "ps-mule.el" "ps-samp.el" -;;;;;; "saveplace.el" "sb-image.el" "scroll-bar.el" "select.el" -;;;;;; "soundex.el" "subdirs.el" "tempo.el" "textmodes/bib-mode.el" -;;;;;; "textmodes/makeinfo.el" "textmodes/page-ext.el" "textmodes/refbib.el" -;;;;;; "textmodes/refer.el" "textmodes/reftex-auc.el" "textmodes/reftex-dcr.el" -;;;;;; "textmodes/reftex-ref.el" "textmodes/reftex-sel.el" "textmodes/reftex-toc.el" -;;;;;; "textmodes/texnfo-upd.el" "timezone.el" "tooltip.el" "tree-widget.el" -;;;;;; "url/url-about.el" "url/url-cookie.el" "url/url-dired.el" -;;;;;; "url/url-domsuf.el" "url/url-expand.el" "url/url-ftp.el" -;;;;;; "url/url-future.el" "url/url-history.el" "url/url-imap.el" -;;;;;; "url/url-methods.el" "url/url-nfs.el" "url/url-proxy.el" +;;;;;; "saveplace.el" "sb-image.el" "scroll-bar.el" "soundex.el" +;;;;;; "subdirs.el" "tempo.el" "textmodes/bib-mode.el" "textmodes/makeinfo.el" +;;;;;; "textmodes/page-ext.el" "textmodes/refbib.el" "textmodes/refer.el" +;;;;;; "textmodes/reftex-auc.el" "textmodes/reftex-cite.el" "textmodes/reftex-dcr.el" +;;;;;; "textmodes/reftex-global.el" "textmodes/reftex-index.el" +;;;;;; "textmodes/reftex-parse.el" "textmodes/reftex-ref.el" "textmodes/reftex-sel.el" +;;;;;; "textmodes/reftex-toc.el" "textmodes/texnfo-upd.el" "timezone.el" +;;;;;; "tooltip.el" "tree-widget.el" "url/url-about.el" "url/url-cookie.el" +;;;;;; "url/url-dired.el" "url/url-domsuf.el" "url/url-expand.el" +;;;;;; "url/url-ftp.el" "url/url-future.el" "url/url-history.el" +;;;;;; "url/url-imap.el" "url/url-methods.el" "url/url-nfs.el" "url/url-proxy.el" ;;;;;; "url/url-vars.el" "vc/ediff-diff.el" "vc/ediff-init.el" "vc/ediff-merg.el" ;;;;;; "vc/ediff-ptch.el" "vc/ediff-vers.el" "vc/ediff-wind.el" ;;;;;; "vc/pcvs-info.el" "vc/pcvs-parse.el" "vc/pcvs-util.el" "vc/vc-dav.el" -;;;;;; "vcursor.el" "vt-control.el" "vt100-led.el" "w32-common-fns.el" -;;;;;; "w32-fns.el" "w32-vars.el" "x-dnd.el") (21628 23968 97140 -;;;;;; 527000)) +;;;;;; "vc/vc-filewise.el" "vcursor.el" "vt-control.el" "vt100-led.el" +;;;;;; "w32-fns.el" "w32-vars.el" "x-dnd.el") (21669 11479 568273 +;;;;;; 504000)) ;;;*** diff --git a/lisp/leim/quail/latin-post.el b/lisp/leim/quail/latin-post.el index bd21ff0b8f1..e8957eb9b63 100644 --- a/lisp/leim/quail/latin-post.el +++ b/lisp/leim/quail/latin-post.el @@ -2299,6 +2299,7 @@ Doubling the postfix separates the letter and postfix: e.g. a'' -> a' ("z." ?ż) ("z~" ?ž) + (" __" [" _"]) ("!//" ["!/"]) ("///" ["//"]) ("<<<" ["<<"]) diff --git a/lisp/leim/quail/sisheng.el b/lisp/leim/quail/sisheng.el index b03ab01980b..e43bf0ac5cb 100644 --- a/lisp/leim/quail/sisheng.el +++ b/lisp/leim/quail/sisheng.el @@ -249,42 +249,39 @@ Example: nve5 -> nüe ;; Call quail-make-sisheng-rules for all syllables in sisheng-syllable-table. ;; -(let ((case-table-save (current-case-table)) - sisheng-list) - (set-case-table (standard-case-table)) +(let (sisheng-list) (dolist (syllable sisheng-syllable-table) (setq sisheng-list - (append (quail-make-sisheng-rules syllable) - sisheng-list))) + (append (quail-make-sisheng-rules syllable) + sisheng-list))) (dolist (syllable sisheng-syllable-table) (setq sisheng-list - (append (quail-make-sisheng-rules (upcase-initials syllable)) - sisheng-list))) + (append (quail-make-sisheng-rules (upcase-initials syllable)) + sisheng-list))) (dolist (syllable sisheng-syllable-table) (setq sisheng-list - (append (quail-make-sisheng-rules (upcase syllable)) - sisheng-list))) + (append (quail-make-sisheng-rules (upcase syllable)) + sisheng-list))) (eval `(quail-define-rules - ,@sisheng-list - - ("lv5" ["lü"]) - ("lve5" ["lüe"]) - ("nv5" ["nü"]) - ("nve5" ["nüe"]) - - ("Lv5" ["Lü"]) - ("Lve5" ["Lüe"]) - ("Nv5" ["Nü"]) - ("Nve5" ["Nüe"]) - - ("LV5" ["LÜ"]) - ("LVE5" ["LÜE"]) - ("NV5" ["NÜ"]) - ("NVE5" ["NÜE"]))) - (set-case-table case-table-save)) + ,@sisheng-list + + ("lv5" ["lü"]) + ("lve5" ["lüe"]) + ("nv5" ["nü"]) + ("nve5" ["nüe"]) + + ("Lv5" ["Lü"]) + ("Lve5" ["Lüe"]) + ("Nv5" ["Nü"]) + ("Nve5" ["Nüe"]) + + ("LV5" ["LÜ"]) + ("LVE5" ["LÜE"]) + ("NV5" ["NÜ"]) + ("NVE5" ["NÜE"])))) ;; Local Variables: ;; coding: utf-8 diff --git a/lisp/let-alist.el b/lisp/let-alist.el new file mode 100644 index 00000000000..80b72d37ac9 --- /dev/null +++ b/lisp/let-alist.el @@ -0,0 +1,142 @@ +;;; let-alist.el --- Easily let-bind values of an assoc-list by their names -*- lexical-binding: t; -*- + +;; Copyright (C) 2014-2015 Free Software Foundation, Inc. + +;; Author: Artur Malabarba <bruce.connor.am@gmail.com> +;; Maintainer: Artur Malabarba <bruce.connor.am@gmail.com> +;; Version: 1.0.3 +;; Keywords: extensions lisp +;; Prefix: let-alist +;; Separator: - + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This package offers a single macro, `let-alist'. This macro takes a +;; first argument (whose value must be an alist) and a body. +;; +;; The macro expands to a let form containing body, where each dotted +;; symbol inside body is let-bound to their cdrs in the alist. Dotted +;; symbol is any symbol starting with a `.'. Only those present in +;; the body are let-bound and this search is done at compile time. +;; +;; For instance, the following code +;; +;; (let-alist alist +;; (if (and .title .body) +;; .body +;; .site +;; .site.contents)) +;; +;; essentially expands to +;; +;; (let ((.title (cdr (assq 'title alist))) +;; (.body (cdr (assq 'body alist))) +;; (.site (cdr (assq 'site alist))) +;; (.site.contents (cdr (assq 'contents (cdr (assq 'site alist)))))) +;; (if (and .title .body) +;; .body +;; .site +;; .site.contents)) +;; +;; If you nest `let-alist' invocations, the inner one can't access +;; the variables of the outer one. You can, however, access alists +;; inside the original alist by using dots inside the symbol, as +;; displayed in the example above by the `.site.contents'. +;; +;;; Code: + + +(defun let-alist--deep-dot-search (data) + "Return alist of symbols inside DATA that start with a `.'. +Perform a deep search and return an alist where each car is the +symbol, and each cdr is the same symbol without the `.'." + (cond + ((symbolp data) + (let ((name (symbol-name data))) + (when (string-match "\\`\\." name) + ;; Return the cons cell inside a list, so it can be appended + ;; with other results in the clause below. + (list (cons data (intern (replace-match "" nil nil name))))))) + ((not (listp data)) nil) + (t (apply #'append + (mapcar #'let-alist--deep-dot-search data))))) + +(defun let-alist--access-sexp (symbol variable) + "Return a sexp used to access SYMBOL inside VARIABLE." + (let* ((clean (let-alist--remove-dot symbol)) + (name (symbol-name clean))) + (if (string-match "\\`\\." name) + clean + (let-alist--list-to-sexp + (mapcar #'intern (nreverse (split-string name "\\."))) + variable)))) + +(defun let-alist--list-to-sexp (list var) + "Turn symbols LIST into recursive calls to `cdr' `assq' on VAR." + `(cdr (assq ',(car list) + ,(if (cdr list) (let-alist--list-to-sexp (cdr list) var) + var)))) + +(defun let-alist--remove-dot (symbol) + "Return SYMBOL, sans an initial dot." + (let ((name (symbol-name symbol))) + (if (string-match "\\`\\." name) + (intern (replace-match "" nil nil name)) + symbol))) + + +;;; The actual macro. +;;;###autoload +(defmacro let-alist (alist &rest body) + "Let-bind dotted symbols to their cdrs in ALIST and execute BODY. +Dotted symbol is any symbol starting with a `.'. Only those present +in BODY are let-bound and this search is done at compile time. + +For instance, the following code + + (let-alist alist + (if (and .title .body) + .body + .site + .site.contents)) + +essentially expands to + + (let ((.title (cdr (assq 'title alist))) + (.body (cdr (assq 'body alist))) + (.site (cdr (assq 'site alist))) + (.site.contents (cdr (assq 'contents (cdr (assq 'site alist)))))) + (if (and .title .body) + .body + .site + .site.contents)) + +If you nest `let-alist' invocations, the inner one can't access +the variables of the outer one. You can, however, access alists +inside the original alist by using dots inside the symbol, as +displayed in the example above." + (declare (indent 1) (debug t)) + (let ((var (make-symbol "alist"))) + `(let ((,var ,alist)) + (let ,(mapcar (lambda (x) `(,(car x) ,(let-alist--access-sexp (car x) var))) + (delete-dups (let-alist--deep-dot-search body))) + ,@body)))) + +(provide 'let-alist) + +;;; let-alist.el ends here diff --git a/lisp/linum.el b/lisp/linum.el index 23e560596b3..de15274314c 100644 --- a/lisp/linum.el +++ b/lisp/linum.el @@ -138,6 +138,14 @@ Linum mode is a buffer-local minor mode." (mapc #'delete-overlay linum-available) (setq linum-available nil)))) +(defun linum--face-width (face) + (let ((info (font-info (face-font face))) + width) + (setq width (aref info 11)) + (if (<= width 0) + (setq width (aref info 10))) + width)) + (defun linum-update-window (win) "Update line numbers for the portion visible in window WIN." (goto-char (window-start win)) @@ -178,6 +186,10 @@ Linum mode is a buffer-local minor mode." (let ((inhibit-point-motion-hooks t)) (forward-line)) (setq line (1+ line))) + (when (display-graphic-p) + (setq width (ceiling + (/ (* width 1.0 (linum--face-width 'linum)) + (frame-char-width))))) (set-window-margins win width (cdr (window-margins win))))) (defun linum-after-change (beg end _len) diff --git a/lisp/loadup.el b/lisp/loadup.el index ef60130ca51..96641c8a268 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -46,8 +46,7 @@ ;; Add subdirectories to the load-path for files that might get ;; autoloaded when bootstrapping. ;; This is because PATH_DUMPLOADSEARCH is just "../lisp". -(if (or (equal (nth 3 command-line-args) "bootstrap") - (equal (nth 4 command-line-args) "bootstrap") +(if (or (equal (member "bootstrap" command-line-args) '("bootstrap")) ;; FIXME this is irritatingly fragile. (equal (nth 4 command-line-args) "unidata-gen.el") (equal (nth 7 command-line-args) "unidata-gen-files") @@ -70,11 +69,15 @@ (message "Using load-path %s" load-path) -(if (or (member (nth 3 command-line-args) '("dump" "bootstrap")) - (member (nth 4 command-line-args) '("dump" "bootstrap"))) - ;; To reduce the size of dumped Emacs, we avoid making huge - ;; char-tables. - (setq inhibit-load-charset-map t)) +;; This is a poor man's `last', since we haven't loaded subr.el yet. +(if (or (equal (member "bootstrap" command-line-args) '("bootstrap")) + (equal (member "dump" command-line-args) '("dump"))) + (progn + ;; To reduce the size of dumped Emacs, we avoid making huge char-tables. + (setq inhibit-load-charset-map t) + ;; --eval gets handled too late. + (defvar load--prefer-newer load-prefer-newer) + (setq load-prefer-newer t))) ;; We don't want to have any undo records in the dumped Emacs. (set-buffer "*scratch*") @@ -116,13 +119,13 @@ (let ((macroexp--pending-eager-loads '(skip))) (load "emacs-lisp/pcase")) ;; Re-load macroexp so as to eagerly macro-expand its uses of pcase. - (load "emacs-lisp/macroexp")) + (let ((max-lisp-eval-depth (* 2 max-lisp-eval-depth))) + (load "emacs-lisp/macroexp"))) (load "cus-face") (load "faces") ; after here, `defface' may be used. (load "button") -(load "startup") ;; We don't want to store loaddefs.el in the repository because it is ;; a generated file; but it is required in order to compile the lisp files. @@ -189,6 +192,7 @@ (load "indent") (load "frame") +(load "startup") (load "term/tty-colors") (load "font-core") ;; facemenu must be loaded before font-lock, because `facemenu-keymap' @@ -198,12 +202,10 @@ (load "font-lock") (load "jit-lock") -(if (fboundp 'track-mouse) - (progn - (load "mouse") - (and (boundp 'x-toolkit-scroll-bars) - (load "scroll-bar")) - (load "select"))) +(load "mouse") +(if (boundp 'x-toolkit-scroll-bars) + (load "scroll-bar")) +(load "select") (load "emacs-lisp/timer") (load "isearch") (load "rfn-eshadow") @@ -215,6 +217,7 @@ (load "textmodes/paragraphs") (load "progmodes/prog-mode") (load "emacs-lisp/lisp-mode") +(load "progmodes/elisp-mode") (load "textmodes/text-mode") (load "textmodes/fill") (load "newcomment") @@ -249,7 +252,6 @@ (load "w32-vars") (load "term/w32-win") (load "disp-table") - (load "w32-common-fns") (when (eq system-type 'windows-nt) (load "w32-fns") (load "ls-lisp") @@ -280,6 +282,7 @@ (load "vc/ediff-hook") (load "uniquify") (load "electric") +(load "emacs-lisp/eldoc") (if (not (eq system-type 'ms-dos)) (load "tooltip")) ;; This file doesn't exist when building a development version of Emacs @@ -308,17 +311,13 @@ lost after dumping"))) ;; file primitive. So the only workable solution to support building ;; in non-ASCII directories is to manipulate unibyte strings in the ;; current locale's encoding. -(if (and (or (equal (nth 3 command-line-args) "dump") - (equal (nth 4 command-line-args) "dump") - (equal (nth 3 command-line-args) "bootstrap") - (equal (nth 4 command-line-args) "bootstrap")) +(if (and (member (car (last command-line-args)) '("dump" "bootstrap")) (multibyte-string-p default-directory)) (error "default-directory must be unibyte when dumping Emacs!")) ;; Determine which last version number to use ;; based on the executables that now exist. -(if (and (or (equal (nth 3 command-line-args) "dump") - (equal (nth 4 command-line-args) "dump")) +(if (and (equal (last command-line-args) '("dump")) (not (eq system-type 'ms-dos))) (let* ((base (concat "emacs-" emacs-version ".")) (exelen (if (eq system-type 'windows-nt) -4)) @@ -337,8 +336,7 @@ lost after dumping"))) (message "Finding pointers to doc strings...") -(if (or (equal (nth 3 command-line-args) "dump") - (equal (nth 4 command-line-args) "dump")) +(if (equal (last command-line-args) '("dump")) (Snarf-documentation "DOC") (condition-case nil (Snarf-documentation "DOC") @@ -365,6 +363,12 @@ lost after dumping"))) (remove-hook 'after-load-functions (lambda (f) (garbage-collect))) +(if (boundp 'load--prefer-newer) + (progn + (setq load-prefer-newer load--prefer-newer) + (put 'load-prefer-newer 'standard-value load--prefer-newer) + (makunbound 'load--prefer-newer))) + (setq inhibit-load-charset-map nil) (clear-charset-maps) (garbage-collect) @@ -396,8 +400,7 @@ lost after dumping"))) (if (null (garbage-collect)) (setq pure-space-overflow t)) -(if (or (member (nth 3 command-line-args) '("dump" "bootstrap")) - (member (nth 4 command-line-args) '("dump" "bootstrap"))) +(if (member (car (last command-line-args)) '("dump" "bootstrap")) (progn (message "Dumping under the name emacs") (condition-case () @@ -413,8 +416,7 @@ lost after dumping"))) (if (not (or (eq system-type 'ms-dos) ;; Don't bother adding another name if we're just ;; building bootstrap-emacs. - (equal (nth 3 command-line-args) "bootstrap") - (equal (nth 4 command-line-args) "bootstrap"))) + (equal (last command-line-args) '("bootstrap")))) (let ((name (concat "emacs-" emacs-version)) (exe (if (eq system-type 'windows-nt) ".exe" ""))) (while (string-match "[^-+_.a-zA-Z0-9]+" name) @@ -435,7 +437,7 @@ lost after dumping"))) ;; this file must be loaded each time Emacs is run. ;; So run the startup code now. First, remove `-l loadup' from args. -(if (and (equal (nth 1 command-line-args) "-l") +(if (and (member (nth 1 command-line-args) '("-l" "--load")) (equal (nth 2 command-line-args) "loadup")) (setcdr command-line-args (nthcdr 3 command-line-args))) diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 98c0e2ef35f..c3d5705531e 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -113,6 +113,47 @@ update the dependent variables." :type 'boolean :group 'ls-lisp) +(defcustom ls-lisp-use-string-collate + (cond ((memq ls-lisp-emulation '(MacOS UNIX)) nil) + (t t)) ; GNU/Linux or MS-Windows emulate GNU ls + "Non-nil causes ls-lisp to sort files in locale-dependent collation order. + +A value of nil means use ordinary string comparison (see `compare-strings') +for sorting files. A non-nil value uses `string-collate-lessp' instead, +which more closely emulates what GNU `ls' does. + +On GNU/Linux systems, if the locale's codeset specifies UTF-8, as +in \"en_US.UTF-8\", the collation order follows the Unicode +Collation Algorithm (UCA), which places together file names that +differ only in punctuation characters. On MS-Windows, customize +the option `ls-lisp-UCA-like-collation' to a non-nil value to get +similar behavior." + :version "25.1" + :set-after '(ls-lisp-emulation) + :type 'boolean + :group 'ls-lisp) + +(defcustom ls-lisp-UCA-like-collation t + "Non-nil means force ls-lisp use a collation order compatible with UCA. + +UCA is the Unicode Collation Algorithm. GNU/Linux systems automatically +follow it in their string-collation routines if the locale specifies +UTF-8 as its codeset. On MS-Windows, customize this option to a non-nil +value to get similar behavior. + +When this option is non-nil, and `ls-lisp-use-string-collate' is also +non-nil, the collation order produced on MS-Windows will ignore +punctuation and symbol characters, which will, for example, place +\`.foo' near `foo'. See the documentation of `string-collate-lessp' +and `w32-collate-ignore-punctuation' for more details. + +This option is ignored on platforms other than MS-Windows; to +control the collation ordering of the file names on those other +systems, set your locale instead." + :version "25.1" + :type 'boolean + :group 'ls-lisp) + (defcustom ls-lisp-dirs-first (eq ls-lisp-emulation 'MS-Windows) "Non-nil causes ls-lisp to sort directories first in any ordering. \(Or last if it is reversed.) Follows Microsoft Windows Explorer." @@ -232,7 +273,7 @@ The Lisp emulation does not run any external programs or shells. It supports ordinary shell wildcards if `ls-lisp-support-shell-wildcards' is non-nil; otherwise, it interprets wildcards as regular expressions to match file names. It does not support all `ls' switches -- those -that work are: A a B C c F G g h i n R r S s t U u X. The l switch +that work are: A a B C c F G g h i n R r S s t U u v X. The l switch is assumed to be always present and cannot be turned off." (if ls-lisp-use-insert-directory-program (funcall orig-fun @@ -495,11 +536,81 @@ Responds to the window width as ls should but may not!" result)) (defsubst ls-lisp-string-lessp (s1 s2) - "Return t if string S1 is less than string S2 in lexicographic order. + "Return t if string S1 should sort before string S2. +Case is significant if `ls-lisp-ignore-case' is nil. +Uses `string-collate-lessp' if `ls-lisp-use-string-collate' is non-nil, +\`compare-strings' otherwise. +On GNU/Linux systems, if the locale specifies UTF-8 as the codeset, +the sorting order will place together file names that differ only +by punctuation characters, like `.emacs' and `emacs'. To have a +similar behavior on MS-Windows, customize `ls-lisp-UCA-like-collation' +to a non-nil value." + (let ((w32-collate-ignore-punctuation ls-lisp-UCA-like-collation)) + (if ls-lisp-use-string-collate + (string-collate-lessp s1 s2 nil ls-lisp-ignore-case) + (let ((u (compare-strings s1 0 nil s2 0 nil ls-lisp-ignore-case))) + (and (numberp u) (< u 0)))))) + +(defun ls-lisp-version-lessp (s1 s2) + "Return t if versioned string S1 should sort before versioned string S2. + Case is significant if `ls-lisp-ignore-case' is nil. -Unibyte strings are converted to multibyte for comparison." - (let ((u (compare-strings s1 0 nil s2 0 nil ls-lisp-ignore-case))) - (and (numberp u) (< u 0)))) +This is the same as string-lessp (with the exception of case +insensitivity), but sequences of digits are compared numerically, +as a whole, in the same manner as the `strverscmp' function available +in some standard C libraries does." + (let ((i1 0) + (i2 0) + (len1 (length s1)) + (len2 (length s2)) + (val 0) + ni1 ni2 e1 e2 found-2-numbers-p) + (while (and (< i1 len1) (< i2 len2) (zerop val)) + (unless found-2-numbers-p + (setq ni1 (string-match "[0-9]+" s1 i1) + e1 (match-end 0)) + (setq ni2 (string-match "[0-9]+" s2 i2) + e2 (match-end 0))) + (cond + ((and ni1 ni2) + (cond + ((and (> ni1 i1) (> ni2 i2)) + ;; Compare non-numerical part as strings. + (setq val (compare-strings s1 i1 ni1 s2 i2 ni2 ls-lisp-ignore-case) + i1 ni1 + i2 ni2 + found-2-numbers-p t)) + ((and (= ni1 i1) (= ni2 i2)) + (setq found-2-numbers-p nil) + ;; Compare numerical parts as integral and/or fractional parts. + (let* ((sub1 (substring s1 ni1 e1)) + (sub2 (substring s2 ni2 e2)) + ;; "Fraction" is a numerical sequence with leading zeros. + (fr1 (string-match "\\`0+" sub1)) + (fr2 (string-match "\\`0+" sub2))) + (cond + ((and fr1 fr2) ; two fractions, the shortest wins + (setq val (- val (- (length sub1) (length sub2))))) + (fr1 ; a fraction is always less than an integral + (setq val (- ni1))) + (fr2 + (setq val ni2))) + (if (zerop val) ; fall back on numerical comparison + (setq val (- (string-to-number sub1) + (string-to-number sub2)))) + (setq i1 e1 + i2 e2))) + (t + (setq val (compare-strings s1 i1 nil s2 i2 nil ls-lisp-ignore-case) + i1 len1 + i2 len2)))) + (t (setq val (compare-strings s1 i1 nil s2 i2 nil ls-lisp-ignore-case) + i1 len1 + i2 len2))) + (and (eq val t) (setq val 0))) + (if (zerop val) + (setq val (- len1 len2))) + (< val 0))) (defun ls-lisp-handle-switches (file-alist switches) "Return new FILE-ALIST sorted according to SWITCHES. @@ -527,6 +638,9 @@ SWITCHES is a list of characters. Default sorting is alphabetic." (ls-lisp-string-lessp (ls-lisp-extension (car x)) (ls-lisp-extension (car y))))) + ((memq ?v switches) + (lambda (x y) ; sorted by version number + (ls-lisp-version-lessp (car x) (car y)))) (t (lambda (x y) ; sorted alphabetically (ls-lisp-string-lessp (car x) (car y)))))))) diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index fdde6257788..8cd59006d8d 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -43,11 +43,6 @@ (define-obsolete-variable-alias 'report-emacs-bug-pretest-address 'report-emacs-bug-address "24.1") -(defcustom report-emacs-bug-address "bug-gnu-emacs@gnu.org" - "Address of mailing list for GNU Emacs bugs." - :group 'emacsbug - :type 'string) - (defcustom report-emacs-bug-no-confirmation nil "If non-nil, suppress the confirmations asked for the sake of novice users." :group 'emacsbug @@ -261,6 +256,8 @@ usually do not have translators for other languages.\n\n"))) (insert "Configured using:\n `configure " system-configuration-options "'\n\n") (fill-region (line-beginning-position -1) (point))) + (insert "Configured features:\n" system-configuration-features "\n\n") + (fill-region (line-beginning-position -1) (point)) (insert "Important settings:\n") (mapc (lambda (var) diff --git a/lisp/mail/hashcash.el b/lisp/mail/hashcash.el index 89e54928d82..70170654f67 100644 --- a/lisp/mail/hashcash.el +++ b/lisp/mail/hashcash.el @@ -47,10 +47,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) ; for case (defgroup hashcash nil diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 58901cb1342..855a4c2d0ff 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -1508,8 +1508,7 @@ If so restore the actual mbox message collection." '(rmail-font-lock-keywords t t nil nil (font-lock-maximum-size . nil) - (font-lock-fontify-buffer-function . rmail-fontify-buffer-function) - (font-lock-unfontify-buffer-function . rmail-unfontify-buffer-function) + (font-lock-dont-widen . t) (font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode)))) (make-local-variable 'require-final-newline) (setq require-final-newline nil) @@ -3449,47 +3448,66 @@ STATE non-nil means mark as deleted." "Delete this message and stay on it." (interactive) (rmail-set-attribute rmail-deleted-attr-index t) - (run-hooks 'rmail-delete-message-hook)) + (run-hooks 'rmail-delete-message-hook) + (let ((del-msg rmail-current-message)) + (if (rmail-summary-exists) + (rmail-select-summary + (rmail-summary-mark-deleted del-msg))))) -(defun rmail-undelete-previous-message () +(defun rmail-undelete-previous-message (count) "Back up to deleted message, select it, and undelete it." - (interactive) + (interactive "p") (set-buffer rmail-buffer) - (let ((msg rmail-current-message)) - (while (and (> msg 0) - (not (rmail-message-deleted-p msg))) - (setq msg (1- msg))) - (if (= msg 0) - (error "No previous deleted message") - (if (/= msg rmail-current-message) - (rmail-show-message msg)) - (rmail-set-attribute rmail-deleted-attr-index nil) - (if (rmail-summary-exists) - (with-current-buffer rmail-summary-buffer - (rmail-summary-mark-undeleted msg))) - (rmail-maybe-display-summary)))) - -(defun rmail-delete-forward (&optional backward) + (let (value) + (dotimes (i count) + (let ((msg rmail-current-message)) + (while (and (> msg 0) + (not (rmail-message-deleted-p msg))) + (setq msg (1- msg))) + (if (= msg 0) + (error "No previous deleted message") + (if (/= msg rmail-current-message) + (rmail-show-message msg)) + (rmail-set-attribute rmail-deleted-attr-index nil) + (if (rmail-summary-exists) + (with-current-buffer rmail-summary-buffer + (rmail-summary-mark-undeleted msg)))))) + (rmail-maybe-display-summary))) + +(defun rmail-delete-forward (&optional count) "Delete this message and move to next nondeleted one. Deleted messages stay in the file until the \\[rmail-expunge] command is given. -With prefix argument, delete and move backward. +Optional argument COUNT (interactively, prefix argument) is a repeat count; +negative argument means move backwards instead of forwards. Returns t if a new message is displayed after the delete, or nil otherwise." - (interactive "P") - (rmail-set-attribute rmail-deleted-attr-index t) - (run-hooks 'rmail-delete-message-hook) - (let ((del-msg rmail-current-message)) - (if (rmail-summary-exists) - (rmail-select-summary - (rmail-summary-mark-deleted del-msg))) - (prog1 (rmail-next-undeleted-message (if backward -1 1)) - (rmail-maybe-display-summary)))) + (interactive "p") + (if (not count) (setq count 1)) + (let (value backward) + (if (< count 0) + (setq count (- count) backward t)) + (dotimes (i count) + (rmail-set-attribute rmail-deleted-attr-index t) + (run-hooks 'rmail-delete-message-hook) + (let ((del-msg rmail-current-message)) + (if (rmail-summary-exists) + (rmail-select-summary + (rmail-summary-mark-deleted del-msg))) + (setq value (rmail-next-undeleted-message (if backward -1 1))))) + (rmail-maybe-display-summary) + value)) -(defun rmail-delete-backward () +(defun rmail-delete-backward (&optional count) "Delete this message and move to previous nondeleted one. -Deleted messages stay in the file until the \\[rmail-expunge] command is given." - (interactive) - (rmail-delete-forward t)) +Deleted messages stay in the file until the \\[rmail-expunge] command is given. +Optional argument COUNT (interactively, prefix argument) is a repeat count; +negative argument means move forwards instead of backwards. + +Returns t if a new message is displayed after the delete, or nil otherwise." + + (interactive "p") + (if (not count) (setq count 1)) + (rmail-delete-forward (- count))) ;; Expunging. @@ -4298,31 +4316,21 @@ This has an effect only if a summary buffer exists." (defun rmail-unfontify-buffer-function () ;; This function's symbol is bound to font-lock-fontify-unbuffer-function. - (let ((modified (buffer-modified-p)) - (buffer-undo-list t) (inhibit-read-only t) - before-change-functions after-change-functions - buffer-file-name buffer-file-truename) + (with-silent-modifications (save-restriction (widen) (remove-hook 'rmail-show-message-hook 'rmail-fontify-message t) (remove-text-properties (point-min) (point-max) '(rmail-fontified nil)) - (font-lock-default-unfontify-buffer) - (and (not modified) (buffer-modified-p) - (restore-buffer-modified-p nil))))) + (font-lock-default-unfontify-buffer)))) (defun rmail-fontify-message () ;; Fontify the current message if it is not already fontified. (if (text-property-any (point-min) (point-max) 'rmail-fontified nil) - (let ((modified (buffer-modified-p)) - (buffer-undo-list t) (inhibit-read-only t) - before-change-functions after-change-functions - buffer-file-name buffer-file-truename) + (with-silent-modifications (save-excursion (save-match-data (add-text-properties (point-min) (point-max) '(rmail-fontified t)) - (font-lock-fontify-region (point-min) (point-max)) - (and (not modified) (buffer-modified-p) - (restore-buffer-modified-p nil))))))) + (font-lock-fontify-region (point-min) (point-max))))))) ;;; Speedbar support for RMAIL files. (defcustom rmail-speedbar-match-folder-regexp "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$" @@ -4505,11 +4513,11 @@ encoded string (and the same mask) will decode the string." ;; change it in one of the calls to `epa-decrypt-region'. (save-excursion - (let (decrypts) + (let (decrypts (mime (rmail-mime-message-p))) (goto-char (point-min)) ;; Turn off mime processing. - (when (and (rmail-mime-message-p) + (when (and mime (not (get-text-property (point-min) 'rmail-mime-hidden))) (rmail-mime)) @@ -4518,10 +4526,19 @@ encoded string (and the same mask) will decode the string." (goto-char (point-min)) (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t) (let ((coding-system-for-read coding-system-for-read) - armor-start armor-end after-end) + (case-fold-search t) + unquote + armor-start armor-prefix armor-end after-end) + (setq armor-start (match-beginning 0) - armor-end (re-search-forward "^-----END PGP MESSAGE-----$" - nil t)) + armor-prefix (buffer-substring + (line-beginning-position) + armor-start) + armor-end (re-search-forward + (concat "^" + armor-prefix + "-----END PGP MESSAGE-----$") + nil t)) (unless armor-end (error "Encryption armor beginning has no matching end")) (goto-char armor-start) @@ -4529,30 +4546,49 @@ encoded string (and the same mask) will decode the string." ;; Because epa--find-coding-system-for-mime-charset not autoloaded. (require 'epa) - ;; Use the charset specified in the armor. - (unless coding-system-for-read - (if (re-search-forward "^Charset: \\(.*\\)" armor-end t) - (setq coding-system-for-read - (epa--find-coding-system-for-mime-charset - (intern (downcase (match-string 1))))))) - ;; Advance over this armor. (goto-char armor-end) (setq after-end (- (point-max) armor-end)) + (when mime + (save-excursion + (goto-char armor-start) + (re-search-backward "^--" nil t) + (save-restriction + (narrow-to-region (point) armor-start) + + ;; Use the charset specified in the armor. + (unless coding-system-for-read + (if (re-search-forward "^Charset: \\(.*\\)" nil t) + (setq coding-system-for-read + (epa--find-coding-system-for-mime-charset + (intern (downcase (match-string 1))))))) + + (goto-char (point-min)) + (if (re-search-forward "^[ \t]*Content-transfer-encoding[ \t]*:[ \t]*quoted-printable[ \t]*$" nil t) + (setq unquote t))))) + + (when unquote + (let ((inhibit-read-only t)) + (mail-unquote-printable-region armor-start + (- (point-max) after-end)))) + ;; Decrypt it, maybe in place, maybe making new buffer. (epa-decrypt-region - armor-start armor-end + armor-start (- (point-max) after-end) ;; Call back this function to prepare the output. (lambda () (let ((inhibit-read-only t)) - (delete-region armor-start armor-end) + (delete-region armor-start (- (point-max) after-end)) (goto-char armor-start) (current-buffer)))) (push (list armor-start (- (point-max) after-end)) decrypts))) + (unless decrypts + (error "Nothing to decrypt")) + (when (and decrypts (rmail-buffers-swapped-p)) (when (y-or-n-p "Replace the original message? ") (setq decrypts (nreverse decrypts)) @@ -4677,7 +4713,7 @@ With prefix argument N moves forward N messages with these labels. ;;;*** -;;;### (autoloads nil "rmailmm" "rmailmm.el" "93b910705d5481b37cace27d89df0217") +;;;### (autoloads nil "rmailmm" "rmailmm.el" "43e0b9f680c4d2581640b286bd4b3107") ;;; Generated autoloads from rmailmm.el (autoload 'rmail-mime "rmailmm" "\ @@ -4774,7 +4810,7 @@ If prefix argument REVERSE is non-nil, sorts in reverse order. ;;;*** -;;;### (autoloads nil "rmailsum" "rmailsum.el" "7a34d3e46d5b99c22c1c9d012e29a94b") +;;;### (autoloads nil "rmailsum" "rmailsum.el" "e3943ef45946f10b9b5cab8097d7f271") ;;; Generated autoloads from rmailsum.el (autoload 'rmail-summary "rmailsum" "\ diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index 34857f05371..120d517f55c 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el @@ -131,6 +131,26 @@ automatically display the image in the buffer." :version "23.2" :group 'rmail-mime) +(defcustom rmail-mime-render-html-function + (cond ((fboundp 'libxml-parse-html-region) 'rmail-mime-render-html-shr) + ((executable-find "lynx") 'rmail-mime-render-html-lynx) + (t nil)) + "Function to convert HTML to text. Called with buffer containing HTML +extracted from message in a temporary buffer. Converts to text in current +buffer. If NIL, display HTML source." + :group 'rmail + :version "25.1" + :type '(choice function (const nil))) + +(defcustom rmail-mime-prefer-html + ;; Default to preferring HTML parts, but only if we have a renderer + (if rmail-mime-render-html-function t nil) + "If non-nil, default to showing HTML part rather than text part +when both are available" + :group 'rmail + :version "25.1" + :type 'boolean) + ;;; End of user options. ;;; Global variables that always have let-binding when referred. @@ -150,6 +170,10 @@ processing MIME.") The value is usually nil, and bound to non-nil while inserting MIME entities.") +(defvar rmail-mime-searching nil + "Bound to T inside `rmail-search-mime-message' to suppress expensive +operations such as HTML decoding") + ;;; MIME-entity object (defun rmail-mime-entity (type disposition transfer-encoding @@ -631,6 +655,72 @@ HEADER is a header component of a MIME-entity object (see (insert-image (create-image data (cdr bulk-data) t)) (insert "\n"))) +(defun rmail-mime-insert-html (entity) + "Decode, render, and insert html from MIME-entity ENTITY." + (let ((body (rmail-mime-entity-body entity)) + (transfer-encoding (rmail-mime-entity-transfer-encoding entity)) + (charset (cdr (assq 'charset (cdr (rmail-mime-entity-type entity))))) + (buffer (current-buffer)) + coding-system) + (if charset (setq coding-system (coding-system-from-name charset))) + (or (and coding-system (coding-system-p coding-system)) + (setq coding-system 'undecided)) + (with-temp-buffer + (set-buffer-multibyte nil) + (setq buffer-undo-list t) + (insert-buffer-substring rmail-mime-mbox-buffer + (aref body 0) (aref body 1)) + (cond ((string= transfer-encoding "base64") + (ignore-errors (base64-decode-region (point-min) (point-max)))) + ((string= transfer-encoding "quoted-printable") + (quoted-printable-decode-region (point-min) (point-max)))) + (decode-coding-region (point-min) (point) coding-system) + (if (and + (or (not rmail-mime-coding-system) (consp rmail-mime-coding-system)) + (not (eq (coding-system-base coding-system) 'us-ascii))) + (setq rmail-mime-coding-system coding-system)) + ;; Convert html in temporary buffer to text and insert in original buffer + (let ((source-buffer (current-buffer))) + (with-current-buffer buffer + (let ((start (point))) + (if rmail-mime-render-html-function + (funcall rmail-mime-render-html-function source-buffer) + (insert-buffer-substring source-buffer)) + (rmail-mime-fix-inserted-faces start))))))) + +(defun rmail-mime-render-html-shr (source-buffer) + (let ((dom (with-current-buffer source-buffer + (libxml-parse-html-region (point-min) (point-max)))) + ;; Image retrieval happens asynchronously, but meanwhile + ;; `rmail-swap-buffers' may have been run, leaving + ;; `shr-image-fetched' trying to insert the image in the wrong buffer. + (shr-inhibit-images t) + ;; Bind shr-width to nil to force shr-insert-document break + ;; the lines at the window margin. The default is + ;; fill-column, whose default value is too small, and screws + ;; up display of the quoted messages. + shr-width) + (shr-insert-document dom))) + +(defun rmail-mime-render-html-lynx (source-buffer) + (let ((destination-buffer (current-buffer))) + (with-current-buffer source-buffer + (call-process-region (point-min) (point-max) + "lynx" nil destination-buffer nil + "-stdin" "-dump" "-force_html" + "-dont_wrap_pre" "-width=70")))) + +;; Put font-lock-face properties matching face properties on text +;; inserted, e.g., by shr, in text from START to point. +(defun rmail-mime-fix-inserted-faces (start) + (while (< start (point)) + (let ((face (get-text-property start 'face)) + (next (next-single-property-change + start 'face (current-buffer) (point)))) + (if face ; anything to do? + (put-text-property start next 'font-lock-face face)) + (setq start next)))) + (defun rmail-mime-toggle-button (button) "Hide or show the body of the MIME-entity associated with BUTTON." (save-excursion @@ -675,6 +765,8 @@ directly." (setq size (/ (* size 7) 3))))))) (cond + ((string-match "text/html" content-type) + (setq type 'html)) ((string-match "text/" content-type) (setq type 'text)) ((string-match "image/\\(.*\\)" content-type) @@ -784,6 +876,12 @@ directly." (if (rmail-mime-display-body new) (cond ((eq (cdr bulk-data) 'text) (rmail-mime-insert-decoded-text entity)) + ((eq (cdr bulk-data) 'html) + ;; Render HTML if display single message, but if searching + ;; don't render but just search HTML itself. + (if rmail-mime-searching + (rmail-mime-insert-decoded-text entity) + (rmail-mime-insert-html entity))) ((cdr bulk-data) (rmail-mime-insert-image entity)) (t @@ -918,18 +1016,28 @@ The other arguments are the same as `rmail-mime-multipart-handler'." (setq entities (nreverse entities)) (if (string-match "alternative" subtype) ;; Find the best entity to show, and hide all the others. - (let (best second) + ;; If rmail-mime-prefer-html is set, html is best, then plain. + ;; If not, plain is best, then html. + ;; Then comes any other text part. + ;; If thereto of the same type, earlier entities in the message (later + ;; in the reverse list) are preferred. + (let (best best-priority) (dolist (child entities) (if (string= (or (car (rmail-mime-entity-disposition child)) (car content-disposition)) "inline") - (if (string-match "text/plain" - (car (rmail-mime-entity-type child))) - (setq best child) - (if (string-match "text/.*" - (car (rmail-mime-entity-type child))) - (setq second child))))) - (or best (not second) (setq best second)) + (let ((type (car (rmail-mime-entity-type child)))) + (if (string-match "text/" type) + ;; Consider all inline text parts + (let ((priority + (cond ((string-match "text/html" type) + (if rmail-mime-prefer-html 1 2)) + ((string-match "text/plain" type) + (if rmail-mime-prefer-html 2 1)) + (t 3)))) + (if (or (null best) (<= priority best-priority)) + (setq best child + best-priority priority))))))) (dolist (child entities) (unless (eq best child) (aset (rmail-mime-entity-body child) 2 nil) @@ -1114,6 +1222,8 @@ modified." (cond ((string-match "multipart/.*" (car content-type)) (save-restriction (narrow-to-region (1- end) (point-max)) + (if (zerop (length parse-tag)) ; top level of message + (aset new 1 (aset tagline 2 nil))) ; don't show tagline (setq children (rmail-mime-process-multipart content-type content-disposition @@ -1134,6 +1244,12 @@ modified." (aset (rmail-mime-entity-tagline msg) 2 nil) (setq children (list msg) handler 'rmail-mime-insert-multipart)))) + ((and is-inline (string-match "text/html" (car content-type))) + ;; Display tagline, so part can be detached + (aset new 1 (aset tagline 2 t)) + (aset new 2 (aset body 2 t)) ; display body also. + (setq handler 'rmail-mime-insert-bulk)) + ;; Inline non-HTML text ((and is-inline (string-match "text/" (car content-type))) ;; Don't need a tagline. (aset new 1 (aset tagline 2 nil)) @@ -1186,10 +1302,6 @@ If an error occurs, return an error message string." (new (aref (rmail-mime-entity-display entity) 1))) ;; Show header. (aset new 0 (aset (rmail-mime-entity-header entity) 2 t)) - ;; Show tagline if and only if body is not shown. - (if (aref new 2) - (aset new 1 (aset (rmail-mime-entity-tagline entity) 2 nil)) - (aset new 1 (aset (rmail-mime-entity-tagline entity) 2 t))) entity))) (error (format "%s" err))))) @@ -1390,7 +1502,8 @@ This is the usual value of `rmail-insert-mime-forwarded-message-function'." "Function to set in `rmail-search-mime-message-function' (which see)." (save-restriction (narrow-to-region (rmail-msgbeg msg) (rmail-msgend msg)) - (let* ((rmail-mime-mbox-buffer (current-buffer)) + (let* ((rmail-mime-searching t) ; mark inside search + (rmail-mime-mbox-buffer (current-buffer)) (rmail-mime-view-buffer rmail-view-buffer) (header-end (save-excursion (re-search-forward "^$" nil 'move) (point))) diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index 788dfcc16c0..7ac147b87d7 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -914,7 +914,10 @@ a negative argument means to delete and move backward." (unless (numberp count) (setq count 1)) (let (end del-msg (backward (< count 0))) - (while (/= count 0) + (while (and (/= count 0) + ;; Don't waste time if we are at the beginning + ;; and trying to go backward. + (not (and backward (bobp)))) (rmail-summary-goto-msg) (with-current-buffer rmail-buffer (rmail-delete-message) @@ -924,11 +927,13 @@ a negative argument means to delete and move backward." (save-excursion (beginning-of-line) (looking-at " *[0-9]+D"))) (forward-line (if backward -1 1))) + (setq count + (if (> count 0) (1- count) (1+ count))) ;; It looks ugly to move to the empty line at end of buffer. + ;; And don't waste time after hitting the end. (and (eobp) (not backward) - (forward-line -1)) - (setq count - (if (> count 0) (1- count) (1+ count)))))) + (progn (setq count 0) + (forward-line -1)))))) (defun rmail-summary-delete-backward (&optional count) "Delete this message and move to previous nondeleted one. @@ -939,8 +944,9 @@ a negative argument means to delete and move forward." (rmail-summary-delete-forward (- count))) (defun rmail-summary-mark-deleted (&optional n undel) - ;; Since third arg is t, this only alters the summary, not the Rmail buf. - (and n (rmail-summary-goto-msg n t t)) + (and n (not (eq n (rmail-summary-msg-number))) + ;; Since third arg is t, this only alters summary, not the Rmail buf. + (rmail-summary-goto-msg n t t)) (or (eobp) (not (overlay-get rmail-summary-overlay 'face)) (let ((buffer-read-only nil)) @@ -951,9 +957,9 @@ a negative argument means to delete and move forward." (progn (delete-char 1) (insert " "))) (delete-char 1) (insert "D")) - ;; Register a new summary line. + ;; Discard cached new summary line. (with-current-buffer rmail-buffer - (aset rmail-summary-vector (1- n) (rmail-create-summary-line n))))) + (aset rmail-summary-vector (1- n) nil)))) (beginning-of-line)) (defun rmail-summary-update-line (n) @@ -1002,7 +1008,7 @@ Optional prefix ARG means undelete ARG previous messages." (set-buffer rmail-buffer) (rmail-pop-to-buffer rmail-buffer)) (and (rmail-message-deleted-p rmail-current-message) - (rmail-undelete-previous-message)) + (rmail-undelete-previous-message 1)) (if rmail-enable-mime (rmail-pop-to-buffer rmail-buffer)) (rmail-pop-to-buffer rmail-summary-buffer)) @@ -1011,26 +1017,35 @@ Optional prefix ARG means undelete ARG previous messages." (defun rmail-summary-undelete-many (&optional n) "Undelete all deleted msgs, optional prefix arg N means undelete N prev msgs." (interactive "P") - (with-current-buffer rmail-buffer - (let* ((init-msg (if n rmail-current-message rmail-total-messages)) - (rmail-current-message init-msg) - (n (or n rmail-total-messages)) - (msgs-undeled 0)) - (while (and (> rmail-current-message 0) - (< msgs-undeled n)) - (if (rmail-message-deleted-p rmail-current-message) - (progn (rmail-set-attribute rmail-deleted-attr-index nil) - (setq msgs-undeled (1+ msgs-undeled)))) - (setq rmail-current-message (1- rmail-current-message))) - (set-buffer rmail-summary-buffer) - (setq rmail-current-message init-msg msgs-undeled 0) - (while (and (> rmail-current-message 0) - (< msgs-undeled n)) - (if (rmail-summary-deleted-p rmail-current-message) - (progn (rmail-summary-mark-undeleted rmail-current-message) - (setq msgs-undeled (1+ msgs-undeled)))) - (setq rmail-current-message (1- rmail-current-message)))) - (rmail-summary-goto-msg))) + (if n + (while (and (> n 0) (not (eobp))) + (rmail-summary-goto-msg) + (let (del-msg) + (when (rmail-summary-deleted-p) + (with-current-buffer rmail-buffer + (rmail-undelete-previous-message 1) + (setq del-msg rmail-current-message)) + (rmail-summary-mark-undeleted del-msg))) + (while (and (not (eobp)) + (save-excursion (beginning-of-line) + (looking-at " *[0-9]+ "))) + (forward-line 1)) + (setq n (1- n))) + (rmail-summary-goto-msg 1) + (dotimes (i rmail-total-messages) + (rmail-summary-goto-msg) + (let (del-msg) + (when (rmail-summary-deleted-p) + (with-current-buffer rmail-buffer + (rmail-undelete-previous-message 1) + (setq del-msg rmail-current-message)) + (rmail-summary-mark-undeleted del-msg))) + (if (not (eobp)) + (forward-line 1)))) + + ;; It looks ugly to move to the empty line at end of buffer. + (and (eobp) + (forward-line -1))) ;; Rmail Summary mode is suitable only for specially formatted data. (put 'rmail-summary-mode 'mode-class 'special) @@ -1188,6 +1203,13 @@ Search, the `unseen' attribute is restored.") (goto-char (posn-point (event-end event))) (rmail-summary-goto-msg)) +(defun rmail-summary-msg-number () + (save-excursion + (beginning-of-line) + (string-to-number + (buffer-substring (point) + (min (point-max) (+ 6 (point))))))) + (defun rmail-summary-goto-msg (&optional n nowarn skip-rmail) "Go to message N in the summary buffer and the Rmail buffer. If N is nil, use the message corresponding to point in the summary diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 7f683db6465..20de353295f 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -687,6 +687,7 @@ Returns an error if the server cannot be contacted." "smtpmail" process-buffer host port :type smtpmail-stream-type :return-list t + :warn-unless-encrypted ask-for-password :capability-command (format "EHLO %s\r\n" (smtpmail-fqdn)) :end-of-command "^[0-9]+ .*\r\n" :success "^2.*\n" @@ -733,7 +734,7 @@ Returns an error if the server cannot be contacted." (plist-get (cdr result) :capabilities) "\r\n"))) (let ((name - (with-case-table ascii-case-table + (with-case-table ascii-case-table ;FIXME: Why? (mapcar (lambda (s) (intern (downcase s))) (split-string (substring line 4) "[ ]"))))) (when (= (length name) 1) diff --git a/lisp/man.el b/lisp/man.el index 3731170e279..d9124c24e00 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -174,13 +174,12 @@ Any other value of `Man-notify-method' is equivalent to `meek'." (defcustom Man-width nil "Number of columns for which manual pages should be formatted. -If nil, the width of the window selected at the moment of man -invocation is used. If non-nil, the width of the frame selected -at the moment of man invocation is used. The value also can be a -positive integer." +If nil, use the width of the window where the manpage is displayed. +If non-nil, use the width of the frame where the manpage is displayed. +The value also can be a positive integer for a fixed width." :type '(choice (const :tag "Window width" nil) (const :tag "Frame width" t) - (integer :tag "Specific width" :value 65)) + (integer :tag "Fixed width" :value 65)) :group 'man) (defcustom Man-frame-parameters nil @@ -695,9 +694,8 @@ a \"/\" as a local filename. The function returns either `man-db' (with-temp-buffer (let ((default-directory ;; Ensure that `default-directory' exists and is readable. - (if (and (file-directory-p default-directory) - (file-readable-p default-directory)) - default-directory + (if (file-accessible-directory-p default-directory) + default-directory (expand-file-name "~/")))) (ignore-errors (call-process manual-program nil t nil "--help"))) @@ -932,12 +930,14 @@ test/automated/man-tests.el in the emacs repository." ;;;###autoload (defun man (man-args) "Get a Un*x manual page and put it in a buffer. -This command is the top-level command in the man package. It -runs a Un*x command to retrieve and clean a manpage in the +This command is the top-level command in the man package. +It runs a Un*x command to retrieve and clean a manpage in the background and places the results in a `Man-mode' browsing -buffer. See variable `Man-notify-method' for what happens when -the buffer is ready. If a buffer already exists for this man -page, it will display immediately. +buffer. The variable `Man-width' defines the number of columns in +formatted manual pages. The buffer is displayed immediately. +The variable `Man-notify-method' defines how the buffer is displayed. +If a buffer already exists for this man page, it will be displayed +without running the man command. For a manpage from a particular section, use either of the following. \"cat(1)\" is how cross-references appear and is @@ -1032,15 +1032,22 @@ names or descriptions. The pattern argument is usually an ;; ther is available). (when (or window-system (not (or (getenv "MANWIDTH") (getenv "COLUMNS")))) - ;; This isn't strictly correct, since we don't know how - ;; the page will actually be displayed, but it seems - ;; reasonable. + ;; Since the page buffer is displayed beforehand, + ;; we can select its window and get the window/frame width. (setenv "COLUMNS" (number-to-string (cond ((and (integerp Man-width) (> Man-width 0)) Man-width) - (Man-width (frame-width)) - ((window-width)))))) + (Man-width + (if (window-live-p (get-buffer-window (current-buffer) t)) + (with-selected-window (get-buffer-window (current-buffer) t) + (frame-width)) + (frame-width))) + (t + (if (window-live-p (get-buffer-window (current-buffer) t)) + (with-selected-window (get-buffer-window (current-buffer) t) + (window-width)) + (window-width))))))) ;; Since man-db 2.4.3-1, man writes plain text with no escape ;; sequences when stdout is not a tty. In 2.5.0, the following ;; env-var was added to allow control of this (see Debian Bug#340673). @@ -1059,33 +1066,45 @@ Return the buffer in which the manpage will appear." (message "Invoking %s %s in the background" manual-program man-args) (setq buffer (generate-new-buffer bufname)) (with-current-buffer buffer + (Man-notify-when-ready buffer) (setq buffer-undo-list t) (setq Man-original-frame (selected-frame)) - (setq Man-arguments man-args)) - (Man-start-calling - (if (fboundp 'start-process) - (set-process-sentinel - (start-process manual-program buffer - (if (memq system-type '(cygwin windows-nt)) - shell-file-name - "sh") - shell-command-switch - (format (Man-build-man-command) man-args)) - 'Man-bgproc-sentinel) - (let ((exit-status - (call-process shell-file-name nil (list buffer nil) nil - shell-command-switch - (format (Man-build-man-command) man-args))) - (msg "")) - (or (and (numberp exit-status) - (= exit-status 0)) - (and (numberp exit-status) - (setq msg - (format "exited abnormally with code %d" - exit-status))) - (setq msg exit-status)) - (Man-bgproc-sentinel bufname msg))))) - buffer)) + (setq Man-arguments man-args) + (Man-mode) + (setq mode-line-process + (concat " " (propertize (if Man-fontify-manpage-flag + "[formatting...]" + "[cleaning...]") + 'face 'mode-line-emphasis))) + (Man-start-calling + (if (fboundp 'start-process) + (let ((proc (start-process + manual-program buffer + (if (memq system-type '(cygwin windows-nt)) + shell-file-name + "sh") + shell-command-switch + (format (Man-build-man-command) man-args)))) + (set-process-sentinel proc 'Man-bgproc-sentinel) + (set-process-filter proc 'Man-bgproc-filter)) + (let* ((inhibit-read-only t) + (exit-status + (call-process shell-file-name nil (list buffer nil) nil + shell-command-switch + (format (Man-build-man-command) man-args))) + (msg "")) + (or (and (numberp exit-status) + (= exit-status 0)) + (and (numberp exit-status) + (setq msg + (format "exited abnormally with code %d" + exit-status))) + (setq msg exit-status)) + (if Man-fontify-manpage-flag + (Man-fontify-manpage) + (Man-cleanup-manpage)) + (Man-bgproc-sentinel bufname msg)))))) + buffer)) (defun Man-update-manpage () "Reformat current manpage by calling the man command again synchronously." @@ -1170,7 +1189,6 @@ See the variable `Man-notify-method' for the different notification behaviors." "Convert overstriking and underlining to the correct fonts. Same for the ANSI bold and normal escape sequences." (interactive) - (message "Please wait: formatting the %s man page..." Man-arguments) (goto-char (point-min)) ;; Fontify ANSI escapes. (let ((ansi-color-apply-face-function @@ -1185,7 +1203,7 @@ Same for the ANSI bold and normal escape sequences." ;; Multibyte characters exist. (progn (goto-char (point-min)) - (while (search-forward "__\b\b" nil t) + (while (and (search-forward "__\b\b" nil t) (not (eobp))) (backward-delete-char 4) (put-text-property (point) (1+ (point)) 'face 'Man-underline)) (goto-char (point-min)) @@ -1193,7 +1211,7 @@ Same for the ANSI bold and normal escape sequences." (backward-delete-char 4) (put-text-property (1- (point)) (point) 'face 'Man-underline)))) (goto-char (point-min)) - (while (search-forward "_\b" nil t) + (while (and (search-forward "_\b" nil t) (not (eobp))) (backward-delete-char 2) (put-text-property (point) (1+ (point)) 'face 'Man-underline)) (goto-char (point-min)) @@ -1225,8 +1243,7 @@ Same for the ANSI bold and normal escape sequences." (while (re-search-forward Man-heading-regexp nil t) (put-text-property (match-beginning 0) (match-end 0) - 'face 'Man-overstrike))) - (message "%s man page formatted" (Man-page-from-arguments Man-arguments))) + 'face 'Man-overstrike)))) (defun Man-highlight-references (&optional xref-man-type) "Highlight the references on mouse-over. @@ -1288,8 +1305,6 @@ Normally skip any jobs that should have been done by the sed script, but when called interactively, do those jobs even if the sed script would have done them." (interactive "p") - (message "Please wait: cleaning up the %s man page..." - Man-arguments) (if (or interactive (not Man-sed-script)) (progn (goto-char (point-min)) @@ -1311,8 +1326,35 @@ script would have done them." ;; their preceding chars (but don't put Man-overstrike). (Bug#5566) (goto-char (point-min)) (while (re-search-forward ".\b" nil t) (backward-delete-char 2)) - (Man-softhyphen-to-minus) - (message "%s man page cleaned up" Man-arguments)) + (Man-softhyphen-to-minus)) + +(defun Man-bgproc-filter (process string) + "Manpage background process filter. +When manpage command is run asynchronously, PROCESS is the process +object for the manpage command; when manpage command is run +synchronously, PROCESS is the name of the buffer where the manpage +command is run. Second argument STRING is the entire string of output." + (save-excursion + (let ((Man-buffer (process-buffer process))) + (if (null (buffer-name Man-buffer)) ;; deleted buffer + (set-process-buffer process nil) + + (with-current-buffer Man-buffer + (let ((inhibit-read-only t) + (beg (marker-position (process-mark process)))) + (save-excursion + (goto-char beg) + (insert string) + (save-restriction + (narrow-to-region + (save-excursion + (goto-char beg) + (line-beginning-position)) + (point)) + (if Man-fontify-manpage-flag + (Man-fontify-manpage) + (Man-cleanup-manpage))) + (set-marker (process-mark process) (point-max))))))))) (defun Man-bgproc-sentinel (process msg) "Manpage background process sentinel. @@ -1331,63 +1373,75 @@ manpage command." (set-process-buffer process nil)) (with-current-buffer Man-buffer - (let ((case-fold-search nil)) - (goto-char (point-min)) - (cond ((or (looking-at "No \\(manual \\)*entry for") - (looking-at "[^\n]*: nothing appropriate$")) - (setq err-mess (buffer-substring (point) - (progn - (end-of-line) (point))) - delete-buff t)) - - ;; "-k foo", successful exit, but no output (from man-db) - ;; ENHANCE-ME: share the check for -k with - ;; `Man-highlight-references'. The \\s- bits here are - ;; meant to allow for multiple options with -k among them. - ((and (string-match "\\(\\`\\|\\s-\\)-k\\s-" Man-arguments) - (eq (process-status process) 'exit) - (= (process-exit-status process) 0) - (= (point-min) (point-max))) - (setq err-mess (format "%s: no matches" Man-arguments) - delete-buff t)) - - ((or (stringp process) - (not (and (eq (process-status process) 'exit) - (= (process-exit-status process) 0)))) - (or (zerop (length msg)) - (progn - (setq err-mess - (concat (buffer-name Man-buffer) - ": process " - (let ((eos (1- (length msg)))) - (if (= (aref msg eos) ?\n) - (substring msg 0 eos) msg)))) - (goto-char (point-max)) - (insert (format "\nprocess %s" msg)))) - )) - (if delete-buff - (kill-buffer Man-buffer) - (if Man-fontify-manpage-flag - (Man-fontify-manpage) - (Man-cleanup-manpage)) - - (run-hooks 'Man-cooked-hook) - (Man-mode) - - (if (not Man-page-list) - (let ((args Man-arguments)) - (kill-buffer (current-buffer)) - (user-error "Can't find the %s manpage" - (Man-page-from-arguments args))) - (set-buffer-modified-p nil)))) - ;; Restore case-fold-search before calling - ;; Man-notify-when-ready because it may switch buffers. - - (if (not delete-buff) - (Man-notify-when-ready Man-buffer)) + (save-excursion + (let ((case-fold-search nil)) + (goto-char (point-min)) + (cond ((or (looking-at "No \\(manual \\)*entry for") + (looking-at "[^\n]*: nothing appropriate$")) + (setq err-mess (buffer-substring (point) + (progn + (end-of-line) (point))) + delete-buff t)) + + ;; "-k foo", successful exit, but no output (from man-db) + ;; ENHANCE-ME: share the check for -k with + ;; `Man-highlight-references'. The \\s- bits here are + ;; meant to allow for multiple options with -k among them. + ((and (string-match "\\(\\`\\|\\s-\\)-k\\s-" Man-arguments) + (eq (process-status process) 'exit) + (= (process-exit-status process) 0) + (= (point-min) (point-max))) + (setq err-mess (format "%s: no matches" Man-arguments) + delete-buff t)) + + ((or (stringp process) + (not (and (eq (process-status process) 'exit) + (= (process-exit-status process) 0)))) + (or (zerop (length msg)) + (progn + (setq err-mess + (concat (buffer-name Man-buffer) + ": process " + (let ((eos (1- (length msg)))) + (if (= (aref msg eos) ?\n) + (substring msg 0 eos) msg)))) + (goto-char (point-max)) + (insert (format "\nprocess %s" msg)))) + )) + (if delete-buff + (if (window-live-p (get-buffer-window Man-buffer t)) + (quit-restore-window + (get-buffer-window Man-buffer t) 'kill) + (kill-buffer Man-buffer)) + + (run-hooks 'Man-cooked-hook) + + (Man-build-page-list) + (Man-strip-page-headers) + (Man-unindent) + (Man-goto-page 1 t) + + (if (not Man-page-list) + (let ((args Man-arguments)) + (if (window-live-p (get-buffer-window (current-buffer) t)) + (quit-restore-window + (get-buffer-window (current-buffer) t) 'kill) + (kill-buffer (current-buffer))) + (message "Can't find the %s manpage" + (Man-page-from-arguments args))) + + (if Man-fontify-manpage-flag + (message "%s man page formatted" + (Man-page-from-arguments Man-arguments)) + (message "%s man page cleaned up" + (Man-page-from-arguments Man-arguments))) + (unless (and (processp process) + (not (eq (process-status process) 'exit))) + (setq mode-line-process nil)) + (set-buffer-modified-p nil))))) (if err-mess - (error "%s" err-mess)) + (message "%s" err-mess)) )))) (defun Man-page-from-arguments (args) @@ -1431,7 +1485,7 @@ The following man commands are available in the buffer. Try The following variables may be of some use. Try \"\\[describe-variable] <variable-name> RET\" for more information: -`Man-notify-method' What happens when manpage formatting is done. +`Man-notify-method' What happens when manpage is ready to display. `Man-downcase-section-letters-flag' Force section letters to lower case. `Man-circular-pages-flag' Treat multiple manpage list as circular. `Man-section-translations-alist' List of section numbers and their Un*x equiv. @@ -1460,11 +1514,7 @@ The following key bindings are currently in effect in the buffer: (set (make-local-variable 'outline-regexp) Man-heading-regexp) (set (make-local-variable 'outline-level) (lambda () 1)) (set (make-local-variable 'bookmark-make-record-function) - 'Man-bookmark-make-record) - (Man-build-page-list) - (Man-strip-page-headers) - (Man-unindent) - (Man-goto-page 1 t)) + 'Man-bookmark-make-record)) (defsubst Man-build-section-alist () "Build the list of manpage sections." @@ -1518,7 +1568,6 @@ The following key bindings are currently in effect in the buffer: (page-end (point-max)) (header "")) (goto-char page-start) - ;; (switch-to-buffer (current-buffer))(debug) (while (not (eobp)) (setq header (if (looking-at Man-page-header-regexp) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 25d41dcdd85..cd1a4d05b55 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -373,35 +373,31 @@ (bindings--define-key menu [set-tags-name] '(menu-item "Set Tags File Name..." visit-tags-table - :help "Tell Tags commands which tag table file to use")) + :visible (menu-bar-goto-uses-etags-p) + :help "Tell navigation commands which tag table file to use")) (bindings--define-key menu [separator-tag-file] - menu-bar-separator) + '(menu-item "--" nil :visible (menu-bar-goto-uses-etags-p))) + + (bindings--define-key menu [xref-pop] + '(menu-item "Back" xref-pop-marker-stack + :visible (and (featurep 'xref) + (not (xref-marker-stack-empty-p))) + :help "Back to the position of the last search")) - (bindings--define-key menu [apropos-tags] - '(menu-item "Tags Apropos..." tags-apropos + (bindings--define-key menu [xref-apropos] + '(menu-item "Find Apropos..." xref-find-apropos :help "Find function/variables whose names match regexp")) - (bindings--define-key menu [next-tag-otherw] - '(menu-item "Next Tag in Other Window" - menu-bar-next-tag-other-window - :enable (and (boundp 'tags-location-ring) - (not (ring-empty-p tags-location-ring))) - :help "Find next function/variable matching last tag name in another window")) - - (bindings--define-key menu [next-tag] - '(menu-item "Find Next Tag" - menu-bar-next-tag - :enable (and (boundp 'tags-location-ring) - (not (ring-empty-p tags-location-ring))) - :help "Find next function/variable matching last tag name")) - (bindings--define-key menu [find-tag-otherw] - '(menu-item "Find Tag in Other Window..." find-tag-other-window + + (bindings--define-key menu [xref-find-otherw] + '(menu-item "Find Definition in Other Window..." + xref-find-definitions-other-window :help "Find function/variable definition in another window")) - (bindings--define-key menu [find-tag] - '(menu-item "Find Tag..." find-tag + (bindings--define-key menu [xref-find-def] + '(menu-item "Find Definition..." xref-find-definitions :help "Find definition of function or variable")) - (bindings--define-key menu [separator-tags] + (bindings--define-key menu [separator-xref] menu-bar-separator) (bindings--define-key menu [end-of-buf] @@ -416,6 +412,9 @@ :help "Read a line number and go to that line")) menu)) +(defun menu-bar-goto-uses-etags-p () + (or (not (boundp 'xref-find-function)) + (eq xref-find-function 'etags-xref-find))) (defvar yank-menu (cons (purecopy "Select Yank") nil)) (fset 'yank-menu (cons 'keymap yank-menu)) @@ -470,17 +469,14 @@ [paste-from-menu]) ;; ns-win.el said: Change text to be more consistent with ;; surrounding menu items `paste', etc." - `(menu-item ,(if (featurep 'ns) "Select and Paste" - "Paste from Kill Menu") yank-menu + `(menu-item ,(if (featurep 'ns) "Select and Paste" "Paste from Kill Menu") + yank-menu :enable (and (cdr yank-menu) (not buffer-read-only)) :help "Choose a string from the kill ring and paste it")) (bindings--define-key menu [paste] '(menu-item "Paste" yank :enable (and (or - ;; Emacs compiled --without-x (or --with-ns) - ;; doesn't have x-selection-exists-p. - (and (fboundp 'x-selection-exists-p) - (x-selection-exists-p 'CLIPBOARD)) + (gui-call gui-selection-exists-p 'CLIPBOARD) (if (featurep 'ns) ; like paste-from-menu (cdr yank-menu) kill-ring)) @@ -517,16 +513,6 @@ menu)) -(defun menu-bar-next-tag-other-window () - "Find the next definition of the tag already specified." - (interactive) - (find-tag-other-window nil t)) - -(defun menu-bar-next-tag () - "Find the next definition of the tag already specified." - (interactive) - (find-tag nil t)) - (define-obsolete-function-alias 'menu-bar-kill-ring-save 'kill-ring-save "24.1") @@ -537,27 +523,26 @@ '(and mark-active (not buffer-read-only))) (put 'clipboard-kill-ring-save 'menu-enable 'mark-active) (put 'clipboard-yank 'menu-enable - '(and (or (not (fboundp 'x-selection-exists-p)) - (x-selection-exists-p) - (x-selection-exists-p 'CLIPBOARD)) + '(and (or (gui-call gui-selection-exists-p 'PRIMARY) + (gui-call gui-selection-exists-p 'CLIPBOARD)) (not buffer-read-only))) (defun clipboard-yank () "Insert the clipboard contents, or the last stretch of killed text." (interactive "*") - (let ((x-select-enable-clipboard t)) + (let ((gui-select-enable-clipboard t)) (yank))) (defun clipboard-kill-ring-save (beg end &optional region) - "Copy region to kill ring, and save in the X clipboard." + "Copy region to kill ring, and save in the GUI's clipboard." (interactive "r\np") - (let ((x-select-enable-clipboard t)) + (let ((gui-select-enable-clipboard t)) (kill-ring-save beg end region))) (defun clipboard-kill-region (beg end &optional region) - "Kill the region, and save it in the X clipboard." + "Kill the region, and save it in the GUI's clipboard." (interactive "r\np") - (let ((x-select-enable-clipboard t)) + (let ((gui-select-enable-clipboard t)) (kill-region beg end region))) (defun menu-bar-enable-clipboard () @@ -887,8 +872,33 @@ by \"Save Options\" in Custom buffers.") (interactive) (customize-set-variable 'scroll-bar-mode nil)) +(defun menu-bar-horizontal-scroll-bar () + "Display horizontal scroll bars on each window." + (interactive) + (customize-set-variable 'horizontal-scroll-bar-mode t)) + +(defun menu-bar-no-horizontal-scroll-bar () + "Turn off horizontal scroll bars." + (interactive) + (customize-set-variable 'horizontal-scroll-bar-mode nil)) + (defvar menu-bar-showhide-scroll-bar-menu (let ((menu (make-sparse-keymap "Scroll-bar"))) + (bindings--define-key menu [horizontal] + '(menu-item "Horizontal" + menu-bar-horizontal-scroll-bar + :help "Horizontal scroll bar" + :visible (horizontal-scroll-bars-available-p) + :button (:radio . (cdr (assq 'horizontal-scroll-bars + (frame-parameters)))))) + + (bindings--define-key menu [none-horizontal] + '(menu-item "None-horizontal" + menu-bar-no-horizontal-scroll-bar + :help "Turn off horizontal scroll bars" + :visible (horizontal-scroll-bars-available-p) + :button (:radio . (not (cdr (assq 'horizontal-scroll-bars + (frame-parameters))))))) (bindings--define-key menu [right] '(menu-item "On the Right" @@ -896,7 +906,8 @@ by \"Save Options\" in Custom buffers.") :help "Scroll-bar on the right side" :visible (display-graphic-p) :button (:radio . (eq (cdr (assq 'vertical-scroll-bars - (frame-parameters))) 'right)))) + (frame-parameters))) + 'right)))) (bindings--define-key menu [left] '(menu-item "On the Left" @@ -904,7 +915,8 @@ by \"Save Options\" in Custom buffers.") :help "Scroll-bar on the left side" :visible (display-graphic-p) :button (:radio . (eq (cdr (assq 'vertical-scroll-bars - (frame-parameters))) 'left)))) + (frame-parameters))) + 'left)))) (bindings--define-key menu [none] '(menu-item "None" @@ -912,7 +924,8 @@ by \"Save Options\" in Custom buffers.") :help "Turn off scroll-bar" :visible (display-graphic-p) :button (:radio . (eq (cdr (assq 'vertical-scroll-bars - (frame-parameters))) nil)))) + (frame-parameters))) + nil)))) menu)) (defun menu-bar-frame-for-menubar () @@ -1302,9 +1315,6 @@ mail status in mode line")) (bindings--define-key menu [life] '(menu-item "Life" life :help "Watch how John Conway's cellular automaton evolves")) - (bindings--define-key menu [land] - '(menu-item "Landmark" landmark - :help "Watch a neural-network robot learn landmarks")) (bindings--define-key menu [hanoi] '(menu-item "Towers of Hanoi" hanoi :help "Watch Towers-of-Hanoi puzzle solved by Emacs")) @@ -1917,6 +1927,19 @@ Buffers menu is regenerated." "Function to select the buffer chosen from the `Buffers' menu-bar menu. It must accept a buffer as its only required argument.") +(defun menu-bar-buffer-vector (alist) + ;; turn ((name . buffer) ...) into a menu + (let ((buffers-vec (make-vector (length alist) nil)) + (i (length alist))) + (dolist (pair alist) + (setq i (1- i)) + (aset buffers-vec i + (cons (car pair) + `(lambda () + (interactive) + (funcall menu-bar-select-buffer-function ,(cdr pair)))))) + buffers-vec)) + (defun menu-bar-update-buffers (&optional force) ;; If user discards the Buffers item, play along. (and (lookup-key (current-global-map) [menu-bar buffer]) @@ -1952,18 +1975,7 @@ It must accept a buffer as its only required argument.") name) )) alist)))) - ;; Now make the actual list of items. - (let ((buffers-vec (make-vector (length alist) nil)) - (i (length alist))) - (dolist (pair alist) - (setq i (1- i)) - (aset buffers-vec i - (nconc (list (car pair) - (cons nil nil)) - `(lambda () - (interactive) - (funcall menu-bar-select-buffer-function ,(cdr pair)))))) - (list buffers-vec)))) + (list (menu-bar-buffer-vector alist)))) ;; Make a Frames menu if we have more than one frame. (when (cdr frames) @@ -1974,10 +1986,8 @@ It must accept a buffer as its only required argument.") (i 0)) (dolist (frame frames) (aset frames-vec i - (nconc - (list - (frame-parameter frame 'name) - (cons nil nil)) + (cons + (frame-parameter frame 'name) `(lambda () (interactive) (menu-bar-select-frame ,frame)))) (setq i (1+ i))) @@ -2140,6 +2150,13 @@ See `menu-bar-mode' for more information." (declare-function x-menu-bar-open "term/x-win" (&optional frame)) (declare-function w32-menu-bar-open "term/w32-win" (&optional frame)) +(defun lookup-key-ignore-too-long (map key) + "Call `lookup-key' and convert numeric values to nil." + (let ((binding (lookup-key map key))) + (if (numberp binding) ; `too long' + nil + binding))) + (defun popup-menu (menu &optional position prefix from-menu-bar) "Popup the given menu and call the selected option. MENU can be a keymap, an easymenu-style menu or a list of keymaps as for @@ -2192,11 +2209,9 @@ FROM-MENU-BAR, if non-nil, means we are dropping one of menu-bar's menus." (let ((mouse-click (apply 'vector event)) binding) (while (and map (null binding)) - (setq binding (lookup-key (car map) mouse-click)) - (if (numberp binding) ; `too long' - (setq binding nil)) + (setq binding (lookup-key-ignore-too-long (car map) mouse-click)) (setq map (cdr map))) - binding)) + binding)) (t ;; We were given a single keymap. (lookup-key map (apply 'vector event))))) @@ -2276,15 +2291,37 @@ If FRAME is nil or not given, use the selected frame." (let* ((x tty-menu--initial-menu-x) (menu (menu-bar-menu-at-x-y x 0 frame))) (popup-menu (or - (lookup-key global-map (vector 'menu-bar menu)) - (lookup-key (current-local-map) (vector 'menu-bar menu)) - (cdar (minor-mode-key-binding (vector 'menu-bar menu)))) + (lookup-key-ignore-too-long + global-map (vector 'menu-bar menu)) + (lookup-key-ignore-too-long + (current-local-map) (vector 'menu-bar menu)) + (cdar (minor-mode-key-binding (vector 'menu-bar menu))) + (mouse-menu-bar-map)) (posn-at-x-y x 0 nil t) nil t))) (t (with-selected-frame (or frame (selected-frame)) (tmm-menubar)))))) (global-set-key [f10] 'menu-bar-open) +(defun buffer-menu-open () + "Start key navigation of the buffer menu. +This is the keyboard interface to \\[mouse-buffer-menu]." + (interactive) + (popup-menu (mouse-buffer-menu-keymap) + (posn-at-x-y 0 0 nil t))) + +(global-set-key [C-f10] 'buffer-menu-open) + +(defun mouse-buffer-menu-keymap () + (let* ((menu (mouse-buffer-menu-map)) + (km (make-sparse-keymap (pop menu)))) + (dolist (item (nreverse menu)) + (let* ((name (pop item))) + (define-key km (vector (intern name)) + (list name 'keymap name + (menu-bar-buffer-vector item))))) + km)) + (defvar tty-menu-navigation-map (let ((map (make-sparse-keymap))) ;; The next line is disabled because it breaks interpretation of diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index cbf08f2bf34..8b547dfa918 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog @@ -1,6 +1,6 @@ 2014-10-20 Glenn Morris <rgm@gnu.org> - * Version 24.4 released. + * Merge in all changes up to 24.4 release. 2014-09-30 Bill Wohler <wohler@newt.com> @@ -13,13 +13,17 @@ * mh-comp.el (mh-insert-x-face): Ensure that mh-x-face-file is a string before trying to use it (closes SF #474). (mh-bare-components): New function to create a temporary initial - components file; replaces mh-find-components. Improve the temp - folder and file names as per a suggestion from Bill Wohler. Also - address XEmacs compatibility issues: use mm-make-temp-file instead + components file; replaces mh-find-components. Improve the temp + folder and file names as per a suggestion from Bill Wohler. + Also address XEmacs compatibility issues: use mm-make-temp-file instead of make-temp-file, and only pass one argument to delete-directory. (mh-edit-again, mh-send-sub): Use mh-bare-components instead of mh-find-components (partially closes SF #468). +2014-05-09 Glenn Morris <rgm@gnu.org> + + * mh-e.el (mh-variants): Use file-accessible-directory-p. + 2014-03-16 Bill Wohler <wohler@newt.com> * mh-folder.el (mh-regenerate-headers): Fix scan: bad message list @@ -99,8 +103,8 @@ * mh-letter.el (mh-yank-hooks): Use new mh-make-obsolete-variable macro. - * mh-e.el (mh-kill-folder-suppress-prompt-hooks): Use - new mh-define-obsolete-variable-alias macro. + * mh-e.el (mh-kill-folder-suppress-prompt-hooks): + Use new mh-define-obsolete-variable-alias macro. * mh-compat.el (mh-cl-flet): New alias for cl-flet on Emacs 24 and flet elsewhere. @@ -112,8 +116,8 @@ Replace flet with new alias mh-cl-flet. * mh-mime.el (mh-display-with-external-viewer, mh-mime-display) - (mh-press-button, mh-push-button, mh-display-emphasis): Replace - flet with new alias mh-cl-flet. + (mh-press-button, mh-push-button, mh-display-emphasis): + Replace flet with new alias mh-cl-flet. * mh-e.el (mh-invisible-header-fields-internal): Remove trailing whitespace. @@ -155,16 +159,16 @@ (mh-folder-mode): Add mh-blacklist and mh-whitelist variables. (mh-execute-commands): Update documentation. (mh-undo, mh-outstanding-commands-p, mh-process-commands) - (mh-delete-a-msg, mh-refile-a-msg, mh-undo-msg): Handle - blacklisted and whitelisted messages. + (mh-delete-a-msg, mh-refile-a-msg, mh-undo-msg): + Handle blacklisted and whitelisted messages. * mh-junk.el (mh-junk-blacklist, mh-junk-whitelist): Update to put messages in blacklist and whitelist respectively for latter processing. (mh-blacklist-a-msg, mh-junk-whitelist-a-msg): New function to support previous functions. (mh-junk-blacklist-disposition): New function. - (mh-junk-process-blacklist, mh-junk-process-whitelist): New - functions that perform the blacklisting and whitelisting + (mh-junk-process-blacklist, mh-junk-process-whitelist): + New functions that perform the blacklisting and whitelisting respectively that used to be performed by mh-junk-blacklist and mh-junk-whitelist. * mh-scan.el (mh-scan-blacklisted-msg-regexp) @@ -187,18 +191,18 @@ X-MaxCode-Template:, X-ME-Bayesian:, X-Sendergroup:, X-SFDC-, X-SMFBL:, X-SMHeaderMap:, X-VGI-OESCD:, X-VirtualServer:, X-VirtualServerGroup:, X-XPT-XSL-Name:, X-Y-GMX-Trusted:, - X-XWALL-, X-ZixNet:. Changed X-Habeas-SWE- to X-Habeas-. Updated - the comment. (addresses SF #1916032). + X-XWALL-, X-ZixNet:. Changed X-Habeas-SWE- to X-Habeas-. + Updated the comment. (addresses SF #1916032). 2012-11-25 Bill Wohler <wohler@newt.com> - * mh-e.el (mh-invisible-header-fields-internal): Add - X-AnalysisOut, X-Authentication-Info, X-Auto-Response-Suppress, + * mh-e.el (mh-invisible-header-fields-internal): + Add X-AnalysisOut, X-Authentication-Info, X-Auto-Response-Suppress, X-Bayes-Prob, X-Cam-, X-CanIt-Geo, X-Completed, X-Facebook, X-Forwarded-, X-Generated-By, X-Headers-End, X-IEEE-UCE, X-Jira-Fingerprint, X-Junkmail-, X-Launchpad-, X-MXL-Hash, - X-Notification-, X-Notifications, X-Oracle-Calendar. Replace - X-DCC-Usenix-Metrics with X-DCC- (addresses SF #1916032). + X-Notification-, X-Notifications, X-Oracle-Calendar. + Replace X-DCC-Usenix-Metrics with X-DCC- (addresses SF #1916032). 2012-11-25 Jeffrey C Honig <jch@honig.net> @@ -1256,8 +1260,8 @@ (mh-show-subject, mh-show-to, mh-show-xface) (mh-speedbar-folder, mh-speedbar-folder-with-unseen-messages) (mh-speedbar-selected-folder) - (mh-speedbar-selected-folder-with-unseen-messages): Add - :package-version keyword to these faces (closes SF #1452724). + (mh-speedbar-selected-folder-with-unseen-messages): + Add :package-version keyword to these faces (closes SF #1452724). * mh-tool-bar.el (mh-tool-bar-define): Add commented-out :package-version keywords (closes SF #1452724). diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el index d44261e8846..04096246f16 100644 --- a/lisp/mh-e/mh-acros.el +++ b/lisp/mh-e/mh-acros.el @@ -46,6 +46,10 @@ ;;; Compatibility +;; TODO: Replace `cl' with `cl-lib'. +;; `cl' is deprecated in Emacs 24.3. Use `cl-lib' instead. However, +;; we'll likely have to insert `cl-' before each use of a Common Lisp +;; function. ;;;###mh-autoload (defmacro mh-require-cl () "Macro to load \"cl\" if needed. diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 8205187e289..f11511a9dc5 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -739,7 +739,7 @@ is described by the variable `mh-variants'." (setq dir (file-chase-links (directory-file-name dir))) (add-to-list 'list-unique dir)) (loop for dir in (nreverse list-unique) do - (when (and dir (file-directory-p dir) (file-readable-p dir)) + (when (and dir (file-accessible-directory-p dir)) (let ((variant (mh-variant-info dir))) (if variant (add-to-list 'mh-variants variant))))) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 9146c29ed80..538bd974256 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -169,13 +169,15 @@ ACTION can be one of nil, t or `lambda'." (t 'test-completion)) string table pred)))) -(defun completion-table-dynamic (fun) +(defun completion-table-dynamic (fun &optional switch-buffer) "Use function FUN as a dynamic completion table. FUN is called with one argument, the string for which completion is required, and it should return an alist containing all the intended possible completions. This alist may be a full list of possible completions so that FUN can ignore -the value of its argument. If completion is performed in the minibuffer, -FUN will be called in the buffer from which the minibuffer was entered. +the value of its argument. +If SWITCH-BUFFER is non-nil and completion is performed in the +minibuffer, FUN will be called in the buffer from which the minibuffer +was entered. The result of the `completion-table-dynamic' form is a function that can be used as the COLLECTION argument to `try-completion' and @@ -187,9 +189,10 @@ See also the related function `completion-table-with-cache'." ;; `fun' is not supposed to return another function but a plain old ;; completion table, whose boundaries are always trivial. nil - (with-current-buffer (let ((win (minibuffer-selected-window))) - (if (window-live-p win) (window-buffer win) - (current-buffer))) + (with-current-buffer (if (not switch-buffer) (current-buffer) + (let ((win (minibuffer-selected-window))) + (if (window-live-p win) (window-buffer win) + (current-buffer)))) (complete-with-action action (funcall fun string) string pred))))) (defun completion-table-with-cache (fun &optional ignore-case) @@ -228,7 +231,8 @@ You should give VAR a non-nil `risky-local-variable' property." (lambda (,str) (when (functionp ,var) (setq ,var (funcall #',fun))) - ,var)))) + ,var) + 'do-switch-buffer))) (defun completion-table-case-fold (table &optional dont-fold) "Return new completion TABLE that is case insensitive. @@ -244,8 +248,7 @@ The result is a completion table which completes strings of the form (concat S1 S) in the same way as TABLE completes strings of the form (concat S2 S)." (lambda (string pred action) - (let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil - completion-ignore-case)) + (let* ((str (if (string-prefix-p s1 string completion-ignore-case) (concat s2 (substring string (length s1))))) (res (if str (complete-with-action action table str pred)))) (when res @@ -257,8 +260,7 @@ the form (concat S2 S)." (+ beg (- (length s1) (length s2)))) . ,(and (eq (car-safe res) 'boundaries) (cddr res))))) ((stringp res) - (if (eq t (compare-strings res 0 (length s2) s2 nil nil - completion-ignore-case)) + (if (string-prefix-p s2 string completion-ignore-case) (concat s1 (substring res (length s2))))) ((eq action t) (let ((bounds (completion-boundaries str table pred ""))) @@ -824,16 +826,27 @@ styles for specific categories, such as files, buffers, etc." :type completion--styles-type :version "23.1") -(defcustom completion-category-overrides - '((buffer (styles . (basic substring)))) - "List of `completion-styles' overrides for specific categories. +(defvar completion-category-defaults + '((buffer (styles . (basic substring))) + (unicode-name (styles . (basic substring)))) + "Default settings for specific completion categories. +Each entry has the shape (CATEGORY . ALIST) where ALIST is +an association list that can specify properties such as: +- `styles': the list of `completion-styles' to use for that category. +- `cycle': the `completion-cycle-threshold' to use for that category. +Categories are symbols such as `buffer' and `file', used when +completing buffer and file names, respectively.") + +(defcustom completion-category-overrides nil + "List of category-specific user overrides for completion styles. Each override has the shape (CATEGORY . ALIST) where ALIST is an association list that can specify properties such as: - `styles': the list of `completion-styles' to use for that category. - `cycle': the `completion-cycle-threshold' to use for that category. Categories are symbols such as `buffer' and `file', used when -completing buffer and file names, respectively." - :version "24.1" +completing buffer and file names, respectively. +This overrides the defaults specified in `completion-category-defaults'." + :version "25.1" :type `(alist :key-type (choice :tag "Category" (const buffer) (const file) @@ -849,9 +862,13 @@ completing buffer and file names, respectively." (const :tag "Select one value from the menu." cycle) ,completion--cycling-threshold-type)))) +(defun completion--category-override (category tag) + (or (assq tag (cdr (assq category completion-category-overrides))) + (assq tag (cdr (assq category completion-category-defaults))))) + (defun completion--styles (metadata) (let* ((cat (completion-metadata-get metadata 'category)) - (over (assq 'styles (cdr (assq cat completion-category-overrides))))) + (over (completion--category-override cat 'styles))) (if over (delete-dups (append (cdr over) (copy-sequence completion-styles))) completion-styles))) @@ -873,6 +890,7 @@ completing buffer and file names, respectively." ;; part of the string (e.g. substitute-in-file-name). (let ((requote (when (completion-metadata-get metadata 'completion--unquote-requote) + (cl-assert (functionp table)) (let ((new (funcall table string point 'completion--unquote))) (setq string (pop new)) (setq table (pop new)) @@ -964,7 +982,7 @@ completion candidates than this number." (defun completion--cycle-threshold (metadata) (let* ((cat (completion-metadata-get metadata 'category)) - (over (assq 'cycle (cdr (assq cat completion-category-overrides))))) + (over (completion--category-override cat 'cycle))) (if over (cdr over) completion-cycle-threshold))) (defvar-local completion-all-sorted-completions nil) @@ -1117,9 +1135,10 @@ If no characters can be completed, display a list of possible completions. If you repeat this command after it displayed such a list, scroll the window of possible completions." (interactive) - (completion-in-region (minibuffer-prompt-end) (point-max) - minibuffer-completion-table - minibuffer-completion-predicate)) + (when (<= (minibuffer-prompt-end) (point)) + (completion-in-region (minibuffer-prompt-end) (point-max) + minibuffer-completion-table + minibuffer-completion-predicate))) (defun completion--in-region-1 (beg end) ;; If the previous command was not this, @@ -1794,8 +1813,32 @@ variables.") ;; window, mark it as softly-dedicated, so bury-buffer in ;; minibuffer-hide-completions will know whether to ;; delete the window or not. - (display-buffer-mark-dedicated 'soft)) - (with-output-to-temp-buffer "*Completions*" + (display-buffer-mark-dedicated 'soft) + ;; Disable `pop-up-windows' temporarily to allow + ;; `display-buffer--maybe-pop-up-frame-or-window' + ;; in the display actions below to pop up a frame + ;; if `pop-up-frames' is non-nil, but not to pop up a window. + (pop-up-windows nil)) + (with-displayed-buffer-window + "*Completions*" + ;; This is a copy of `display-buffer-fallback-action' + ;; where `display-buffer-use-some-window' is replaced + ;; with `display-buffer-at-bottom'. + `((display-buffer--maybe-same-window + display-buffer-reuse-window + display-buffer--maybe-pop-up-frame-or-window + ;; Use `display-buffer-below-selected' for inline completions, + ;; but not in the minibuffer (e.g. in `eval-expression') + ;; for which `display-buffer-at-bottom' is used. + ,(if (eq (selected-window) (minibuffer-window)) + 'display-buffer-at-bottom + 'display-buffer-below-selected)) + ,(if temp-buffer-resize-mode + '(window-height . resize-temp-buffer-window) + '(window-height . shrink-window-if-larger-than-buffer)) + ,(when temp-buffer-resize-mode + '(preserve-size . (nil . t)))) + nil ;; Remove the base-size tail because `sort' requires a properly ;; nil-terminated list. (when last (setcdr last nil)) @@ -2085,7 +2128,11 @@ The completion method is determined by `completion-at-point-functions'." (completion-in-region start end collection (plist-get plist :predicate)))) ;; Maybe completion already happened and the function returned t. - (_ (cdr res))))) + (_ + (when (cdr res) + (message "Warning: %S failed to return valid completion data!" + (car res))) + (cdr res))))) (defun completion-help-at-point () "Display the completions on the text around point. @@ -3065,16 +3112,9 @@ filter out additional entries (because TABLE might not obey PRED)." (nconc (completion-pcm--hilit-commonality pattern all) (length prefix))))) -(defun completion--sreverse (str) - "Like `reverse' but for a string STR rather than a list." - (apply #'string (nreverse (mapcar 'identity str)))) - (defun completion--common-suffix (strs) "Return the common suffix of the strings STRS." - (completion--sreverse - (try-completion - "" - (mapcar #'completion--sreverse strs)))) + (nreverse (try-completion "" (mapcar #'reverse strs)))) (defun completion-pcm--merge-completions (strs pattern) "Extract the commonality in STRS, with the help of PATTERN. @@ -3292,6 +3332,7 @@ the same set of elements." (string-match completion-pcm--delim-wild-regex str (car bounds))) (if (zerop (car bounds)) + ;; FIXME: Don't hardcode "-" (bug#17559). (mapconcat 'string str "-") ;; If there's a boundary, it's trickier. The main use-case ;; we consider here is file-name completion. We'd like diff --git a/lisp/misearch.el b/lisp/misearch.el index dc8e1d0aa43..dcc819564fb 100644 --- a/lisp/misearch.el +++ b/lisp/misearch.el @@ -91,6 +91,11 @@ Isearch starts.") "The buffer where the search is currently searching. The value is nil when the search still is in the initial buffer.") +;;;###autoload +(defvar multi-isearch-buffer-list nil) +;;;###autoload +(defvar multi-isearch-file-list nil) + (defvar multi-isearch-orig-search-fun nil) (defvar multi-isearch-orig-wrap nil) (defvar multi-isearch-orig-push-state nil) @@ -119,7 +124,9 @@ Intended to be added to `isearch-mode-hook'." (defun multi-isearch-end () "Clean up the multi-buffer search after terminating isearch." (setq multi-isearch-current-buffer nil - multi-isearch-next-buffer-current-function nil) + multi-isearch-next-buffer-current-function nil + multi-isearch-buffer-list nil + multi-isearch-file-list nil) (setq-default isearch-search-fun-function multi-isearch-orig-search-fun isearch-wrap-function multi-isearch-orig-wrap isearch-push-state-function multi-isearch-orig-push-state) @@ -204,8 +211,6 @@ Switch to the buffer restored from the search status stack." ;;; Global multi-buffer search invocations -(defvar multi-isearch-buffer-list nil) - (defun multi-isearch-next-buffer-from-list (&optional buffer wrap) "Return the next buffer in the series of buffers. This function is used for multiple buffers Isearch. A sequence of @@ -290,8 +295,6 @@ whose names match the specified regexp." ;;; Global multi-file search invocations -(defvar multi-isearch-file-list nil) - (defun multi-isearch-next-file-buffer-from-list (&optional buffer wrap) "Return the next buffer in the series of file buffers. This function is used for multiple file buffers Isearch. A sequence @@ -374,6 +377,25 @@ whose file names match the specified wildcard." (goto-char (if isearch-forward (point-min) (point-max))) (isearch-forward-regexp nil t))) +(defun multi-isearch-unload-function () + "Remove autoloaded variables from `unload-function-defs-list'. +Also prevent the feature from being reloaded via `isearch-mode-hook'." + (remove-hook 'isearch-mode-hook 'multi-isearch-setup) + (let ((defs (list (car unload-function-defs-list))) + (auto '(multi-isearch-next-buffer-function + multi-isearch-next-buffer-current-function + multi-isearch-current-buffer + multi-isearch-buffer-list multi-isearch-file-list))) + (dolist (def (cdr unload-function-defs-list)) + (unless (and (symbolp def) + (memq def auto)) + (push def defs))) + (setq unload-function-defs-list (nreverse defs)) + ;; . + nil)) + +(defalias 'misearch-unload-function 'multi-isearch-unload-function) + (provide 'multi-isearch) (provide 'misearch) diff --git a/lisp/mouse-copy.el b/lisp/mouse-copy.el index f60768e7949..609713ce5fd 100644 --- a/lisp/mouse-copy.el +++ b/lisp/mouse-copy.el @@ -147,7 +147,7 @@ If you have the bug (or the real fix :-), please let me know." ;; Third, set the selection. ;; (setq me-beg beg me-end end me-range range) ; for debugging (set-buffer end-buffer) - (x-set-selection 'SECONDARY (buffer-substring beg end))))) + (gui-set-selection 'SECONDARY (buffer-substring beg end))))) (defun mouse-drag-secondary-pasting (start-event) @@ -203,7 +203,7 @@ by johnh@ficus.cs.ucla.edu." (kill-region (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay))) ;; (delete-overlay mouse-secondary-overlay) - ;; (x-set-selection 'SECONDARY nil) + ;; (gui-set-selection 'SECONDARY nil) ;; (setq mouse-secondary-overlay nil) ) diff --git a/lisp/mouse.el b/lisp/mouse.el index e2674184f69..e78eca40bc5 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -102,8 +102,7 @@ Expects to be bound to `down-mouse-1' in `key-translation-map'." (or mouse-1-click-in-non-selected-windows (eq (selected-window) (posn-window (event-start last-input-event))))) - (let ((this-event last-input-event) - (timedout + (let ((timedout (sit-for (if (numberp mouse-1-click-follows-link) (/ (abs mouse-1-click-follows-link) 1000.0) 0)))) @@ -112,7 +111,7 @@ Expects to be bound to `down-mouse-1' in `key-translation-map'." timedout (not timedout)) nil - (let ((event (read-event))) + (let ((event (read-key))) ;Use read-key so it works for xterm-mouse-mode! (if (eq (car-safe event) (if (eq mouse-1-click-follows-link 'double) 'double-mouse-1 'mouse-1)) ;; Turn the mouse-1 into a mouse-2 to follow links. @@ -307,13 +306,14 @@ This command must be bound to a mouse click." (or (eq frame oframe) (set-mouse-position (selected-frame) (1- (frame-width)) 0)))) -(defun mouse-tear-off-window (click) - "Delete the window clicked on, and create a new frame displaying its buffer." +(define-obsolete-function-alias 'mouse-tear-off-window 'tear-off-window "24.4") +(defun tear-off-window (click) + "Delete the selected window, and create a new frame displaying its buffer." (interactive "e") (mouse-minibuffer-check click) (let* ((window (posn-window (event-start click))) (buf (window-buffer window)) - (frame (make-frame))) + (frame (make-frame))) ;FIXME: Use pop-to-buffer. (select-frame frame) (switch-to-buffer buf) (delete-window window))) @@ -355,24 +355,6 @@ This command must be bound to a mouse click." (split-window-horizontally (min (max new-width first-col) last-col)))))) -;; `mouse-drag-line' is now the common routine for handling all line -;; dragging events combining the earlier `mouse-drag-mode-line-1' and -;; `mouse-drag-vertical-line'. It should improve the behavior of line -;; dragging wrt Emacs 23 as follows: - -;; (1) Gratuitous error messages and restrictions have been (hopefully) -;; removed. (The help-echo that dragging the mode-line can resize a -;; one-window-frame's window will still show through via bindings.el.) - -;; (2) No gratuitous selection of other windows should happen. (This -;; has not been completely fixed for mouse-autoselected windows yet.) - -;; (3) Mouse clicks below a scroll-bar should pass through via unread -;; command events. - -;; Note that `window-in-direction' replaces `mouse-drag-window-above' -;; and `mouse-drag-vertical-line-rightward-window' with Emacs 24.1. - (defun mouse-drag-line (start-event line) "Drag a mode line, header line, or vertical line with the mouse. START-EVENT is the starting mouse-event of the drag action. LINE @@ -383,116 +365,136 @@ must be one of the symbols `header', `mode', or `vertical'." (start (event-start start-event)) (window (posn-window start)) (frame (window-frame window)) - (minibuffer-window (minibuffer-window frame)) - (side (and (eq line 'vertical) - (or (cdr (assq 'vertical-scroll-bars - (frame-parameters frame))) - 'right))) + ;; `position' records the x- or y-coordinate of the last + ;; sampled position. + (position (if (eq line 'vertical) + (+ (window-pixel-left window) + (car (posn-x-y start))) + (+ (window-pixel-top window) + (cdr (posn-x-y start))))) + ;; `last-position' records the x- or y-coordinate of the + ;; previously sampled position. The difference of `position' + ;; and `last-position' determines the size change of WINDOW. + (last-position position) (draggable t) - height finished event position growth dragged) + posn-window growth dragged) + ;; Decide on whether we are allowed to track at all and whose + ;; window's edge we drag. (cond ((eq line 'header) - ;; Check whether header-line can be dragged at all. (if (window-at-side-p window 'top) + ;; We can't drag the header line of a topmost window. (setq draggable nil) - ;; window-pixel-edges includes the header and mode lines, so - ;; we need to account for that when calculating window growth. - ;; On GUI frames, assume the mouse is approximately in the - ;; middle of the header/mode line, so we need only half the - ;; height in pixels. - (setq height - (cond - ((display-graphic-p frame) - (/ (window-header-line-height window) 2)) - (t (window-header-line-height window)))) + ;; Drag bottom edge of window above the header line. (setq window (window-in-direction 'above window t)))) ((eq line 'mode) - ;; Check whether mode-line can be dragged at all. (if (and (window-at-side-p window 'bottom) - ;; Allow resizing the minibuffer window if it's on the same - ;; frame as and immediately below the clicked window, and - ;; it's active or `resize-mini-windows' is nil. - (not (and (eq (window-frame minibuffer-window) frame) - (= (nth 1 (window-pixel-edges minibuffer-window)) - (nth 3 (window-pixel-edges window))) - (or (not resize-mini-windows) - (eq minibuffer-window - (active-minibuffer-window)))))) - (setq draggable nil) - (setq height + ;; Allow resizing the minibuffer window if it's on the + ;; same frame as and immediately below `window', and it's + ;; either active or `resize-mini-windows' is nil. + (let ((minibuffer-window (minibuffer-window frame))) + (not (and (eq (window-frame minibuffer-window) frame) + (or (not resize-mini-windows) + (eq minibuffer-window + (active-minibuffer-window))))))) + (setq draggable nil)))) + + (let* ((exitfun nil) + (move + (lambda (event) (interactive "e") (cond - ((display-graphic-p frame) - (/ (window-mode-line-height window) 2)) - (t (window-mode-line-height window)))))) - ((eq line 'vertical) - ;; Get the window to adjust for the vertical case. If the scroll - ;; bar is on the window's right or we drag a vertical divider, - ;; adjust the window where the start-event occurred. If the - ;; scroll bar is on the start-event window's left or there are no - ;; scrollbars, adjust the window on the left of it. - (unless (or (eq side 'right) - (not (zerop (window-right-divider-width window)))) - (setq window (window-in-direction 'left window t))))) - - ;; Start tracking. - (track-mouse + ((not (consp event)) + nil) + ((eq line 'vertical) + ;; Drag right edge of `window'. + (setq start (event-start event)) + (setq position (car (posn-x-y start))) + ;; Set `posn-window' to the window where `event' was recorded. + ;; This can be `window' or the window on the left or right of + ;; `window'. + (when (window-live-p (setq posn-window (posn-window start))) + ;; Add left edge of `posn-window' to `position'. + (setq position (+ (window-pixel-left posn-window) position)) + (unless (nth 1 start) + ;; Add width of objects on the left of the text area to + ;; `position'. + (when (eq (window-current-scroll-bars posn-window) 'left) + (setq position (+ (window-scroll-bar-width posn-window) + position))) + (setq position (+ (car (window-fringes posn-window)) + (or (car (window-margins posn-window)) 0) + position)))) + ;; When the cursor overshoots after shrinking a window to its + ;; minimum size and the dragging direction changes, have the + ;; cursor first catch up with the window edge. + (unless (or (zerop (setq growth (- position last-position))) + (and (> growth 0) + (< position (+ (window-pixel-left window) + (window-pixel-width window)))) + (and (< growth 0) + (> position (+ (window-pixel-left window) + (window-pixel-width window))))) + (setq dragged t) + (adjust-window-trailing-edge window growth t t)) + (setq last-position position)) + (draggable + ;; Drag bottom edge of `window'. + (setq start (event-start event)) + ;; Set `posn-window' to the window where `event' was recorded. + ;; This can be either `window' or the window above or below of + ;; `window'. + (setq posn-window (posn-window start)) + (setq position (cdr (posn-x-y start))) + (when (window-live-p posn-window) + ;; Add top edge of `posn-window' to `position'. + (setq position (+ (window-pixel-top posn-window) position)) + ;; If necessary, add height of header line to `position' + (when (memq (posn-area start) + '(nil left-fringe right-fringe left-margin right-margin)) + (setq position (+ (window-header-line-height posn-window) position)))) + ;; When the cursor overshoots after shrinking a window to its + ;; minimum size and the dragging direction changes, have the + ;; cursor first catch up with the window edge. + (unless (or (zerop (setq growth (- position last-position))) + (and (> growth 0) + (< position (+ (window-pixel-top window) + (window-pixel-height window)))) + (and (< growth 0) + (> position (+ (window-pixel-top window) + (window-pixel-height window))))) + (setq dragged t) + (adjust-window-trailing-edge window growth nil t)) + (setq last-position position)))))) + ;; Start tracking. + (setq track-mouse t) ;; Loop reading events and sampling the position of the mouse. - (while (not finished) - (setq event (read-event)) - (setq position (mouse-pixel-position)) - ;; Do nothing if - ;; - there is a switch-frame event. - ;; - the mouse isn't in the frame that we started in - ;; - the mouse isn't in any Emacs frame - ;; Drag if - ;; - there is a mouse-movement event - ;; - there is a scroll-bar-movement event (Why? -- cyd) - ;; (same as mouse movement for our purposes) - ;; Quit if - ;; - there is a keyboard event or some other unknown event. - (cond - ((not (consp event)) - (setq finished t)) - ((memq (car event) '(switch-frame select-window)) - nil) - ((not (memq (car event) '(mouse-movement scroll-bar-movement))) - (when (consp event) - ;; Do not unread a drag-mouse-1 event to avoid selecting - ;; some other window. For vertical line dragging do not - ;; unread mouse-1 events either (but only if we dragged at - ;; least once to allow mouse-1 clicks get through). - (unless (and dragged - (if (eq line 'vertical) - (memq (car event) '(drag-mouse-1 mouse-1)) - (eq (car event) 'drag-mouse-1))) - (push event unread-command-events))) - (setq finished t)) - ((not (and (eq (car position) frame) - (cadr position))) - nil) - ((eq line 'vertical) - ;; Drag vertical divider. This must be probably fixed like - ;; for the mode-line. - (setq growth (- (cadr position) - (if (eq side 'right) 0 2) - (nth 2 (window-pixel-edges window)) - -1)) - (unless (zerop growth) - (setq dragged t) - (adjust-window-trailing-edge window growth t t))) - (draggable - ;; Drag horizontal divider. - (setq growth - (if (eq line 'mode) - (- (+ (cddr position) height) - (nth 3 (window-pixel-edges window))) - ;; The window's top includes the header line! - (- (+ (nth 3 (window-pixel-edges window)) height) - (cddr position)))) - (unless (zerop growth) - (setq dragged t) - (adjust-window-trailing-edge - window (if (eq line 'mode) growth (- growth)) nil t)))))))) + (setq exitfun + (set-transient-map + (let ((map (make-sparse-keymap))) + (define-key map [switch-frame] #'ignore) + (define-key map [select-window] #'ignore) + (define-key map [scroll-bar-movement] #'ignore) + (define-key map [mouse-movement] move) + ;; Swallow drag-mouse-1 events to avoid selecting some other window. + (define-key map [drag-mouse-1] + (lambda () (interactive) (funcall exitfun))) + ;; For vertical line dragging swallow also a mouse-1 + ;; event (but only if we dragged at least once to allow mouse-1 + ;; clicks to get through). + (when (eq line 'vertical) + (define-key map [mouse-1] + `(menu-item "" ,(lambda () (interactive) (funcall exitfun)) + :filter ,(lambda (cmd) (if dragged cmd))))) + ;; Some of the events will of course end up looked up + ;; with a mode-line or header-line prefix ... + (define-key map [mode-line] map) + (define-key map [header-line] map) + ;; ... and some maybe even with a right- or bottom-divider + ;; prefix. + (define-key map [right-divider] map) + (define-key map [bottom-divider] map) + map) + t (lambda () (setq track-mouse nil))))))) (defun mouse-drag-mode-line (start-event) "Change the height of a window by dragging on the mode line." @@ -509,14 +511,18 @@ must be one of the symbols `header', `mode', or `vertical'." (interactive "e") (mouse-drag-line start-event 'vertical)) -(defun mouse-set-point (event) +(defun mouse-set-point (event &optional promote-to-region) "Move point to the position clicked on with the mouse. -This should be bound to a mouse click event type." - (interactive "e") +This should be bound to a mouse click event type. +If PROMOTE-TO-REGION is non-nil and event is a multiple-click, +select the corresponding element around point." + (interactive "e\np") (mouse-minibuffer-check event) - ;; Use event-end in case called from mouse-drag-region. - ;; If EVENT is a click, event-end and event-start give same value. - (posn-set-point (event-end event))) + (if (and promote-to-region (> (event-click-count event) 1)) + (mouse-set-region event) + ;; Use event-end in case called from mouse-drag-region. + ;; If EVENT is a click, event-end and event-start give same value. + (posn-set-point (event-end event)))) (defvar mouse-last-region-beg nil) (defvar mouse-last-region-end nil) @@ -529,6 +535,8 @@ This should be bound to a mouse click event type." (eq mouse-last-region-end (region-end)) (eq mouse-last-region-tick (buffer-modified-tick)))) +(defvar mouse--drag-start-event nil) + (defun mouse-set-region (click) "Set the region to the text dragged over, and copy to kill ring. This should be bound to a mouse drag event. @@ -538,7 +546,29 @@ command alters the kill ring or not." (mouse-minibuffer-check click) (select-window (posn-window (event-start click))) (let ((beg (posn-point (event-start click))) - (end (posn-point (event-end click)))) + (end (posn-point (event-end click))) + (click-count (event-click-count click))) + (let ((drag-start (terminal-parameter nil 'mouse-drag-start))) + (when drag-start + ;; Drag events don't come with a click count, sadly, so we hack + ;; our way around this problem by remembering the start-event in + ;; `mouse-drag-start' and fetching the click-count from there. + (when (and (<= click-count 1) + (equal beg (posn-point (event-start drag-start)))) + (setq click-count (event-click-count drag-start))) + ;; Occasionally we get spurious drag events where the user hasn't + ;; dragged his mouse, but instead Emacs has dragged the text under the + ;; user's mouse. Try to recover those cases (bug#17562). + (when (and (equal (posn-x-y (event-start click)) + (posn-x-y (event-end click))) + (not (eq (car drag-start) 'mouse-movement))) + (setq end beg)) + (setf (terminal-parameter nil 'mouse-drag-start) nil))) + (when (and (integerp beg) (integerp end)) + (let ((range (mouse-start-end beg end (1- click-count)))) + (if (< end beg) + (setq end (nth 0 range) beg (nth 1 range)) + (setq beg (nth 0 range) end (nth 1 range))))) (and mouse-drag-copy-region (integerp beg) (integerp end) ;; Don't set this-command to `kill-region', so a following ;; C-w won't double the text in the kill ring. Ignore @@ -558,10 +588,10 @@ command alters the kill ring or not." (defun mouse-set-region-1 () ;; Set transient-mark-mode for a little while. (unless (eq (car-safe transient-mark-mode) 'only) - (setq transient-mark-mode - (cons 'only - (unless (eq transient-mark-mode 'lambda) - transient-mark-mode)))) + (setq-local transient-mark-mode + (cons 'only + (unless (eq transient-mark-mode 'lambda) + transient-mark-mode)))) (setq mouse-last-region-beg (region-beginning)) (setq mouse-last-region-end (region-end)) (setq mouse-last-region-tick (buffer-modified-tick))) @@ -632,13 +662,11 @@ Upon exit, point is at the far edge of the newly visible text." Highlight the drag area as you move the mouse. This must be bound to a button-down mouse event. In Transient Mark mode, the highlighting remains as long as the mark -remains active. Otherwise, it remains until the next input event. - -If the click is in the echo area, display the `*Messages*' buffer." +remains active. Otherwise, it remains until the next input event." (interactive "e") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) - (mouse-drag-track start-event t)) + (mouse-drag-track start-event)) (defun mouse-posn-property (pos property) @@ -655,10 +683,11 @@ its value is returned." (str (posn-string pos))) (or (and str (get-text-property (cdr str) property (car str))) - ;; FIXME: mouse clicks on the mode-line come with a position in - ;; (nth 5). Maybe we should change the C code instead so that - ;; mouse-clicks don't include a position there! - (and pt (not (memq (posn-area pos) '(mode-line header-line))) + ;; Mouse clicks in the fringe come with a position in + ;; (nth 5). This is useful but is not exactly where we clicked, so + ;; don't look up that position's properties! + (and pt (not (memq (posn-area pos) '(left-fringe right-fringe + left-margin right-margin))) (get-char-property pt property w)))) (get-char-property pos property))) @@ -745,12 +774,9 @@ at the same position." "mouse-1" (substring msg 7))))))) msg) -(defun mouse-drag-track (start-event &optional - do-mouse-drag-region-post-process) +(defun mouse-drag-track (start-event) "Track mouse drags by highlighting area between point and cursor. -The region will be defined with mark and point. -DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by -`mouse-drag-region'." +The region will be defined with mark and point." (mouse-minibuffer-check start-event) (setq mouse-selection-click-count-buffer (current-buffer)) (deactivate-mark) @@ -763,8 +789,6 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by (start-posn (event-start start-event)) (start-point (posn-point start-posn)) (start-window (posn-window start-posn)) - (start-window-start (window-start start-window)) - (start-hscroll (window-hscroll start-window)) (bounds (window-edges start-window)) (make-cursor-line-fully-visible nil) (top (nth 1 bounds)) @@ -775,9 +799,7 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by (click-count (1- (event-click-count start-event))) ;; Suppress automatic hscrolling, because that is a nuisance ;; when setting point near the right fringe (but see below). - (auto-hscroll-mode-saved auto-hscroll-mode) - (auto-hscroll-mode nil) - moved-off-start event end end-point) + (auto-hscroll-mode-saved auto-hscroll-mode)) (setq mouse-selection-click-count click-count) ;; In case the down click is in the middle of some intangible text, @@ -788,93 +810,51 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by ;; Activate the region, using `mouse-start-end' to determine where ;; to put point and mark (e.g., double-click will select a word). - (setq transient-mark-mode - (if (eq transient-mark-mode 'lambda) - '(only) - (cons 'only transient-mark-mode))) + (setq-local transient-mark-mode + (if (eq transient-mark-mode 'lambda) + '(only) + (cons 'only transient-mark-mode))) (let ((range (mouse-start-end start-point start-point click-count))) (push-mark (nth 0 range) t t) (goto-char (nth 1 range))) - ;; Track the mouse until we get a non-movement event. - (track-mouse - (while (progn - (setq event (read-event)) - (or (mouse-movement-p event) - (memq (car-safe event) '(switch-frame select-window)))) - (unless (memq (car-safe event) '(switch-frame select-window)) - ;; Automatic hscrolling did not occur during the call to - ;; `read-event'; but if the user subsequently drags the - ;; mouse, go ahead and hscroll. - (let ((auto-hscroll-mode auto-hscroll-mode-saved)) - (redisplay)) - (setq end (event-end event) - end-point (posn-point end)) - ;; Note whether the mouse has left the starting position. - (unless (eq end-point start-point) - (setq moved-off-start t)) - (if (and (eq (posn-window end) start-window) - (integer-or-marker-p end-point)) - (mouse--drag-set-mark-and-point start-point - end-point click-count) - (let ((mouse-row (cdr (cdr (mouse-position))))) - (cond - ((null mouse-row)) - ((< mouse-row top) - (mouse-scroll-subr start-window (- mouse-row top) - nil start-point)) - ((>= mouse-row bottom) - (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) - nil start-point)))))))) - - ;; Handle the terminating event if possible. - (when (consp event) - ;; Ensure that point is on the end of the last event. - (when (and (setq end-point (posn-point (event-end event))) - (eq (posn-window end) start-window) - (integer-or-marker-p end-point) - (/= start-point end-point)) - (mouse--drag-set-mark-and-point start-point - end-point click-count)) - - ;; Find its binding. - (let* ((fun (key-binding (vector (car event)))) - ;; FIXME This doesn't make sense, because - ;; event-click-count always returns something >= 1. - (do-multi-click (and (> (event-click-count event) 0) - (functionp fun) - (not (memq fun '(mouse-set-point - mouse-set-region)))))) - (if (and (/= (mark) (point)) - (not do-multi-click)) - - ;; If point has moved, finish the drag. - (let* (last-command this-command) - (and mouse-drag-copy-region - do-mouse-drag-region-post-process - (let (deactivate-mark) - (copy-region-as-kill (mark) (point))))) - - ;; Otherwise, run binding of terminating up-event. + (setf (terminal-parameter nil 'mouse-drag-start) start-event) + (setq track-mouse t) + (setq auto-hscroll-mode nil) + + (set-transient-map + (let ((map (make-sparse-keymap))) + (define-key map [switch-frame] #'ignore) + (define-key map [select-window] #'ignore) + (define-key map [mouse-movement] + (lambda (event) (interactive "e") + (let* ((end (event-end event)) + (end-point (posn-point end))) + (unless (eq end-point start-point) + ;; As soon as the user moves, we can re-enable auto-hscroll. + (setq auto-hscroll-mode auto-hscroll-mode-saved) + ;; And remember that we have moved, so mouse-set-region can know + ;; its event is really a drag event. + (setcar start-event 'mouse-movement)) + (if (and (eq (posn-window end) start-window) + (integer-or-marker-p end-point)) + (mouse--drag-set-mark-and-point start-point + end-point click-count) + (let ((mouse-row (cdr (cdr (mouse-position))))) + (cond + ((null mouse-row)) + ((< mouse-row top) + (mouse-scroll-subr start-window (- mouse-row top) + nil start-point)) + ((>= mouse-row bottom) + (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) + nil start-point)))))))) + map) + t (lambda () + (setq track-mouse nil) + (setq auto-hscroll-mode auto-hscroll-mode-saved) (deactivate-mark) - (if do-multi-click - (goto-char start-point) - (unless moved-off-start - (pop-mark))) - - (when (and (functionp fun) - (= start-hscroll (window-hscroll start-window)) - ;; Don't run the up-event handler if the window - ;; start changed in a redisplay after the - ;; mouse-set-point for the down-mouse event at - ;; the beginning of this function. When the - ;; window start has changed, the up-mouse event - ;; contains a different position due to the new - ;; window contents, and point is set again. - (or end-point - (= (window-start start-window) - start-window-start))) - (push event unread-command-events))))))) + (pop-mark))))) (defun mouse--drag-set-mark-and-point (start click click-count) (let* ((range (mouse-start-end start click click-count)) @@ -1089,24 +1069,7 @@ regardless of where you click." (let (select-active-regions) (deactivate-mark))) (or mouse-yank-at-point (mouse-set-point click)) - (let ((primary - (if (fboundp 'x-get-selection-value) - (if (eq (framep (selected-frame)) 'w32) - ;; MS-Windows emulates PRIMARY in x-get-selection, but not - ;; in x-get-selection-value (the latter only accesses the - ;; clipboard). So try PRIMARY first, in case they selected - ;; something with the mouse in the current Emacs session. - (or (x-get-selection 'PRIMARY) - (x-get-selection-value)) - ;; Else MS-DOS or X. - ;; On X, x-get-selection-value supports more formats and - ;; encodings, so use it in preference to x-get-selection. - (or (x-get-selection-value) - (x-get-selection 'PRIMARY))) - ;; FIXME: What about xterm-mouse-mode etc.? - (x-get-selection 'PRIMARY)))) - (unless primary - (error "No selection is available")) + (let ((primary (gui-get-primary-selection))) (push-mark (point)) (insert-for-yank primary))) @@ -1293,7 +1256,7 @@ This must be bound to a mouse drag event." (if (numberp (posn-point posn)) (setq beg (posn-point posn))) (move-overlay mouse-secondary-overlay beg (posn-point end)) - (x-set-selection + (gui-set-selection 'SECONDARY (buffer-substring (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay)))))) @@ -1330,6 +1293,7 @@ The function returns a non-nil value if it creates a secondary selection." (setq mouse-secondary-start (make-marker))) (set-marker mouse-secondary-start start-point) (delete-overlay mouse-secondary-overlay)) + ;; FIXME: Use mouse-drag-track! (let (event end end-point) (track-mouse (while (progn @@ -1368,13 +1332,13 @@ The function returns a non-nil value if it creates a secondary selection." (if (marker-position mouse-secondary-start) (save-window-excursion (delete-overlay mouse-secondary-overlay) - (x-set-selection 'SECONDARY nil) + (gui-set-selection 'SECONDARY nil) (select-window start-window) (save-excursion (goto-char mouse-secondary-start) (sit-for 1) nil)) - (x-set-selection + (gui-set-selection 'SECONDARY (buffer-substring (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay))))))))) @@ -1388,7 +1352,7 @@ regardless of where you click." ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (or mouse-yank-at-point (mouse-set-point click)) - (let ((secondary (x-get-selection 'SECONDARY))) + (let ((secondary (gui-get-selection 'SECONDARY))) (if secondary (insert-for-yank secondary) (error "No secondary selection")))) @@ -1507,7 +1471,7 @@ CLICK position, kill the secondary selection." (setq str (buffer-substring (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay))) (> (length str) 0) - (x-set-selection 'SECONDARY str)))) + (gui-set-selection 'SECONDARY str)))) (defcustom mouse-buffer-menu-maxlen 20 @@ -1552,8 +1516,17 @@ This switches buffers in the window that you clicked on, and selects that window." (interactive "e") (mouse-minibuffer-check event) - (let ((buffers (buffer-list)) alist menu split-by-major-mode sum-of-squares) - ;; Make an alist of elements that look like (MENU-ITEM . BUFFER). + (let ((buf (x-popup-menu event (mouse-buffer-menu-map))) + (window (posn-window (event-start event)))) + (when buf + (select-window + (if (framep window) (frame-selected-window window) + window)) + (switch-to-buffer buf)))) + +(defun mouse-buffer-menu-map () + ;; Make an alist of elements that look like (MENU-ITEM . BUFFER). + (let ((buffers (buffer-list)) split-by-major-mode sum-of-squares) (dolist (buf buffers) ;; Divide all buffers into buckets for various major modes. ;; Each bucket looks like (MODE NAMESTRING BUFFERS...). @@ -1617,18 +1590,10 @@ and selects that window." (setq subdivided-menus (cons (cons "Others" others-list) subdivided-menus))))) - (setq menu (cons "Buffer Menu" (nreverse subdivided-menus)))) - (progn - (setq alist (mouse-buffer-menu-alist buffers)) - (setq menu (cons "Buffer Menu" - (mouse-buffer-menu-split "Select Buffer" alist))))) - (let ((buf (x-popup-menu event menu)) - (window (posn-window (event-start event)))) - (when buf - (select-window - (if (framep window) (frame-selected-window window) - window)) - (switch-to-buffer buf))))) + (cons "Buffer Menu" (nreverse subdivided-menus))) + (cons "Buffer Menu" + (mouse-buffer-menu-split "Select Buffer" + (mouse-buffer-menu-alist buffers)))))) (defun mouse-buffer-menu-alist (buffers) (let (tail @@ -1902,14 +1867,10 @@ choose a font." ;;; Bindings for mouse commands. -(define-key global-map [down-mouse-1] 'mouse-drag-region) +(global-set-key [down-mouse-1] 'mouse-drag-region) (global-set-key [mouse-1] 'mouse-set-point) (global-set-key [drag-mouse-1] 'mouse-set-region) -;; These are tested for in mouse-drag-region. -(global-set-key [double-mouse-1] 'mouse-set-point) -(global-set-key [triple-mouse-1] 'mouse-set-point) - (defun mouse--strip-first-event (_prompt) (substring (this-single-command-raw-keys) 1)) diff --git a/lisp/mpc.el b/lisp/mpc.el index a8df75d9a1c..76c08dbcbeb 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -1,4 +1,4 @@ -;;; mpc.el --- A client for the Music Player Daemon -*- coding: utf-8; lexical-binding: t -*- +;;; mpc.el --- A client for the Music Player Daemon -*- lexical-binding: t -*- ;; Copyright (C) 2006-2015 Free Software Foundation, Inc. @@ -891,9 +891,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." :type '(choice (const nil) directory)) (defcustom mpc-data-directory - (if (and (not (file-directory-p "~/.mpc")) - (file-directory-p "~/.emacs.d")) - "~/.emacs.d/mpc" "~/.mpc") + (locate-user-emacs-file "mpc" ".mpc") "Directory where MPC.el stores auxiliary data." :type 'directory) @@ -1024,7 +1022,12 @@ If PLAYLIST is t or nil or missing, use the main playlist." (when (and (null val) (eq tag 'Title)) (setq val (cdr (assq 'file info)))) (push `(equal ',val (cdr (assq ',tag info))) pred) - val))))) + (cond + ((not (and (eq tag 'Date) (stringp val))) val) + ;; For "date", only keep the year! + ((string-match "[0-9]\\{4\\}" val) + (match-string 0 val)) + (t val))))))) (space (when size (setq size (string-to-number size)) (propertize " " 'display @@ -1619,7 +1622,7 @@ Return non-nil if a selection was deactivated." (setq active (if (listp active) (mpc-intersection active vals) vals)))) - (when (and (listp active)) + (when (listp active) ;; Remove the selections if they are all in conflict with ;; other constraints. (let ((deactivate t)) @@ -1633,8 +1636,14 @@ Return non-nil if a selection was deactivated." (setq selection nil) (mapc 'delete-overlay mpc-select) (setq mpc-select nil) - (mpc-tagbrowser-all-select))))) - + (mpc-tagbrowser-all-select)))) + + ;; Don't bother splitting the "active" elements to the first part if + ;; they're the same as the selection. + (when (equal (sort (copy-sequence active) #'string-lessp) + (sort (copy-sequence selection) #'string-lessp)) + (setq active 'all))) + ;; FIXME: This `mpc-sort' takes a lot of time. Maybe we should ;; be more clever and presume the buffer is mostly sorted already. (mpc-sort (if (listp active) active)) @@ -1796,7 +1805,9 @@ A value of t means the main playlist.") ;; Maintain the volume. (setq mpc-volume (mpc-volume-widget - (string-to-number (cdr (assq 'volume mpc-status)))))) + (string-to-number (cdr (assq 'volume mpc-status))))) + (let ((status-buf (mpc-proc-buffer (mpc-proc) 'status))) + (when status-buf (with-current-buffer status-buf (force-mode-line-update))))) (defvar mpc-volume-step 5) @@ -1866,7 +1877,7 @@ This is used so that they can be compared with `eq', which is needed for `text-property-any'.") (defun mpc-songs-hashcons (name) (or (gethash name mpc-songs-hashcons) (puthash name name mpc-songs-hashcons))) -(defcustom mpc-songs-format "%2{Disc--}%3{Track} %-5{Time} %25{Title} %20{Album} %20{Artist} %10{Date}" +(defcustom mpc-songs-format "%2{Disc--}%3{Track} %-5{Time} %25{Title} %20{Album} %20{Artist} %5{Date}" "Format used to display each song in the list of songs." :type 'string) @@ -2025,7 +2036,7 @@ This is used so that they can be compared with `eq', which is needed for (match-string 1))))) (cond ((null re) (posn-set-point posn)) - ((null sn) (error "This song is not in the playlist")) + ((null sn) (user-error "This song is not in the playlist")) ((null (with-current-buffer plbuf (re-search-forward re nil t))) ;; song-file only appears once in the playlist: no ambiguity, ;; we're good to go! @@ -2335,7 +2346,7 @@ This is used so that they can be compared with `eq', which is needed for (if (mpc-playlist-add) (if (member (cdr (assq 'state (mpc-cmd-status))) '("stop")) (mpc-cmd-play)) - (error "Don't know what to play")))) + (user-error "Don't know what to play")))) (defun mpc-next () "Jump to the next song in the queue." @@ -2599,7 +2610,8 @@ This is used so that they can be compared with `eq', which is needed for (mpc-cmd-move (let ((poss '())) (dotimes (i (length songs)) (push (+ i (length pl)) poss)) - (nreverse poss)) dest-pos mpc-songs-playlist) + (nreverse poss)) + dest-pos mpc-songs-playlist) (message "Added %d songs" (length songs))))) (mpc-songs-refresh)) (t diff --git a/lisp/msb.el b/lisp/msb.el index 8438d522153..149d1934463 100644 --- a/lisp/msb.el +++ b/lisp/msb.el @@ -1064,7 +1064,7 @@ variable `msb-menu-cond'." list)) (defun msb--make-keymap-menu (raw-menu) - (let ((end (cons '(nil) 'menu-bar-select-buffer)) + (let ((end 'menu-bar-select-buffer) (mcount 0)) (mapcar (lambda (sub-menu) @@ -1105,13 +1105,12 @@ variable `msb-menu-cond'." (setcdr (nthcdr msb-max-menu-items frames) nil)) (setq frames-menu (nconc - (list 'frame f-title '(nil) 'keymap f-title) + (list 'frame f-title 'keymap f-title) (mapcar (lambda (frame) (nconc (list (frame-parameter frame 'name) - (frame-parameter frame 'name) - (cons nil nil)) + (frame-parameter frame 'name)) `(lambda () (interactive) (menu-bar-select-frame ,frame)))) frames))))) diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index d124027ea72..52153ad8322 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -1536,8 +1536,8 @@ then kill the related FTP process." (signal 'file-error (list "Opening directory" (if (file-exists-p directory) - "not a directory" - "no such file or directory") + "Not a directory" + "No such file or directory") directory)))) ;;;; ------------------------------------------------------------ @@ -2831,16 +2831,24 @@ match subdirectories as well.") files ange-ftp-files-hashtable))) (defun ange-ftp-switches-ok (switches) - "Return SWITCHES (a string) if suitable for our use." + "Return SWITCHES (a string) if suitable for use with ls over ftp." (and (stringp switches) - ;; We allow the A switch, which lists all files except "." and - ;; "..". This is OK because we manually insert these entries - ;; in the hash table. + ;; We allow the --almost-all switch, which lists all files + ;; except "." and "..". This is OK because we manually + ;; insert these entries in the hash table. (string-match - "--\\(almost-\\)?all\\>\\|\\(\\`\\| \\)-[[:alpha:]]*[aA]" switches) + "--\\(almost-\\)?all\\>\\|\\(\\`\\| \\)-[[:alpha:]]*[aA]" + switches) + ;; Disallow other long flags except --(almost-)all. + (not (string-match "\\(\\`\\| \\)--\\w+" + (replace-regexp-in-string + "--\\(almost-\\)?all\\>" "" + switches))) + ;; Must include 'l'. (string-match "\\(\\`\\| \\)-[[:alpha:]]*l" switches) + ;; Disallow recursive flag. (not (string-match - "--recursive\\>\\|\\(\\`\\| \\)-[[:alpha:]]*R" switches)) + "\\(\\`\\| \\)-[[:alpha:]]*R" switches)) switches)) (defun ange-ftp-get-files (directory &optional no-error) @@ -3656,7 +3664,7 @@ so return the size on the remote host exactly. See RFC 3659." (or (file-exists-p filename) (signal 'file-error - (list "Copy file" "no such file or directory" filename))) + (list "Copy file" "No such file or directory" filename))) ;; canonicalize newname if a directory. (if (file-directory-p newname) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index e6ae0d7df06..42fb9549255 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -1343,16 +1343,12 @@ used instead of `browse-url-new-window-flag'." "newwin\n" "goto\n") url "\n") - (let ((umask (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes ?\700) - (if (file-exists-p - (setq pidfile (format "/tmp/Mosaic.%d" pid))) - (delete-file pidfile)) - ;; http://debbugs.gnu.org/17428. Use O_EXCL. - (write-region nil nil pidfile nil 'silent nil 'excl)) - (set-default-file-modes umask)))) + (with-file-modes ?\700 + (if (file-exists-p + (setq pidfile (format "/tmp/Mosaic.%d" pid))) + (delete-file pidfile)) + ;; http://debbugs.gnu.org/17428. Use O_EXCL. + (write-region nil nil pidfile nil 'silent nil 'excl))) ;; Send signal SIGUSR to Mosaic (message "Signaling Mosaic...") (signal-process pid 'SIGUSR1) diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index b6ce8c5dac8..bbce300af40 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -544,6 +544,10 @@ placed in the queue. `:already-owner': Service is already the primary owner." + ;; Add Peer handler. + (dbus-register-method + bus service nil dbus-interface-peer "Ping" 'dbus-peer-handler 'dont-register) + ;; Add ObjectManager handler. (dbus-register-method bus service nil dbus-interface-objectmanager "GetManagedObjects" @@ -1151,6 +1155,22 @@ apply bus service dbus-path-dbus dbus-interface-peer "Ping"))) (dbus-error nil))) +(defun dbus-peer-handler () + "Default handler for the \"org.freedesktop.DBus.Peer\" interface. +It will be registered for all objects created by `dbus-register-service'." + (let* ((last-input-event last-input-event) + (method (dbus-event-member-name last-input-event))) + (cond + ;; "Ping" does not return an output parameter. + ((string-equal method "Ping") + :ignore) + ;; "GetMachineId" returns "s". + ((string-equal method "GetMachineId") + (signal + 'dbus-error + (list + (format "%s.GetMachineId not implemented" dbus-interface-peer))))))) + ;;; D-Bus introspection. @@ -1672,7 +1692,7 @@ and \"org.freedesktop.DBus.Properties.GetAll\", which is slow." (defun dbus-managed-objects-handler () "Default handler for the \"org.freedesktop.DBus.ObjectManager\" interface. -It will be registered for all objects created by `dbus-register-method'." +It will be registered for all objects created by `dbus-register-service'." (let* ((last-input-event last-input-event) (bus (dbus-event-bus-name last-input-event)) (path (dbus-event-path-name last-input-event))) diff --git a/lisp/net/dns.el b/lisp/net/dns.el index e2e55b84c76..ba6523f6f5f 100644 --- a/lisp/net/dns.el +++ b/lisp/net/dns.el @@ -31,6 +31,12 @@ "List of DNS servers to query. If nil, /etc/resolv.conf and nslookup will be consulted.") +(defvar dns-servers-valid-for-interfaces nil + "The return value of `network-interface-list' when `dns-servers' was set. +If the set of network interfaces and/or their IP addresses +change, then presumably the list of DNS servers needs to be +updated. Set this variable to t to disable the check.") + ;;; Internal code: (defvar dns-query-types @@ -297,6 +303,17 @@ If TCP-P, the first two bytes of the package with be the length field." (t string))) (goto-char point)))) +(declare-function network-interface-list "process.c") + +(defun dns-servers-up-to-date-p () + "Return false if we need to recheck the list of DNS servers." + (and dns-servers + (or (eq dns-servers-valid-for-interfaces t) + ;; `network-interface-list' was introduced in Emacs 22.1. + (not (fboundp 'network-interface-list)) + (equal dns-servers-valid-for-interfaces + (network-interface-list))))) + (defun dns-set-servers () "Set `dns-servers' to a list of DNS servers or nil if none are found. Parses \"/etc/resolv.conf\" or calls \"nslookup\"." @@ -314,7 +331,9 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"." (goto-char (point-min)) (re-search-forward "^Address:[ \t]*\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t) - (setq dns-servers (list (match-string 1))))))) + (setq dns-servers (list (match-string 1)))))) + (when (fboundp 'network-interface-list) + (setq dns-servers-valid-for-interfaces (network-interface-list)))) (defun dns-read-txt (string) (if (> (length string) 1) @@ -378,7 +397,7 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"." If FULLP, return the entire record returned. If REVERSEP, look up an IP address." (setq type (or type 'A)) - (unless dns-servers + (unless (dns-servers-up-to-date-p) (dns-set-servers)) (when reversep diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el index 622ea72d021..f01f671de9e 100644 --- a/lisp/net/eudc-bob.el +++ b/lisp/net/eudc-bob.el @@ -3,7 +3,8 @@ ;; Copyright (C) 1999-2015 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> -;; Maintainer: Pavel Janík <Pavel@Janik.cz> +;; Pavel Janík <Pavel@Janik.cz> +;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Keywords: comm ;; Package: eudc diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el index bbdb294da7f..0e54d841d57 100644 --- a/lisp/net/eudc-export.el +++ b/lisp/net/eudc-export.el @@ -3,7 +3,8 @@ ;; Copyright (C) 1998-2015 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> -;; Maintainer: Pavel Janík <Pavel@Janik.cz> +;; Pavel Janík <Pavel@Janik.cz> +;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Keywords: comm ;; Package: eudc diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el index b3c9a6db0d5..7416ad090eb 100644 --- a/lisp/net/eudc-hotlist.el +++ b/lisp/net/eudc-hotlist.el @@ -3,7 +3,8 @@ ;; Copyright (C) 1998-2015 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> -;; Maintainer: Pavel Janík <Pavel@Janik.cz> +;; Pavel Janík <Pavel@Janik.cz> +;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Keywords: comm ;; Package: eudc diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el index 6bc0337f958..36a583daa4d 100644 --- a/lisp/net/eudc-vars.el +++ b/lisp/net/eudc-vars.el @@ -3,7 +3,8 @@ ;; Copyright (C) 1998-2015 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> -;; Maintainer: Pavel Janík <Pavel@Janik.cz> +;; Pavel Janík <Pavel@Janik.cz> +;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Keywords: comm ;; Package: eudc @@ -41,14 +42,36 @@ "The name or IP address of the directory server. A port number may be specified by appending a colon and a number to the name of the server. Use `localhost' if the directory -server resides on your computer (BBDB backend)." - :type '(choice (string :tag "Server") (const :tag "None" nil)) - :group 'eudc) +server resides on your computer (BBDB backend). + +To specify multiple servers, customize eudc-server-hotlist +instead." + :type '(choice (string :tag "Server") (const :tag "None" nil))) ;; Known protocols (used in completion) ;; Not to be mistaken with `eudc-supported-protocols' (defvar eudc-known-protocols '(bbdb ph ldap)) +(defcustom eudc-server-hotlist nil + "Directory servers to query. +This is an alist of the form (SERVER . PROTOCOL). SERVER is the +host name or URI of the server, PROTOCOL is a symbol representing +the EUDC backend with which to access the server. + +The BBDB backend ignores SERVER; `localhost' can be used as a +placeholder string." + :tag "Directory Servers to Query" + :type `(repeat (cons :tag "Directory Server" + (string :tag "Server Host Name or URI") + (choice :tag "Protocol" + :menu-tag "Protocol" + ,@(mapcar (lambda (s) + (list 'const + ':tag (symbol-name s) s)) + eudc-known-protocols) + (const :tag "None" nil)))) + :version "25.1") + (defvar eudc-supported-protocols nil "Protocols currently supported by EUDC. This variable is updated when protocol-specific libraries @@ -61,15 +84,13 @@ Supported protocols are specified by `eudc-supported-protocols'." ,@(mapcar (lambda (s) (list 'const ':tag (symbol-name s) s)) eudc-known-protocols) - (const :tag "None" nil)) - :group 'eudc) + (const :tag "None" nil))) (defcustom eudc-strict-return-matches t "Ignore or allow entries not containing all requested return attributes. If non-nil, such entries are ignored." - :type 'boolean - :group 'eudc) + :type 'boolean) (defcustom eudc-default-return-attributes nil "A list of default attributes to extract from directory entries. @@ -82,8 +103,7 @@ server." (repeat :menu-tag "Attribute list" :tag "Attribute name" :value (nil) - (symbol :tag "Attribute name"))) - :group 'eudc) + (symbol :tag "Attribute name")))) (defcustom eudc-multiple-match-handling-method 'select "What to do when multiple entries match an inline expansion query. @@ -102,8 +122,7 @@ Possible values are: (const :menu-tag "Abort Operation" :tag "Abort Operation" abort) (const :menu-tag "Default (Use First)" - :tag "Default (Use First)" nil)) - :group 'eudc) + :tag "Default (Use First)" nil))) (defcustom eudc-duplicate-attribute-handling-method '((email . duplicate)) "A method to handle entries containing duplicate attributes. @@ -130,10 +149,10 @@ different values." (const :menu-tag "List" list) (const :menu-tag "First" first) (const :menu-tag "Concat" concat) - (const :menu-tag "Duplicate" duplicate))))) - :group 'eudc) + (const :menu-tag "Duplicate" duplicate)))))) -(defcustom eudc-inline-query-format '((name) +(defcustom eudc-inline-query-format '((email) + (firstname) (firstname name)) "Format of an inline expansion query. This is a list of FORMATs. A FORMAT is itself a list of one or more @@ -160,14 +179,16 @@ must be set in a protocol/server-local fashion, see `eudc-server-set' and (const :menu-tag "Email Address" :tag "Email Address" email) (const :menu-tag "Phone" :tag "Phone" phone) (symbol :menu-tag "Other" :tag "Attribute name")))) - :group 'eudc) + :version "25.1") -(defcustom eudc-expansion-overwrites-query t +;; Default to nil so that the most common use of eudc-expand-inline, +;; where replace is nil, does not affect the kill ring. +(defcustom eudc-expansion-overwrites-query nil "If non-nil, expanding a query overwrites the query string." :type 'boolean - :group 'eudc) + :version "25.1") -(defcustom eudc-inline-expansion-format '("%s" email) +(defcustom eudc-inline-expansion-format '("%s %s <%s>" firstname name email) "A list specifying the format of the expansion of inline queries. This variable controls what `eudc-expand-inline' actually inserts in the buffer. First element is a string passed to `format'. Remaining @@ -185,7 +206,7 @@ are passed as additional arguments to `format'." (const :menu-tag "Phone" :tag "Phone" phone) (symbol :menu-tag "Other") (symbol :tag "Attribute name")))) - :group 'eudc) + :version "25.1") (defcustom eudc-inline-expansion-servers 'server-then-hotlist "Which servers to contact for the expansion of inline queries. @@ -198,8 +219,7 @@ Possible values are: :menu-tag "Servers" (const :menu-tag "Current server" current-server) (const :menu-tag "Servers in the hotlist" hotlist) - (const :menu-tag "Current server then hotlist" server-then-hotlist)) - :group 'eudc) + (const :menu-tag "Current server then hotlist" server-then-hotlist))) (defcustom eudc-max-servers-to-query nil "Maximum number of servers to query for an inline expansion. @@ -213,8 +233,7 @@ If nil, query all servers available from `eudc-inline-expansion-servers'." (const :menu-tag "3" 3) (const :menu-tag "4" 4) (const :menu-tag "5" 5) - (integer :menu-tag "Set")) - :group 'eudc) + (integer :menu-tag "Set"))) (defcustom eudc-query-form-attributes '(name firstname email phone) "A list of attributes presented in the query form." @@ -226,8 +245,7 @@ If nil, query all servers available from `eudc-inline-expansion-servers'." (const :menu-tag "Surname" :tag "Surname" name) (const :menu-tag "Email Address" :tag "Email Address" email) (const :menu-tag "Phone" :tag "Phone" phone) - (symbol :menu-tag "Other" :tag "Attribute name"))) - :group 'eudc) + (symbol :menu-tag "Other" :tag "Attribute name")))) (defcustom eudc-user-attribute-names-alist '((url . "URL") (callsign . "HAM Call Sign") @@ -257,15 +275,13 @@ at `_' characters and capitalizing the individual words." :tag "User-defined Names of Directory Attributes" :type '(repeat (cons :tag "Field" (symbol :tag "Directory attribute") - (string :tag "User friendly name "))) - :group 'eudc) + (string :tag "User friendly name ")))) (defcustom eudc-use-raw-directory-names nil "If non-nil, use attributes names as defined in the directory. Otherwise, directory query/response forms display the user attribute names defined in `eudc-user-attribute-names-alist'." - :type 'boolean - :group 'eudc) + :type 'boolean) (defcustom eudc-attribute-display-method-alist nil "An alist specifying methods to display attribute values. @@ -277,8 +293,7 @@ attribute values for display." :tag "Attribute Decoding Functions" :type '(repeat (cons :tag "Attribute" (symbol :tag "Name") - (symbol :tag "Display Function"))) - :group 'eudc) + (symbol :tag "Display Function")))) (defcustom eudc-external-viewers '(("ImageMagick" "display" "-") ("ShowAudio" "showaudio")) @@ -295,18 +310,15 @@ arguments that should be passed to the program." (repeat :tag "Arguments" :inline t - (string :tag "Argument")))) - :group 'eudc) + (string :tag "Argument"))))) (defcustom eudc-options-file "~/.eudc-options" "A file where the `servers' hotlist is stored." - :type '(file :Tag "File Name:") - :group 'eudc) + :type '(file :Tag "File Name:")) (defcustom eudc-mode-hook nil "Normal hook run on entry to EUDC mode." - :type '(repeat (sexp :tag "Hook definition")) - :group 'eudc) + :type 'hook) ;;}}} @@ -341,8 +353,7 @@ BBDB fields. SPECs are sexps which are evaluated: :tag "BBDB to PH Field Name Mapping" :type '(repeat (cons :tag "Field Name" (symbol :tag "BBDB Field") - (sexp :tag "Conversion Spec"))) - :group 'eudc-ph) + (sexp :tag "Conversion Spec")))) ;;}}} @@ -376,8 +387,7 @@ BBDB fields. SPECs are sexps which are evaluated: :tag "BBDB to LDAP Attribute Names Mapping" :type '(repeat (cons :tag "Field Name" (symbol :tag "BBDB Field") - (sexp :tag "Conversion Spec"))) - :group 'eudc-ldap) + (sexp :tag "Conversion Spec")))) ;;}}} @@ -391,14 +401,12 @@ BBDB fields. SPECs are sexps which are evaluated: "If non-nil, BBDB address and phone locations are used as attribute names. This has no effect on queries (you can't search for a specific location) but influences the way records are displayed." - :type 'boolean - :group 'eudc-bbdb) + :type 'boolean) (defcustom eudc-bbdb-enable-substring-matches t "If non-nil, authorize substring match in the same way BBDB does. Otherwise records must match queries exactly." - :type 'boolean - :group 'eudc-bbdb) + :type 'boolean) ;;}}} diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 0f2fc0be7bd..cf5d13fce88 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -3,7 +3,8 @@ ;; Copyright (C) 1998-2015 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> -;; Maintainer: Pavel Janík <Pavel@Janik.cz> +;; Pavel Janík <Pavel@Janik.cz> +;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Keywords: comm ;; This file is part of GNU Emacs. @@ -76,10 +77,6 @@ (defvar mode-popup-menu) -;; List of known servers -;; Alist of (SERVER . PROTOCOL) -(defvar eudc-server-hotlist nil) - ;; List of variables that have server- or protocol-local bindings (defvar eudc-local-vars nil) @@ -688,7 +685,8 @@ server for future sessions." (cons (symbol-name elt) elt)) eudc-known-protocols))))) - (unless (or (member protocol + (unless (or (null protocol) + (member protocol eudc-supported-protocols) (load (concat "eudcb-" (symbol-name protocol)) t)) (error "Unsupported protocol: %s" protocol)) @@ -766,7 +764,6 @@ otherwise a list of symbols is returned." format (cdr format))) ;; If the same attribute appears more than once, merge ;; the corresponding values - (setq query-alist (nreverse query-alist)) (while query-alist (setq key (eudc-caar query-alist) val (eudc-cdar query-alist) @@ -812,19 +809,29 @@ If REPLACE is non-nil, then this expansion replaces the name in the buffer. Multiple servers can be tried with the same query until one finds a match, see `eudc-inline-expansion-servers'" (interactive) - (if (memq eudc-inline-expansion-servers - '(current-server server-then-hotlist)) - (or eudc-server - (call-interactively 'eudc-set-server)) + (cond + ((eq eudc-inline-expansion-servers 'current-server) + (or eudc-server + (call-interactively 'eudc-set-server))) + ((eq eudc-inline-expansion-servers 'server-then-hotlist) + (or eudc-server + ;; Allow server to be nil if hotlist is set. + eudc-server-hotlist + (call-interactively 'eudc-set-server))) + ((eq eudc-inline-expansion-servers 'hotlist) (or eudc-server-hotlist (error "No server in the hotlist"))) + (t + (error "Wrong value for `eudc-inline-expansion-servers': %S" + eudc-inline-expansion-servers))) (let* ((end (point)) (beg (save-excursion (if (re-search-backward "\\([:,]\\|^\\)[ \t]*" (point-at-bol) 'move) (goto-char (match-end 0))) (point))) - (query-words (split-string (buffer-substring beg end) "[ \t]+")) + (query-words (split-string (buffer-substring-no-properties beg end) + "[ \t]+")) query-formats response response-string @@ -840,18 +847,17 @@ see `eudc-inline-expansion-servers'" ((eq eudc-inline-expansion-servers 'hotlist) eudc-server-hotlist) ((eq eudc-inline-expansion-servers 'server-then-hotlist) - (cons (cons eudc-server eudc-protocol) - (delete (cons eudc-server eudc-protocol) servers))) + (if eudc-server + (cons (cons eudc-server eudc-protocol) + (delete (cons eudc-server eudc-protocol) servers)) + eudc-server-hotlist)) ((eq eudc-inline-expansion-servers 'current-server) - (list (cons eudc-server eudc-protocol))) - (t - (error "Wrong value for `eudc-inline-expansion-servers': %S" - eudc-inline-expansion-servers)))) + (list (cons eudc-server eudc-protocol))))) (if (and eudc-max-servers-to-query (> (length servers) eudc-max-servers-to-query)) (setcdr (nthcdr (1- eudc-max-servers-to-query) servers) nil)) - (condition-case signal + (unwind-protect (progn (setq response (catch 'found @@ -887,14 +893,15 @@ see `eudc-inline-expansion-servers'" ;; Process response through eudc-inline-expansion-format (while response - (setq response-string (apply 'format - (car eudc-inline-expansion-format) - (mapcar (function - (lambda (field) - (or (cdr (assq field (car response))) - ""))) - (eudc-translate-attribute-list - (cdr eudc-inline-expansion-format))))) + (setq response-string + (apply 'format + (car eudc-inline-expansion-format) + (mapcar (function + (lambda (field) + (or (cdr (assq field (car response))) + ""))) + (eudc-translate-attribute-list + (cdr eudc-inline-expansion-format))))) (if (> (length response-string) 0) (setq response-strings (cons response-string response-strings))) @@ -916,15 +923,10 @@ see `eudc-inline-expansion-servers'" (delete-region beg end) (insert (mapconcat 'identity response-strings ", "))) ((eq eudc-multiple-match-handling-method 'abort) - (error "There is more than one match for the query")))) - (or (and (equal eudc-server eudc-former-server) - (equal eudc-protocol eudc-former-protocol)) - (eudc-set-server eudc-former-server eudc-former-protocol t))) - (error - (or (and (equal eudc-server eudc-former-server) - (equal eudc-protocol eudc-former-protocol)) - (eudc-set-server eudc-former-server eudc-former-protocol t)) - (signal (car signal) (cdr signal)))))) + (error "There is more than one match for the query"))))) + (or (and (equal eudc-server eudc-former-server) + (equal eudc-protocol eudc-former-protocol)) + (eudc-set-server eudc-former-server eudc-former-protocol t))))) ;;;###autoload (defun eudc-query-form (&optional get-fields-from-server) diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el index 0400e5b5bb4..5be2bec0c5d 100644 --- a/lisp/net/eudcb-bbdb.el +++ b/lisp/net/eudcb-bbdb.el @@ -3,7 +3,8 @@ ;; Copyright (C) 1998-2015 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> -;; Maintainer: Pavel Janík <Pavel@Janik.cz> +;; Pavel Janík <Pavel@Janik.cz> +;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Keywords: comm ;; Package: eudc diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el index 4c9b2490ee3..1d426a7b7b0 100644 --- a/lisp/net/eudcb-ldap.el +++ b/lisp/net/eudcb-ldap.el @@ -3,7 +3,8 @@ ;; Copyright (C) 1998-2015 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> -;; Maintainer: Pavel Janík <Pavel@Janik.cz> +;; Pavel Janík <Pavel@Janik.cz> +;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Keywords: comm ;; Package: eudc @@ -70,16 +71,17 @@ ("mail" . eudc-display-mail) ("url" . eudc-display-url)) 'ldap) -(eudc-protocol-set 'eudc-switch-to-server-hook - '(eudc-ldap-check-base) - 'ldap) (defun eudc-ldap-cleanup-record-simple (record) "Do some cleanup in a RECORD to make it suitable for EUDC." (mapcar (function (lambda (field) - (cons (intern (car field)) + ;; Some servers return case-sensitive names (e.g. givenName + ;; instead of givenname); downcase the field's name so that it + ;; can be matched against + ;; eudc-ldap-attributes-translation-alist. + (cons (intern (downcase (car field))) (if (cdr (cdr field)) (cdr field) (car (cdr field)))))) @@ -95,7 +97,7 @@ (mapcar (function (lambda (field) - (let ((name (intern (car field))) + (let ((name (intern (downcase (car field)))) (value (cdr field))) (if (memq name '(postaladdress registeredaddress)) (setq value (mapcar 'eudc-filter-$ value))) @@ -170,14 +172,16 @@ attribute names are returned. Default to `person'" (defun eudc-ldap-format-query-as-rfc1558 (query) "Format the EUDC QUERY list as a RFC1558 LDAP search filter." - (format "(&%s)" - (apply 'concat - (mapcar (lambda (item) - (format "(%s=%s)" - (car item) - (eudc-ldap-escape-query-special-chars (cdr item)))) - query)))) - + (let ((formatter (lambda (item &optional wildcard) + (format "(%s=%s)" + (car item) + (concat + (eudc-ldap-escape-query-special-chars + (cdr item)) (if wildcard "*" "")))))) + (format "(&%s)" + (concat + (mapconcat formatter (butlast query) "") + (funcall formatter (car (last query)) t))))) ;;}}} diff --git a/lisp/net/eudcb-mab.el b/lisp/net/eudcb-mab.el index 81d8f24ecb2..a11cd95b05d 100644 --- a/lisp/net/eudcb-mab.el +++ b/lisp/net/eudcb-mab.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2003-2015 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw@newartisans.com> -;; Maintainer: emacs-devel@gnu.org +;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Keywords: comm ;; Package: eudc diff --git a/lisp/net/eudcb-ph.el b/lisp/net/eudcb-ph.el index fc6aad671c0..1897e0b08bc 100644 --- a/lisp/net/eudcb-ph.el +++ b/lisp/net/eudcb-ph.el @@ -3,7 +3,8 @@ ;; Copyright (C) 1998-2015 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> -;; Maintainer: Pavel Janík <Pavel@Janik.cz> +;; Pavel Janík <Pavel@Janik.cz> +;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Keywords: comm ;; Package: eudc diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 913f0c501ae..ec7a0baacf6 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1,4 +1,4 @@ -;;; eww.el --- Emacs Web Wowser +;;; eww.el --- Emacs Web Wowser -*- lexical-binding:t -*- ;; Copyright (C) 2013-2015 Free Software Foundation, Inc. @@ -28,13 +28,16 @@ (require 'format-spec) (require 'shr) (require 'url) +(require 'url-queue) +(require 'url-util) ; for url-get-url-at-point (require 'mm-url) +(eval-when-compile (require 'subr-x)) ;; for string-trim (defgroup eww nil "Emacs Web Wowser" - :version "24.4" + :version "25.1" :link '(custom-manual "(eww) Top") - :group 'hypermedia + :group 'web :prefix "eww-") (defcustom eww-header-line-format "%t: %u" @@ -57,6 +60,64 @@ :group 'eww :type 'string) +(defcustom eww-suggest-uris + '(eww-links-at-point + url-get-url-at-point + eww-current-url) + "List of functions called to form the list of default URIs for `eww'. +Each of the elements is a function returning either a string or a list +of strings. The results will be joined into a single list with +duplicate entries (if any) removed." + :version "25.1" + :group 'eww + :type 'hook + :options '(eww-links-at-point + url-get-url-at-point + eww-current-url)) + +(defcustom eww-bookmarks-directory user-emacs-directory + "Directory where bookmark files will be stored." + :version "25.1" + :group 'eww + :type 'string) + +(defcustom eww-desktop-remove-duplicates t + "Whether to remove duplicates from the history when saving desktop data. +If non-nil, repetitive EWW history entries (comprising of the URI, the +title, and the point position) will not be saved as part of the Emacs +desktop. Otherwise, such entries will be retained." + :version "25.1" + :group 'eww + :type 'boolean) + +(defcustom eww-restore-desktop nil + "How to restore EWW buffers on `desktop-restore'. +If t or 'auto, the buffers will be reloaded automatically. +If nil, buffers will require manual reload, and will contain the text +specified in `eww-restore-reload-prompt' instead of the actual Web +page contents." + :version "25.1" + :group 'eww + :type '(choice (const :tag "Restore all automatically" t) + (const :tag "Require manual reload" nil))) + +(defcustom eww-restore-reload-prompt + "\n\n *** Use \\[eww-reload] to reload this buffer. ***\n" + "The string to put in the buffers not reloaded on `desktop-restore'. +This prompt will be used if `eww-restore-desktop' is nil. + +The string will be passed through `substitute-command-keys'." + :version "25.1" + :group 'eww + :type 'string) + +(defcustom eww-history-limit 50 + "Maximum number of entries to retain in the history." + :version "25.1" + :group 'eww + :type '(choice (const :tag "Unlimited" nil) + integer)) + (defcustom eww-use-external-browser-for-content-type "\\`\\(video/\\|audio/\\|application/ogg\\)" "Always use external browser for specified content-type." @@ -65,6 +126,12 @@ :type '(choice (const :tag "Never" nil) regexp)) +(defcustom eww-after-render-hook nil + "A hook called after eww has finished rendering the buffer." + :version "25.1" + :group 'eww + :type 'hook) + (defcustom eww-form-checkbox-selected-symbol "[X]" "Symbol used to represent a selected checkbox. See also `eww-form-checkbox-symbol'." @@ -92,6 +159,14 @@ See also `eww-form-checkbox-selected-symbol'." :version "24.4" :group 'eww) +(defface eww-form-file + '((((type x w32 ns) (class color)) ; Like default mode line + :box (:line-width 2 :style released-button) + :background "#808080" :foreground "black")) + "Face for eww buffer buttons." + :version "25.1" + :group 'eww) + (defface eww-form-checkbox '((((type x w32 ns) (class color)) ; Like default mode line :box (:line-width 2 :style released-button) @@ -124,21 +199,24 @@ See also `eww-form-checkbox-selected-symbol'." :version "24.4" :group 'eww) -(defvar eww-current-url nil) -(defvar eww-current-dom nil) -(defvar eww-current-source nil) -(defvar eww-current-title "" - "Title of current page.") +(defface eww-invalid-certificate + '((default :weight bold) + (((class color)) :foreground "red")) + "Face for web pages with invalid certificates." + :version "25.1" + :group 'eww) + +(defface eww-valid-certificate + '((default :weight bold) + (((class color)) :foreground "ForestGreen")) + "Face for web pages with valid certificates." + :version "25.1" + :group 'eww) + +(defvar eww-data nil) (defvar eww-history nil) (defvar eww-history-position 0) -(defvar eww-next-url nil) -(defvar eww-previous-url nil) -(defvar eww-up-url nil) -(defvar eww-home-url nil) -(defvar eww-start-url nil) -(defvar eww-contents-url nil) - (defvar eww-local-regex "localhost" "When this regex is found in the URL, it's not a keyword but an address.") @@ -147,29 +225,67 @@ See also `eww-form-checkbox-selected-symbol'." (define-key map "\r" 'eww-follow-link) map)) +(defun eww-suggested-uris nil + "Return the list of URIs to suggest at the `eww' prompt. +This list can be customized via `eww-suggest-uris'." + (let ((obseen (make-vector 42 0)) + (uris nil)) + (dolist (fun eww-suggest-uris) + (let ((ret (funcall fun))) + (dolist (uri (if (stringp ret) (list ret) ret)) + (when (and uri (not (intern-soft uri obseen))) + (intern uri obseen) + (push uri uris))))) + (nreverse uris))) + ;;;###autoload (defun eww (url) "Fetch URL and render the page. If the input doesn't look like an URL or a domain name, the word(s) will be searched for via `eww-search-prefix'." - (interactive "sEnter URL or keywords: ") - (cond ((string-match-p "\\`file://" url)) + (interactive + (let* ((uris (eww-suggested-uris)) + (prompt (concat "Enter URL or keywords" + (if uris (format " (default %s)" (car uris)) "") + ": "))) + (list (read-string prompt nil nil uris)))) + (setq url (string-trim url)) + (cond ((string-match-p "\\`file:/" url)) + ;; Don't mangle file: URLs at all. ((string-match-p "\\`ftp://" url) (user-error "FTP is not supported.")) (t - (if (and (= (length (split-string url)) 1) - (or (and (not (string-match-p "\\`[\"\'].*[\"\']\\'" url)) - (> (length (split-string url "\\.")) 1)) - (string-match eww-local-regex url))) + ;; Anything that starts with something that vaguely looks + ;; like a protocol designator is interpreted as a full URL. + (if (or (string-match "\\`[A-Za-z]+:" url) + ;; Also try to match "naked" URLs like + ;; en.wikipedia.org/wiki/Free software + (string-match "\\`[A-Za-z_]+\\.[A-Za-z._]+/" url) + (and (= (length (split-string url)) 1) + (or (and (not (string-match-p "\\`[\"\'].*[\"\']\\'" url)) + (> (length (split-string url "[.:]")) 1)) + (string-match eww-local-regex url)))) (progn (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" url) (setq url (concat "http://" url))) - ;; some site don't redirect final / + ;; Some sites do not redirect final / (when (string= (url-filename (url-generic-parse-url url)) "") (setq url (concat url "/")))) (setq url (concat eww-search-prefix (replace-regexp-in-string " " "+" url)))))) - (url-retrieve url 'eww-render (list url))) + (if (eq major-mode 'eww-mode) + (when (or (plist-get eww-data :url) + (plist-get eww-data :dom)) + (eww-save-history)) + (eww-setup-buffer) + (plist-put eww-data :url url) + (plist-put eww-data :title "") + (eww-update-header-line-format) + (let ((inhibit-read-only t)) + (insert (format "Loading %s..." url)) + (goto-char (point-min)))) + (url-retrieve url 'eww-render + (list url nil (current-buffer)))) ;;;###autoload (defalias 'browse-web 'eww) @@ -182,7 +298,14 @@ word(s) will be searched for via `eww-search-prefix'." "/") (expand-file-name file)))) -(defun eww-render (status url &optional point) +;;;###autoload +(defun eww-search-words (&optional beg end) + "Search the web for the text between the point and marker. +See the `eww-search-prefix' variable for the search engine used." + (interactive "r") + (eww (buffer-substring beg end))) + +(defun eww-render (status url &optional point buffer encode) (let ((redirect (plist-get status :redirect))) (when redirect (setq url redirect))) @@ -196,26 +319,31 @@ word(s) will be searched for via `eww-search-prefix'." (or (cdr (assq 'charset (cdr content-type))) (eww-detect-charset (equal (car content-type) "text/html")) - "utf8")))) + "utf-8")))) (data-buffer (current-buffer))) + ;; Save the https peer status. + (with-current-buffer buffer + (plist-put eww-data :peer (plist-get status :peer))) (unwind-protect (progn - (setq eww-current-title "") (cond ((and eww-use-external-browser-for-content-type (string-match-p eww-use-external-browser-for-content-type (car content-type))) (eww-browse-with-external-browser url)) ((equal (car content-type) "text/html") - (eww-display-html charset url nil point)) + (eww-display-html charset url nil point buffer encode)) + ((equal (car content-type) "application/pdf") + (eww-display-pdf)) ((string-match-p "\\`image/" (car content-type)) - (eww-display-image) - (eww-update-header-line-format)) + (eww-display-image buffer)) (t - (eww-display-raw) - (eww-update-header-line-format))) - (setq eww-current-url url - eww-history-position 0)) + (eww-display-raw buffer encode))) + (with-current-buffer buffer + (plist-put eww-data :url url) + (eww-update-header-line-format) + (setq eww-history-position 0) + (run-hooks 'eww-after-render-hook))) (kill-buffer data-buffer)))) (defun eww-parse-headers () @@ -247,139 +375,170 @@ word(s) will be searched for via `eww-search-prefix'." (declare-function libxml-parse-html-region "xml.c" (start end &optional base-url)) -(defun eww-display-html (charset url &optional document point) - (or (fboundp 'libxml-parse-html-region) - (error "This function requires Emacs to be compiled with libxml2")) - (unless (eq charset 'utf8) - (condition-case nil - (decode-coding-region (point) (point-max) charset) - (coding-system-error nil))) +(defun eww-display-html (charset url &optional document point buffer encode) + (unless (fboundp 'libxml-parse-html-region) + (error "This function requires Emacs to be compiled with libxml2")) + (unless (buffer-live-p buffer) + (error "Buffer %s doesn't exist" buffer)) + ;; There should be a better way to abort loading images + ;; asynchronously. + (setq url-queue nil) (let ((document (or document (list 'base (list (cons 'href url)) - (libxml-parse-html-region (point) (point-max)))))) - (setq eww-current-source (buffer-substring (point) (point-max))) - (eww-setup-buffer) - (setq eww-current-dom document) - (let ((inhibit-read-only t) - (after-change-functions nil) - (shr-width nil) - (shr-target-id (url-target (url-generic-parse-url url))) - (shr-external-rendering-functions - '((title . eww-tag-title) - (form . eww-tag-form) - (input . eww-tag-input) - (textarea . eww-tag-textarea) - (body . eww-tag-body) - (select . eww-tag-select) - (link . eww-tag-link) - (a . eww-tag-a)))) - (shr-insert-document document) - (cond - (point - (goto-char point)) - (shr-target-id - (goto-char (point-min)) - (let ((point (next-single-property-change - (point-min) 'shr-target-id))) - (when point - (goto-char point)))) - (t - (goto-char (point-min))))) - (setq eww-current-url url - eww-history-position 0) - (eww-update-header-line-format))) - -(defun eww-handle-link (cont) - (let* ((rel (assq :rel cont)) - (href (assq :href cont)) - (where (assoc - ;; The text associated with :rel is case-insensitive. - (if rel (downcase (cdr rel))) - '(("next" . eww-next-url) - ;; Texinfo uses "previous", but HTML specifies - ;; "prev", so recognize both. - ("previous" . eww-previous-url) - ("prev" . eww-previous-url) - ;; HTML specifies "start" but also "contents", - ;; and Gtk seems to use "home". Recognize - ;; them all; but store them in different - ;; variables so that we can readily choose the - ;; "best" one. - ("start" . eww-start-url) - ("home" . eww-home-url) - ("contents" . eww-contents-url) - ("up" . eww-up-url))))) + (progn + (when (or (and encode + (not (eq charset encode))) + (not (eq charset 'utf-8))) + (condition-case nil + (decode-coding-region (point) (point-max) + (or encode charset)) + (coding-system-error nil))) + (libxml-parse-html-region (point) (point-max)))))) + (source (and (null document) + (buffer-substring (point) (point-max))))) + (with-current-buffer buffer + (plist-put eww-data :source source) + (plist-put eww-data :dom document) + (let ((inhibit-read-only t) + (inhibit-modification-hooks t) + (shr-target-id (url-target (url-generic-parse-url url))) + (shr-external-rendering-functions + '((title . eww-tag-title) + (form . eww-tag-form) + (input . eww-tag-input) + (textarea . eww-tag-textarea) + (body . eww-tag-body) + (select . eww-tag-select) + (link . eww-tag-link) + (a . eww-tag-a)))) + (erase-buffer) + (shr-insert-document document) + (cond + (point + (goto-char point)) + (shr-target-id + (goto-char (point-min)) + (let ((point (next-single-property-change + (point-min) 'shr-target-id))) + (when point + (goto-char point)))) + (t + (goto-char (point-min)) + ;; Don't leave point inside forms, because the normal eww + ;; commands aren't available there. + (while (and (not (eobp)) + (get-text-property (point) 'eww-form)) + (forward-line 1))))) + (eww-size-text-inputs)))) + +(defun eww-handle-link (dom) + (let* ((rel (dom-attr dom 'rel)) + (href (dom-attr dom 'href)) + (where (assoc + ;; The text associated with :rel is case-insensitive. + (if rel (downcase rel)) + '(("next" . :next) + ;; Texinfo uses "previous", but HTML specifies + ;; "prev", so recognize both. + ("previous" . :previous) + ("prev" . :previous) + ;; HTML specifies "start" but also "contents", + ;; and Gtk seems to use "home". Recognize + ;; them all; but store them in different + ;; variables so that we can readily choose the + ;; "best" one. + ("start" . :start) + ("home" . :home) + ("contents" . :contents) + ("up" . :up))))) (and href where - (set (cdr where) (cdr href))))) + (plist-put eww-data (cdr where) href)))) -(defun eww-tag-link (cont) - (eww-handle-link cont) - (shr-generic cont)) +(defun eww-tag-link (dom) + (eww-handle-link dom) + (shr-generic dom)) -(defun eww-tag-a (cont) - (eww-handle-link cont) +(defun eww-tag-a (dom) + (eww-handle-link dom) (let ((start (point))) - (shr-tag-a cont) + (shr-tag-a dom) (put-text-property start (point) 'keymap eww-link-keymap))) (defun eww-update-header-line-format () - (if eww-header-line-format - (setq header-line-format - (replace-regexp-in-string - "%" "%%" - ;; FIXME? Title can be blank. Default to, eg, last component - ;; of url? - (format-spec eww-header-line-format - `((?u . ,eww-current-url) - (?t . ,eww-current-title))))) - (setq header-line-format nil))) - -(defun eww-tag-title (cont) - (setq eww-current-title "") - (dolist (sub cont) - (when (eq (car sub) 'text) - (setq eww-current-title (concat eww-current-title (cdr sub))))) + (setq header-line-format + (and eww-header-line-format + (let ((title (plist-get eww-data :title)) + (peer (plist-get eww-data :peer))) + (when (zerop (length title)) + (setq title "[untitled]")) + ;; This connection has is https. + (when peer + (setq title + (propertize title 'face + (if (plist-get peer :warnings) + 'eww-invalid-certificate + 'eww-valid-certificate)))) + (replace-regexp-in-string + "%" "%%" + (format-spec + eww-header-line-format + `((?u . ,(or (plist-get eww-data :url) "")) + (?t . ,title)))))))) + +(defun eww-tag-title (dom) + (plist-put eww-data :title + (replace-regexp-in-string + "^ \\| $" "" + (replace-regexp-in-string "[ \t\r\n]+" " " (dom-text dom)))) (eww-update-header-line-format)) -(defun eww-tag-body (cont) +(defun eww-tag-body (dom) (let* ((start (point)) - (fgcolor (cdr (or (assq :fgcolor cont) - (assq :text cont)))) - (bgcolor (cdr (assq :bgcolor cont))) + (fgcolor (or (dom-attr dom 'fgcolor) (dom-attr dom 'text))) + (bgcolor (dom-attr dom 'bgcolor)) (shr-stylesheet (list (cons 'color fgcolor) (cons 'background-color bgcolor)))) - (shr-generic cont) - (eww-colorize-region start (point) fgcolor bgcolor))) - -(defun eww-colorize-region (start end fg &optional bg) - (when (or fg bg) - (let ((new-colors (shr-color-check fg bg))) - (when new-colors - (when fg - (add-face-text-property start end - (list :foreground (cadr new-colors)) - t)) - (when bg - (add-face-text-property start end - (list :background (car new-colors)) - t)))))) - -(defun eww-display-raw () - (let ((data (buffer-substring (point) (point-max)))) - (eww-setup-buffer) - (let ((inhibit-read-only t)) - (insert data)) - (goto-char (point-min)))) + (shr-generic dom) + (shr-colorize-region start (point) fgcolor bgcolor))) -(defun eww-display-image () +(defun eww-display-raw (buffer &optional encode) + (let ((data (buffer-substring (point) (point-max)))) + (unless (buffer-live-p buffer) + (error "Buffer %s doesn't exist" buffer)) + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (erase-buffer) + (insert data) + (unless (eq encode 'utf-8) + (encode-coding-region (point-min) (1+ (length data)) 'utf-8) + (condition-case nil + (decode-coding-region (point-min) (1+ (length data)) encode) + (coding-system-error nil)))) + (goto-char (point-min))))) + +(defun eww-display-image (buffer) (let ((data (shr-parse-image-data))) - (eww-setup-buffer) - (let ((inhibit-read-only t)) - (shr-put-image data nil)) - (goto-char (point-min)))) + (unless (buffer-live-p buffer) + (error "Buffer %s doesn't exist" buffer)) + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (erase-buffer) + (shr-put-image data nil)) + (goto-char (point-min))))) + +(declare-function mailcap-view-mime "mailcap" (type)) +(defun eww-display-pdf () + (let ((data (buffer-substring (point) (point-max)))) + (switch-to-buffer (get-buffer-create "*eww pdf*")) + (let ((coding-system-for-write 'raw-text) + (inhibit-read-only t)) + (erase-buffer) + (insert data) + (mailcap-view-mime "application/pdf"))) + (goto-char (point-min))) (defun eww-setup-buffer () (switch-to-buffer (get-buffer-create "*eww*")) @@ -387,37 +546,98 @@ word(s) will be searched for via `eww-search-prefix'." (remove-overlays) (erase-buffer)) (unless (eq major-mode 'eww-mode) - (eww-mode)) - (setq-local eww-next-url nil) - (setq-local eww-previous-url nil) - (setq-local eww-up-url nil) - (setq-local eww-home-url nil) - (setq-local eww-start-url nil) - (setq-local eww-contents-url nil)) + (eww-mode))) + +(defun eww-current-url nil + "Return URI of the Web page the current EWW buffer is visiting." + (plist-get eww-data :url)) + +(defun eww-links-at-point () + "Return list of URIs, if any, linked at point." + (remq nil + (list (get-text-property (point) 'shr-url) + (get-text-property (point) 'image-url)))) (defun eww-view-source () + "View the HTML source code of the current page." (interactive) (let ((buf (get-buffer-create "*eww-source*")) - (source eww-current-source)) + (source (plist-get eww-data :source))) (with-current-buffer buf - (delete-region (point-min) (point-max)) - (insert (or eww-current-source "no source")) - (goto-char (point-min)) - (when (fboundp 'html-mode) - (html-mode))) + (let ((inhibit-read-only t)) + (delete-region (point-min) (point-max)) + (insert (or source "no source")) + (goto-char (point-min)) + (when (fboundp 'html-mode) + (html-mode)))) (view-buffer buf))) +(defun eww-readable () + "View the main \"readable\" parts of the current web page. +This command uses heuristics to find the parts of the web page that +contains the main textual portion, leaving out navigation menus and +the like." + (interactive) + (let* ((old-data eww-data) + (dom (with-temp-buffer + (insert (plist-get old-data :source)) + (condition-case nil + (decode-coding-region (point-min) (point-max) 'utf-8) + (coding-system-error nil)) + (libxml-parse-html-region (point-min) (point-max))))) + (eww-score-readability dom) + (eww-save-history) + (eww-display-html nil nil + (eww-highest-readability dom) + nil (current-buffer)) + (dolist (elem '(:source :url :title :next :previous :up)) + (plist-put eww-data elem (plist-get old-data elem))) + (eww-update-header-line-format))) + +(defun eww-score-readability (node) + (let ((score -1)) + (cond + ((memq (dom-tag node) '(script head comment)) + (setq score -2)) + ((eq (dom-tag node) 'meta) + (setq score -1)) + ((eq (dom-tag node) 'img) + (setq score 2)) + ((eq (dom-tag node) 'a) + (setq score (- (length (split-string (dom-text node)))))) + (t + (dolist (elem (dom-children node)) + (if (stringp elem) + (setq score (+ score (length (split-string elem)))) + (setq score (+ score + (or (cdr (assoc :eww-readability-score (cdr elem))) + (eww-score-readability elem)))))))) + ;; Cache the score of the node to avoid recomputing all the time. + (dom-set-attribute node :eww-readability-score score) + score)) + +(defun eww-highest-readability (node) + (let ((result node) + highest) + (dolist (elem (dom-non-text-children node)) + (when (> (or (dom-attr + (setq highest (eww-highest-readability elem)) + :eww-readability-score) + most-negative-fixnum) + (or (dom-attr result :eww-readability-score) + most-negative-fixnum)) + (setq result highest))) + result)) + (defvar eww-mode-map (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "q" 'quit-window) - (define-key map "g" 'eww-reload) + (set-keymap-parent map special-mode-map) + (define-key map "g" 'eww-reload) ;FIXME: revert-buffer-function instead! + (define-key map "G" 'eww) (define-key map [?\t] 'shr-next-link) (define-key map [?\M-\t] 'shr-previous-link) + (define-key map [backtab] 'shr-previous-link) (define-key map [delete] 'scroll-down-command) - (define-key map [?\S-\ ] 'scroll-down-command) - (define-key map "\177" 'scroll-down-command) - (define-key map " " 'scroll-up-command) (define-key map "l" 'eww-back-url) (define-key map "r" 'eww-forward-url) (define-key map "n" 'eww-next-url) @@ -429,7 +649,10 @@ word(s) will be searched for via `eww-search-prefix'." (define-key map "w" 'eww-copy-page-url) (define-key map "C" 'url-cookie-list) (define-key map "v" 'eww-view-source) + (define-key map "R" 'eww-readable) (define-key map "H" 'eww-list-histories) + (define-key map "E" 'eww-set-character-encoding) + (define-key map "S" 'eww-list-buffers) (define-key map "b" 'eww-add-bookmark) (define-key map "B" 'eww-list-bookmarks) @@ -438,7 +661,7 @@ word(s) will be searched for via `eww-search-prefix'." (easy-menu-define nil map "" '("Eww" - ["Exit" eww-quit t] + ["Exit" quit-window t] ["Close browser" quit-window t] ["Reload" eww-reload t] ["Back to previous page" eww-back-url @@ -450,15 +673,17 @@ word(s) will be searched for via `eww-search-prefix'." ["View page source" eww-view-source] ["Copy page URL" eww-copy-page-url t] ["List histories" eww-list-histories t] + ["List buffers" eww-list-buffers t] ["Add bookmark" eww-add-bookmark t] ["List bookmarks" eww-list-bookmarks t] - ["List cookies" url-cookie-list t])) + ["List cookies" url-cookie-list t] + ["Character Encoding" eww-set-character-encoding])) map)) (defvar eww-tool-bar-map (let ((map (make-sparse-keymap))) (dolist (tool-bar-item - '((eww-quit . "close") + '((quit-window . "close") (eww-reload . "refresh") (eww-back-url . "left-arrow") (eww-forward-url . "right-arrow") @@ -470,30 +695,28 @@ word(s) will be searched for via `eww-search-prefix'." map) "Tool bar for `eww-mode'.") -(define-derived-mode eww-mode nil "eww" - "Mode for browsing the web. - -\\{eww-mode-map}" - ;; FIXME? This seems a strange default. - (setq-local eww-current-url 'author) - (setq-local eww-current-dom nil) - (setq-local eww-current-source nil) - (setq-local eww-current-title "") - (setq-local browse-url-browser-function 'eww-browse-url) - (setq-local after-change-functions 'eww-process-text-input) +(define-derived-mode eww-mode special-mode "eww" + "Mode for browsing the web." + (setq-local eww-data (list :title "")) + (setq-local browse-url-browser-function #'eww-browse-url) + (add-hook 'after-change-functions #'eww-process-text-input nil t) (setq-local eww-history nil) (setq-local eww-history-position 0) (when (boundp 'tool-bar-map) - (setq-local tool-bar-map eww-tool-bar-map)) + (setq-local tool-bar-map eww-tool-bar-map)) + ;; desktop support + (setq-local desktop-save-buffer #'eww-desktop-misc-data) + ;; multi-page isearch support + (setq-local multi-isearch-next-buffer-function #'eww-isearch-next-buffer) + (setq truncate-lines t) (buffer-disable-undo) - ;;(setq buffer-read-only t) - ) + (setq buffer-read-only t)) ;;;###autoload -(defun eww-browse-url (url &optional _new-window) - (when (and (equal major-mode 'eww-mode) - eww-current-url) - (eww-save-history)) +(defun eww-browse-url (url &optional new-window) + (cond (new-window + (switch-to-buffer (generate-new-buffer "*eww*")) + (eww-mode))) (eww url)) (defun eww-back-url () @@ -514,23 +737,25 @@ word(s) will be searched for via `eww-search-prefix'." (eww-restore-history (elt eww-history (1- eww-history-position)))) (defun eww-restore-history (elem) - (let ((inhibit-read-only t)) - (erase-buffer) - (insert (plist-get elem :text)) - (setq eww-current-source (plist-get elem :source)) - (setq eww-current-dom (plist-get elem :dom)) - (goto-char (plist-get elem :point)) - (setq eww-current-url (plist-get elem :url) - eww-current-title (plist-get elem :title)) - (eww-update-header-line-format))) + (let ((inhibit-read-only t) + (inhibit-modification-hooks t) + (text (plist-get elem :text))) + (setq eww-data elem) + (if (null text) + (eww-reload) ; FIXME: restore :point? + (erase-buffer) + (insert text) + (goto-char (plist-get elem :point)) + (eww-update-header-line-format)))) (defun eww-next-url () "Go to the page marked `next'. A page is marked `next' if rel=\"next\" appears in a <link> or <a> tag." (interactive) - (if eww-next-url - (eww-browse-url (shr-expand-url eww-next-url eww-current-url)) + (if (plist-get eww-data :next) + (eww-browse-url (shr-expand-url (plist-get eww-data :next) + (plist-get eww-data :url))) (user-error "No `next' on this page"))) (defun eww-previous-url () @@ -538,8 +763,9 @@ or <a> tag." A page is marked `previous' if rel=\"previous\" appears in a <link> or <a> tag." (interactive) - (if eww-previous-url - (eww-browse-url (shr-expand-url eww-previous-url eww-current-url)) + (if (plist-get eww-data :previous) + (eww-browse-url (shr-expand-url (plist-get eww-data :previous) + (plist-get eww-data :url))) (user-error "No `previous' on this page"))) (defun eww-up-url () @@ -547,8 +773,9 @@ or <a> tag." A page is marked `up' if rel=\"up\" appears in a <link> or <a> tag." (interactive) - (if eww-up-url - (eww-browse-url (shr-expand-url eww-up-url eww-current-url)) + (if (plist-get eww-data :up) + (eww-browse-url (shr-expand-url (plist-get eww-data :up) + (plist-get eww-data :url))) (user-error "No `up' on this page"))) (defun eww-top-url () @@ -556,18 +783,26 @@ or <a> tag." A page is marked `top' if rel=\"start\", rel=\"home\", or rel=\"contents\" appears in a <link> or <a> tag." (interactive) - (let ((best-url (or eww-start-url - eww-contents-url - eww-home-url))) + (let ((best-url (or (plist-get eww-data :start) + (plist-get eww-data :contents) + (plist-get eww-data :home)))) (if best-url - (eww-browse-url (shr-expand-url best-url eww-current-url)) + (eww-browse-url (shr-expand-url best-url (plist-get eww-data :url))) (user-error "No `top' for this page")))) -(defun eww-reload () - "Reload the current page." - (interactive) - (url-retrieve eww-current-url 'eww-render - (list eww-current-url (point)))) +(defun eww-reload (&optional local encode) + "Reload the current page. +If LOCAL (the command prefix), don't reload the page from the +network, but just re-display the HTML already fetched." + (interactive "P") + (let ((url (plist-get eww-data :url))) + (if local + (if (null (plist-get eww-data :dom)) + (error "No current HTML data") + (eww-display-html 'utf-8 url (plist-get eww-data :dom) + (point) (current-buffer))) + (url-retrieve url 'eww-render + (list url (point) (current-buffer) encode))))) ;; Form support. @@ -579,6 +814,12 @@ appears in a <link> or <a> tag." (define-key map [(control c) (control c)] 'eww-submit) map)) +(defvar eww-submit-file + (let ((map (make-sparse-keymap))) + (define-key map "\r" 'eww-select-file) + (define-key map [(control c) (control c)] 'eww-submit) + map)) + (defvar eww-checkbox-map (let ((map (make-sparse-keymap))) (define-key map " " 'eww-toggle-checkbox) @@ -643,13 +884,12 @@ appears in a <link> or <a> tag." (1- (next-single-property-change (point) 'eww-form nil (point-max)))) -(defun eww-tag-form (cont) - (let ((eww-form - (list (assq :method cont) - (assq :action cont))) +(defun eww-tag-form (dom) + (let ((eww-form (list (cons :method (dom-attr dom 'method)) + (cons :action (dom-attr dom 'action)))) (start (point))) (shr-ensure-paragraph) - (shr-generic cont) + (shr-generic dom) (unless (bolp) (insert "\n")) (insert "\n") @@ -657,9 +897,9 @@ appears in a <link> or <a> tag." (put-text-property start (1+ start) 'eww-form eww-form)))) -(defun eww-form-submit (cont) +(defun eww-form-submit (dom) (let ((start (point)) - (value (cdr (assq :value cont)))) + (value (dom-attr dom 'value))) (setq value (if (zerop (length value)) "Submit" @@ -670,48 +910,74 @@ appears in a <link> or <a> tag." (list :eww-form eww-form :value value :type "submit" - :name (cdr (assq :name cont)))) + :name (dom-attr dom 'name))) (put-text-property start (point) 'keymap eww-submit-map) (insert " "))) -(defun eww-form-checkbox (cont) +(defun eww-form-checkbox (dom) (let ((start (point))) - (if (cdr (assq :checked cont)) + (if (dom-attr dom 'checked) (insert eww-form-checkbox-selected-symbol) (insert eww-form-checkbox-symbol)) (add-face-text-property start (point) 'eww-form-checkbox) (put-text-property start (point) 'eww-form (list :eww-form eww-form - :value (cdr (assq :value cont)) - :type (downcase (cdr (assq :type cont))) - :checked (cdr (assq :checked cont)) - :name (cdr (assq :name cont)))) + :value (dom-attr dom 'value) + :type (downcase (dom-attr dom 'type)) + :checked (dom-attr dom 'checked) + :name (dom-attr dom 'name))) (put-text-property start (point) 'keymap eww-checkbox-map) (insert " "))) -(defun eww-form-text (cont) +(defun eww-form-file (dom) (let ((start (point)) - (type (downcase (or (cdr (assq :type cont)) - "text"))) - (value (or (cdr (assq :value cont)) "")) - (width (string-to-number - (or (cdr (assq :size cont)) - "40"))) - (readonly-property (if (or (cdr (assq :disabled cont)) - (cdr (assq :readonly cont))) + (value (dom-attr dom 'value))) + (setq value + (if (zerop (length value)) + " No file selected" + value)) + (insert "Browse") + (add-face-text-property start (point) 'eww-form-file) + (insert value) + (put-text-property start (point) 'eww-form + (list :eww-form eww-form + :value (dom-attr dom 'value) + :type (downcase (dom-attr dom 'type)) + :name (dom-attr dom 'name))) + (put-text-property start (point) 'keymap eww-submit-file) + (insert " "))) + +(defun eww-select-file () + "Change the value of the upload file menu under point." + (interactive) + (let* ((input (get-text-property (point) 'eww-form))) + (let ((filename + (let ((insert-default-directory t)) + (read-file-name "filename: ")))) + (eww-update-field filename (length "Browse")) + (plist-put input :filename filename)))) + +(defun eww-form-text (dom) + (let ((start (point)) + (type (downcase (or (dom-attr dom 'type) "text"))) + (value (or (dom-attr dom 'value) "")) + (width (string-to-number (or (dom-attr dom 'size) "40"))) + (readonly-property (if (or (dom-attr dom 'disabled) + (dom-attr dom 'readonly)) 'read-only 'inhibit-read-only))) (insert value) (when (< (length value) width) (insert (make-string (- width (length value)) ? ))) (put-text-property start (point) 'face 'eww-form-text) + (put-text-property start (point) 'inhibit-read-only t) (put-text-property start (point) 'local-map eww-text-map) (put-text-property start (point) readonly-property t) (put-text-property start (point) 'eww-form (list :eww-form eww-form :value value :type type - :name (cdr (assq :name cont)))) + :name (dom-attr dom 'name))) (insert " "))) (defconst eww-text-input-types '("text" "password" "textarea" @@ -721,63 +987,70 @@ appears in a <link> or <a> tag." "List of input types which represent a text input. See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") -(defun eww-process-text-input (beg end length) - (let* ((form (get-text-property (min (1+ end) (point-max)) 'eww-form)) - (properties (text-properties-at end)) - (type (plist-get form :type))) - (when (and form - (member type eww-text-input-types)) - (cond - ((zerop length) - ;; Delete some space at the end. - (save-excursion - (goto-char - (if (equal type "textarea") - (1- (line-end-position)) - (eww-end-of-field))) - (let ((new (- end beg))) - (while (and (> new 0) +(defun eww-process-text-input (beg end replace-length) + (when-let (pos (and (< (1+ end) (point-max)) + (> (1- end) (point-min)) + (cond + ((get-text-property (1+ end) 'eww-form) + (1+ end)) + ((get-text-property (1- end) 'eww-form) + (1- end))))) + (let* ((form (get-text-property pos 'eww-form)) + (properties (text-properties-at pos)) + (inhibit-read-only t) + (length (- end beg replace-length)) + (type (plist-get form :type))) + (when (and form + (member type eww-text-input-types)) + (cond + ((> length 0) + ;; Delete some space at the end. + (save-excursion + (goto-char + (if (equal type "textarea") + (1- (line-end-position)) + (eww-end-of-field))) + (while (and (> length 0) (eql (following-char) ? )) - (delete-region (point) (1+ (point))) - (setq new (1- new)))) - (set-text-properties beg end properties))) - ((> length 0) - ;; Add padding. - (save-excursion - (goto-char - (if (equal type "textarea") - (1- (line-end-position)) - (eww-end-of-field))) - (let ((start (point))) - (insert (make-string length ? )) - (set-text-properties start (point) properties))))) - (let ((value (buffer-substring-no-properties - (eww-beginning-of-field) - (eww-end-of-field)))) - (when (string-match " +\\'" value) - (setq value (substring value 0 (match-beginning 0)))) - (plist-put form :value value) - (when (equal type "password") - ;; Display passwords as asterisks. - (let ((start (eww-beginning-of-field))) - (put-text-property start (+ start (length value)) - 'display (make-string (length value) ?*)))))))) - -(defun eww-tag-textarea (cont) + (delete-region (1- (point)) (point)) + (cl-decf length)))) + ((< length 0) + ;; Add padding. + (save-excursion + (goto-char (1- end)) + (goto-char + (if (equal type "textarea") + (1- (line-end-position)) + (1+ (eww-end-of-field)))) + (let ((start (point))) + (insert (make-string (abs length) ? )) + (set-text-properties start (point) properties)) + (goto-char (1- end))))) + (set-text-properties (plist-get form :start) (plist-get form :end) + properties) + (let ((value (buffer-substring-no-properties + (eww-beginning-of-field) + (eww-end-of-field)))) + (when (string-match " +\\'" value) + (setq value (substring value 0 (match-beginning 0)))) + (plist-put form :value value) + (when (equal type "password") + ;; Display passwords as asterisks. + (let ((start (eww-beginning-of-field))) + (put-text-property start (+ start (length value)) + 'display (make-string (length value) ?*))))))))) + +(defun eww-tag-textarea (dom) (let ((start (point)) - (value (or (cdr (assq :value cont)) "")) - (lines (string-to-number - (or (cdr (assq :rows cont)) - "10"))) - (width (string-to-number - (or (cdr (assq :cols cont)) - "10"))) + (value (or (dom-attr dom 'value) "")) + (lines (string-to-number (or (dom-attr dom 'rows) "10"))) + (width (string-to-number (or (dom-attr dom 'cols) "10"))) end) (shr-ensure-newline) (insert value) (shr-ensure-newline) (when (< (count-lines start (point)) lines) - (dotimes (i (- lines (count-lines start (point)))) + (dotimes (_ (- lines (count-lines start (point)))) (insert "\n"))) (setq end (point-marker)) (goto-char start) @@ -788,6 +1061,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (insert (make-string pad ? )))) (add-face-text-property (line-beginning-position) (point) 'eww-form-textarea) + (put-text-property (line-beginning-position) (point) 'inhibit-read-only t) (put-text-property (line-beginning-position) (point) 'local-map eww-textarea-map) (forward-line 1)) @@ -795,21 +1069,22 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (list :eww-form eww-form :value value :type "textarea" - :name (cdr (assq :name cont)))))) + :name (dom-attr dom 'name))))) -(defun eww-tag-input (cont) - (let ((type (downcase (or (cdr (assq :type cont)) - "text"))) +(defun eww-tag-input (dom) + (let ((type (downcase (or (dom-attr dom 'type) "text"))) (start (point))) (cond ((or (equal type "checkbox") (equal type "radio")) - (eww-form-checkbox cont)) + (eww-form-checkbox dom)) + ((equal type "file") + (eww-form-file dom)) ((equal type "submit") - (eww-form-submit cont)) + (eww-form-submit dom)) ((equal type "hidden") (let ((form eww-form) - (name (cdr (assq :name cont)))) + (name (dom-attr dom 'name))) ;; Don't add <input type=hidden> elements repeatedly. (while (and form (or (not (consp (car form))) @@ -821,34 +1096,33 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (nconc eww-form (list (list 'hidden :name name - :value (cdr (assq :value cont)))))))) + :value (dom-attr dom 'value))))))) (t - (eww-form-text cont))) + (eww-form-text dom))) (unless (= start (point)) (put-text-property start (1+ start) 'help-echo "Input field")))) -(defun eww-tag-select (cont) +(defun eww-tag-select (dom) (shr-ensure-paragraph) - (let ((menu (list :name (cdr (assq :name cont)) + (let ((menu (list :name (dom-attr dom 'name) :eww-form eww-form)) (options nil) (start (point)) (max 0) opelem) - (if (eq (car (car cont)) 'optgroup) - (dolist (groupelem cont) - (unless (cdr (assq :disabled (cdr groupelem))) - (setq opelem (append opelem (cdr (cdr groupelem)))))) - (setq opelem cont)) + (if (eq (dom-tag dom) 'optgroup) + (dolist (groupelem (dom-children dom)) + (unless (dom-attr groupelem 'disabled) + (setq opelem (append opelem (list groupelem))))) + (setq opelem (list dom))) (dolist (elem opelem) - (when (eq (car elem) 'option) - (when (cdr (assq :selected (cdr elem))) - (nconc menu (list :value - (cdr (assq :value (cdr elem)))))) - (let ((display (or (cdr (assq 'text (cdr elem))) ""))) + (when (eq (dom-tag elem) 'option) + (when (dom-attr elem 'selected) + (nconc menu (list :value (dom-attr elem 'value)))) + (let ((display (dom-text elem))) (setq max (max max (length display))) (push (list 'item - :value (cdr (assq :value (cdr elem))) + :value (dom-attr elem 'value) :display display) options)))) (when options @@ -897,14 +1171,17 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (goto-char (eww-update-field display)))) -(defun eww-update-field (string) +(defun eww-update-field (string &optional offset) + (if (not offset) (setq offset 0)) (let ((properties (text-properties-at (point))) - (start (eww-beginning-of-field)) - (end (1+ (eww-end-of-field)))) - (delete-region start end) + (start (+ (eww-beginning-of-field) offset)) + (current-end (1+ (eww-end-of-field))) + (new-end (1+ (+ (eww-beginning-of-field) (length string))))) + (delete-region start current-end) + (forward-char offset) (insert string - (make-string (- (- end start) (length string)) ? )) - (set-text-properties start end properties) + (make-string (- (- (+ new-end offset) start) (length string)) ? )) + (if (= 0 offset) (set-text-properties start new-end properties)) start)) (defun eww-toggle-checkbox () @@ -949,6 +1226,18 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (setq start (next-single-property-change start 'eww-form)))) (nreverse inputs))) +(defun eww-size-text-inputs () + (let ((start (point-min))) + (while (and start + (< start (point-max))) + (when (or (get-text-property start 'eww-form) + (setq start (next-single-property-change start 'eww-form))) + (let ((props (get-text-property start 'eww-form))) + (plist-put props :start start) + (setq start (next-single-property-change + start 'eww-form nil (point-max))) + (plist-put props :end start)))))) + (defun eww-input-value (input) (let ((type (plist-get input :type)) (value (plist-get input :value))) @@ -972,8 +1261,8 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (form (plist-get this-input :eww-form)) values next-submit) (dolist (elem (sort (eww-inputs form) - (lambda (o1 o2) - (< (car o1) (car o2))))) + (lambda (o1 o2) + (< (car o1) (car o2))))) (let* ((input (cdr elem)) (input-start (car elem)) (name (plist-get input :name))) @@ -983,6 +1272,16 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (when (plist-get input :checked) (push (cons name (plist-get input :value)) values))) + ((equal (plist-get input :type) "file") + (push (cons "file" + (list (cons "filedata" + (with-temp-buffer + (insert-file-contents + (plist-get input :filename)) + (buffer-string))) + (cons "name" (plist-get input :name)) + (cons "filename" (plist-get input :filename)))) + values)) ((equal (plist-get input :type) "submit") ;; We want the values from buttons if we hit a button if ;; we hit enter on it, or if it's the first button after @@ -1001,22 +1300,42 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (when (and (consp elem) (eq (car elem) 'hidden)) (push (cons (plist-get (cdr elem) :name) - (plist-get (cdr elem) :value)) + (or (plist-get (cdr elem) :value) "")) values))) (if (and (stringp (cdr (assq :method form))) (equal (downcase (cdr (assq :method form))) "post")) - (let ((url-request-method "POST") - (url-request-extra-headers - '(("Content-Type" . "application/x-www-form-urlencoded"))) - (url-request-data (mm-url-encode-www-form-urlencoded values))) - (eww-browse-url (shr-expand-url (cdr (assq :action form)) - eww-current-url))) + (let ((mtype)) + (dolist (x values mtype) + (if (equal (car x) "file") + (progn + (setq mtype "multipart/form-data")))) + (cond ((equal mtype "multipart/form-data") + (let ((boundary (mml-compute-boundary '()))) + (let ((url-request-method "POST") + (url-request-extra-headers + (list (cons "Content-Type" + (concat "multipart/form-data; boundary=" + boundary)))) + (url-request-data + (mm-url-encode-multipart-form-data values boundary))) + (eww-browse-url (shr-expand-url + (cdr (assq :action form)) + (plist-get eww-data :url)))))) + (t + (let ((url-request-method "POST") + (url-request-extra-headers + '(("Content-Type" . + "application/x-www-form-urlencoded"))) + (url-request-data + (mm-url-encode-www-form-urlencoded values))) + (eww-browse-url (shr-expand-url + (cdr (assq :action form)) + (plist-get eww-data :url))))))) (eww-browse-url (concat (if (cdr (assq :action form)) - (shr-expand-url (cdr (assq :action form)) - eww-current-url) - eww-current-url) + (shr-expand-url (cdr (assq :action form)) (plist-get eww-data :url)) + (plist-get eww-data :url)) "?" (mm-url-encode-www-form-urlencoded values)))))) @@ -1024,11 +1343,12 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") "Browse the current URL with an external browser. The browser to used is specified by the `shr-external-browser' variable." (interactive) - (funcall shr-external-browser (or url eww-current-url))) + (funcall shr-external-browser (or url (plist-get eww-data :url)))) (defun eww-follow-link (&optional external mouse-event) "Browse the URL under point. -If EXTERNAL, browse the URL using `shr-external-browser'." +If EXTERNAL is single prefix, browse the URL using `shr-external-browser'. +If EXTERNAL is double prefix, browse in new buffer." (interactive (list current-prefix-arg last-nonmenu-event)) (mouse-set-point mouse-event) (let ((url (get-text-property (point) 'shr-url))) @@ -1037,15 +1357,16 @@ If EXTERNAL, browse the URL using `shr-external-browser'." (message "No link under point")) ((string-match "^mailto:" url) (browse-url-mail url)) - (external + ((and (consp external) (<= (car external) 4)) (funcall shr-external-browser url)) ;; This is a #target url in the same page as the current one. ((and (url-target (url-generic-parse-url url)) - (eww-same-page-p url eww-current-url)) - (eww-save-history) - (eww-display-html 'utf8 url eww-current-dom)) + (eww-same-page-p url (plist-get eww-data :url))) + (let ((dom (plist-get eww-data :dom))) + (eww-save-history) + (eww-display-html 'utf-8 url dom nil (current-buffer)))) (t - (eww-browse-url url))))) + (eww-browse-url url external))))) (defun eww-same-page-p (url1 url2) "Return non-nil if both URLs represent the same page. @@ -1057,9 +1378,10 @@ Differences in #targets are ignored." (equal (url-recreate-url obj1) (url-recreate-url obj2)))) (defun eww-copy-page-url () + "Copy the URL of the current page into the kill ring." (interactive) - (message "%s" eww-current-url) - (kill-new eww-current-url)) + (message "%s" (plist-get eww-data :url)) + (kill-new (plist-get eww-data :url))) (defun eww-download () "Download URL under point to `eww-download-directory'." @@ -1075,7 +1397,9 @@ Differences in #targets are ignored." (path (car (url-path-and-query obj))) (file (eww-make-unique-file-name (file-name-nondirectory path) eww-download-directory))) - (write-file file) + (goto-char (point-min)) + (re-search-forward "\r?\n\r?\n") + (write-region (point) (point-max) file) (message "Saved %s" file)))) (defun eww-make-unique-file-name (file directory) @@ -1094,42 +1418,50 @@ Differences in #targets are ignored." (setq count (1+ count))) (expand-file-name file directory))) +(defun eww-set-character-encoding (charset) + "Set character encoding." + (interactive "zUse character set (default utf-8): ") + (if (null charset) + (eww-reload nil 'utf-8) + (eww-reload nil charset))) + ;;; Bookmarks code (defvar eww-bookmarks nil) (defun eww-add-bookmark () - "Add the current page to the bookmarks." + "Bookmark the current page." (interactive) (eww-read-bookmarks) (dolist (bookmark eww-bookmarks) - (when (equal eww-current-url - (plist-get bookmark :url)) + (when (equal (plist-get eww-data :url) (plist-get bookmark :url)) (user-error "Already bookmarked"))) - (if (y-or-n-p "bookmark this page? ") - (progn - (let ((title (replace-regexp-in-string "[\n\t\r]" " " eww-current-title))) - (setq title (replace-regexp-in-string "\\` +\\| +\\'" "" title)) - (push (list :url eww-current-url - :title title - :time (current-time-string)) - eww-bookmarks)) - (eww-write-bookmarks) - (message "Bookmarked %s (%s)" eww-current-url eww-current-title)))) + (when (y-or-n-p "Bookmark this page?") + (let ((title (replace-regexp-in-string "[\n\t\r]" " " + (plist-get eww-data :title)))) + (setq title (replace-regexp-in-string "\\` +\\| +\\'" "" title)) + (push (list :url (plist-get eww-data :url) + :title title + :time (current-time-string)) + eww-bookmarks)) + (eww-write-bookmarks) + (message "Bookmarked %s (%s)" (plist-get eww-data :url) + (plist-get eww-data :title)))) (defun eww-write-bookmarks () - (with-temp-file (expand-file-name "eww-bookmarks" user-emacs-directory) + (with-temp-file (expand-file-name "eww-bookmarks" eww-bookmarks-directory) (insert ";; Auto-generated file; don't edit\n") (pp eww-bookmarks (current-buffer)))) (defun eww-read-bookmarks () - (let ((file (expand-file-name "eww-bookmarks" user-emacs-directory))) + (let ((file (expand-file-name "eww-bookmarks" eww-bookmarks-directory))) (setq eww-bookmarks (unless (zerop (or (nth 7 (file-attributes file)) 0)) (with-temp-buffer (insert-file-contents file) (read (current-buffer))))))) +;;;###autoload (defun eww-list-bookmarks () "Display the bookmarks." (interactive) @@ -1142,19 +1474,18 @@ Differences in #targets are ignored." (user-error "No bookmarks are defined")) (set-buffer (get-buffer-create "*eww bookmarks*")) (eww-bookmark-mode) - (let ((format "%-40s %s") - (inhibit-read-only t) - start url) + (let* ((width (/ (window-width) 2)) + (format (format "%%-%ds %%s" width)) + (inhibit-read-only t) + start title) (erase-buffer) - (setq header-line-format (concat " " (format format "URL" "Title"))) + (setq header-line-format (concat " " (format format "Title" "URL"))) (dolist (bookmark eww-bookmarks) - (setq start (point)) - (setq url (plist-get bookmark :url)) - (when (> (length url) 40) - (setq url (substring url 0 40))) - (insert (format format url - (plist-get bookmark :title)) - "\n") + (setq start (point) + title (plist-get bookmark :title)) + (when (> (length title) width) + (setq title (substring title 0 width))) + (insert (format format title (plist-get bookmark :url)) "\n") (put-text-property start (1+ start) 'eww-bookmark bookmark)) (goto-char (point-min)))) @@ -1272,22 +1603,28 @@ Differences in #targets are ignored." ;;; History code (defun eww-save-history () - (push (list :url eww-current-url - :title eww-current-title - :point (point) - :dom eww-current-dom - :source eww-current-source - :text (buffer-string)) - eww-history)) + (plist-put eww-data :point (point)) + (plist-put eww-data :text (buffer-string)) + (push eww-data eww-history) + (setq eww-data (list :title "")) + ;; Don't let the history grow infinitely. We store quite a lot of + ;; data per page. + (when-let (tail (and eww-history-limit + (nthcdr eww-history-limit eww-history))) + (setcdr tail nil))) + +(defvar eww-current-buffer) (defun eww-list-histories () "List the eww-histories." (interactive) (when (null eww-history) (error "No eww-histories are defined")) - (let ((eww-history-trans eww-history)) + (let ((eww-history-trans eww-history) + (buffer (current-buffer))) (set-buffer (get-buffer-create "*eww history*")) (eww-history-mode) + (setq-local eww-current-buffer buffer) (let ((inhibit-read-only t) (domain-length 0) (title-length 0) @@ -1316,7 +1653,10 @@ Differences in #targets are ignored." (let ((history (get-text-property (line-beginning-position) 'eww-history))) (unless history (error "No history on the current line")) - (quit-window) + (let ((buffer eww-current-buffer)) + (quit-window) + (when buffer + (switch-to-buffer buffer))) (eww-restore-history history))) (defvar eww-history-mode-map @@ -1343,6 +1683,223 @@ Differences in #targets are ignored." (setq buffer-read-only t truncate-lines t)) +;;; eww buffers list + +(defun eww-list-buffers () + "Enlist eww buffers." + (interactive) + (let (buffers-info + (current (current-buffer))) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (derived-mode-p 'eww-mode) + (push (vector buffer (plist-get eww-data :title) + (plist-get eww-data :url)) + buffers-info)))) + (unless buffers-info + (error "No eww buffers")) + (setq buffers-info (nreverse buffers-info)) ;more recent on top + (set-buffer (get-buffer-create "*eww buffers*")) + (eww-buffers-mode) + (let ((inhibit-read-only t) + (domain-length 0) + (title-length 0) + url title format start) + (erase-buffer) + (dolist (buffer-info buffers-info) + (setq title-length (max title-length + (length (elt buffer-info 1))) + domain-length (max domain-length + (length (elt buffer-info 2))))) + (setq format (format "%%-%ds %%-%ds" title-length domain-length) + header-line-format + (concat " " (format format "Title" "URL"))) + (let ((line 0) + (current-buffer-line 1)) + (dolist (buffer-info buffers-info) + (setq start (point) + title (elt buffer-info 1) + url (elt buffer-info 2) + line (1+ line)) + (insert (format format title url)) + (insert "\n") + (let ((buffer (elt buffer-info 0))) + (put-text-property start (1+ start) 'eww-buffer + buffer) + (when (eq current buffer) + (setq current-buffer-line line)))) + (goto-char (point-min)) + (forward-line (1- current-buffer-line))))) + (pop-to-buffer "*eww buffers*")) + +(defun eww-buffer-select () + "Switch to eww buffer." + (interactive) + (let ((buffer (get-text-property (line-beginning-position) + 'eww-buffer))) + (unless buffer + (error "No buffer on current line")) + (quit-window) + (switch-to-buffer buffer))) + +(defun eww-buffer-show () + "Display buffer under point in eww buffer list." + (let ((buffer (get-text-property (line-beginning-position) + 'eww-buffer))) + (unless buffer + (error "No buffer on current line")) + (other-window -1) + (switch-to-buffer buffer) + (other-window 1))) + +(defun eww-buffer-show-next () + "Move to next eww buffer in the list and display it." + (interactive) + (forward-line) + (when (eobp) + (goto-char (point-min))) + (eww-buffer-show)) + +(defun eww-buffer-show-previous () + "Move to previous eww buffer in the list and display it." + (interactive) + (beginning-of-line) + (when (bobp) + (goto-char (point-max))) + (forward-line -1) + (eww-buffer-show)) + +(defun eww-buffer-kill () + "Kill buffer from eww list." + (interactive) + (let* ((start (line-beginning-position)) + (buffer (get-text-property start 'eww-buffer)) + (inhibit-read-only t)) + (unless buffer + (user-error "No buffer on the current line")) + (kill-buffer buffer) + (forward-line 1) + (delete-region start (point))) + (when (eobp) + (forward-line -1)) + (eww-buffer-show)) + +(defvar eww-buffers-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "q" 'quit-window) + (define-key map [(control k)] 'eww-buffer-kill) + (define-key map "\r" 'eww-buffer-select) + (define-key map "n" 'eww-buffer-show-next) + (define-key map "p" 'eww-buffer-show-previous) + + (easy-menu-define nil map + "Menu for `eww-buffers-mode-map'." + '("Eww Buffers" + ["Exit" quit-window t] + ["Select" eww-buffer-select + :active (get-text-property (line-beginning-position) 'eww-buffer)] + ["Kill" eww-buffer-kill + :active (get-text-property (line-beginning-position) 'eww-buffer)])) + map)) + +(define-derived-mode eww-buffers-mode nil "eww buffers" + "Mode for listing buffers. + +\\{eww-buffers-mode-map}" + (buffer-disable-undo) + (setq buffer-read-only t + truncate-lines t)) + +;;; Desktop support + +(defvar eww-desktop-data-save + '(:url :title :point) + "List of `eww-data' properties to preserve in the desktop file. +Also used when saving `eww-history'.") + +(defun eww-desktop-data-1 (alist) + (let ((acc nil) + (tail alist)) + (while tail + (let ((k (car tail)) + (v (cadr tail))) + (when (memq k eww-desktop-data-save) + (setq acc (cons k (cons v acc))))) + (setq tail (cddr tail))) + acc)) + +(defun eww-desktop-history-duplicate (a b) + (let ((tail a) (r t)) + (while tail + (if (or (memq (car tail) '(:point)) ; ignore :point + (equal (cadr tail) + (plist-get b (car tail)))) + (setq tail (cddr tail)) + (setq tail nil + r nil))) + ;; . + r)) + +(defun eww-desktop-misc-data (_directory) + "Return a property list with data used to restore eww buffers. +This list will contain, as :history, the list, whose first element is +the value of `eww-data', and the tail is `eww-history'. + +If `eww-desktop-remove-duplicates' is non-nil, duplicate +entries (if any) will be removed from the list. + +Only the properties listed in `eww-desktop-data-save' are included. +Generally, the list should not include the (usually overly large) +:dom, :source and :text properties." + (let ((history (mapcar 'eww-desktop-data-1 + (cons eww-data eww-history)))) + (list :history (if eww-desktop-remove-duplicates + (cl-remove-duplicates + history :test 'eww-desktop-history-duplicate) + history)))) + +(defun eww-restore-desktop (file-name buffer-name misc-data) + "Restore an eww buffer from its desktop file record. +If `eww-restore-desktop' is t or 'auto, this function will also +initiate the retrieval of the respective URI in the background. +Otherwise, the restored buffer will contain a prompt to do so by using +\\[eww-reload]." + (with-current-buffer (get-buffer-create buffer-name) + (eww-mode) + ;; NB: eww-history, eww-data are buffer-local per (eww-mode) + (setq eww-history (cdr (plist-get misc-data :history)) + eww-data (or (car (plist-get misc-data :history)) + ;; backwards compatibility + (list :url (plist-get misc-data :uri)))) + (unless file-name + (when (plist-get eww-data :url) + (case eww-restore-desktop + ((t auto) (eww (plist-get eww-data :url))) + ((zerop (buffer-size)) + (insert (substitute-command-keys + eww-restore-reload-prompt)))))) + ;; . + (current-buffer))) + +(add-to-list 'desktop-locals-to-save + 'eww-history-position) +(add-to-list 'desktop-buffer-mode-handlers + '(eww-mode . eww-restore-desktop)) + +;;; Isearch support + +(defun eww-isearch-next-buffer (&optional _buffer wrap) + "Go to the next page to search using `rel' attribute for navigation." + (if wrap + (condition-case nil + (eww-top-url) + (error nil)) + (if isearch-forward + (eww-next-url) + (eww-previous-url))) + (current-buffer)) + (provide 'eww) ;;; eww.el ends here diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 0593c1f29e3..235b2a2a111 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -41,7 +41,7 @@ "Emacs interface to the GnuTLS library." :version "24.1" :prefix "gnutls-" - :group 'net-utils) + :group 'comm) (defcustom gnutls-algorithm-priority nil "If non-nil, this should be a TLS priority string. @@ -189,6 +189,9 @@ here's a recent version of the list. It must be omitted, a number, or nil; if omitted or nil it defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT." (let* ((type (or type 'gnutls-x509pki)) + ;; The gnutls library doesn't understand files delivered via + ;; the special handlers, so ignore all files found via those. + (file-name-handler-alist nil) (trustfiles (or trustfiles (delq nil (mapcar (lambda (f) (and f (file-exists-p f) f)) @@ -211,11 +214,13 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT." t) ;; if a list, look for hostname matches ((listp gnutls-verify-error) - (cl-mapcan - (lambda (check) - (when (string-match (car check) hostname) - (cdr check))) - gnutls-verify-error)) + (apply 'append + (mapcar + (lambda (check) + (when (string-match (nth 0 check) + hostname) + (nth 1 check))) + gnutls-verify-error))) ;; else it's nil (t nil)))) (min-prime-bits (or min-prime-bits gnutls-min-prime-bits)) diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index eb1b7589b48..a77fc3c6514 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -34,6 +34,7 @@ ;;; Code: (require 'custom) +(require 'password-cache) (autoload 'auth-source-search "auth-source") @@ -47,15 +48,13 @@ A TCP port number can be appended to that name using a colon as a separator." :type '(choice (string :tag "Host name") - (const :tag "Use library default" nil)) - :group 'ldap) + (const :tag "Use library default" nil))) (defcustom ldap-default-port nil "Default TCP port for LDAP connections. Initialized from the LDAP library at build time. Default value is 389." :type '(choice (const :tag "Use library default" nil) - (integer :tag "Port number")) - :group 'ldap) + (integer :tag "Port number"))) (defcustom ldap-default-base nil "Default base for LDAP searches. @@ -63,8 +62,7 @@ This is a string using the syntax of RFC 1779. For instance, \"o=ACME, c=US\" limits the search to the Acme organization in the United States." :type '(choice (const :tag "Use library default" nil) - (string :tag "Search base")) - :group 'ldap) + (string :tag "Search base"))) (defcustom ldap-host-parameters-alist nil @@ -144,35 +142,35 @@ Valid properties include: :tag "Size Limit" :inline t (const :tag "Size Limit" sizelimit) - (integer :tag "(number of records)"))))) - :group 'ldap) + (integer :tag "(number of records)")))))) (defcustom ldap-ldapsearch-prog "ldapsearch" "The name of the ldapsearch command line program." - :type '(string :tag "`ldapsearch' Program") - :group 'ldap) + :type '(string :tag "`ldapsearch' Program")) (defcustom ldap-ldapsearch-args '("-LL" "-tt") "A list of additional arguments to pass to `ldapsearch'." :type '(repeat :tag "`ldapsearch' Arguments" - (string :tag "Argument")) - :group 'ldap) + (string :tag "Argument"))) + +(defcustom ldap-ldapsearch-password-prompt-regexp "Enter LDAP Password: " + "A regular expression used to recognize the `ldapsearch' +program's password prompt." + :type 'regexp + :version "25.1") (defcustom ldap-ignore-attribute-codings nil "If non-nil, do not encode/decode LDAP attribute values." - :type 'boolean - :group 'ldap) + :type 'boolean) (defcustom ldap-default-attribute-decoder nil "Decoder function to use for attributes whose syntax is unknown." - :type 'symbol - :group 'ldap) + :type 'symbol) (defcustom ldap-coding-system 'utf-8 "Coding system of LDAP string values. LDAP v3 specifies the coding system of strings to be UTF-8." - :type 'symbol - :group 'ldap) + :type 'symbol) (defvar ldap-attribute-syntax-encoders [nil ; 1 ACI Item N @@ -476,6 +474,47 @@ Additional search parameters can be specified through (mapcar 'ldap-decode-attribute record)) result)))) +(defun ldap-password-read (host) + "Read LDAP password for HOST. +If the password is cached, it is read from the cache, otherwise the user +is prompted for the password. If `password-cache' is non-nil the password +is verified and cached. The `password-cache-expiry' variable +controls for how long the password is cached. + +This function can be specified for the `passwd' property in +`ldap-host-parameters-alist' when interactive password prompting +is desired for HOST." + ;; Add ldap: namespace to allow empty string for default host. + (let* ((host-key (concat "ldap:" host)) + (password (password-read + (format "Enter LDAP Password%s: " + (if (equal host "") + "" + (format " for %s" host))) + host-key))) + (when (and password-cache + (not (password-in-cache-p host-key)) + ;; Confirm the password is valid before adding it to + ;; the password cache. ldap-search-internal will throw + ;; an error if the password is invalid. + (not (ldap-search-internal + `(host ,host + ;; Specify an arbitrary filter that should + ;; produce no results, since only + ;; authentication success is of interest. + filter "emacs-test-password=" + attributes nil + attrsonly nil + withdn nil + ;; Preempt passwd ldap-password-read + ;; setting in ldap-host-parameters-alist. + passwd ,password + ,@(cdr + (assoc + host + ldap-host-parameters-alist)))))) + (password-cache-add host-key password)) + password)) (defun ldap-search-internal (search-plist) "Perform a search on a LDAP server. @@ -531,7 +570,11 @@ an alist of attribute/value pairs." (passwd (or (plist-get search-plist 'passwd) (plist-get asfound :secret))) ;; convert the password from a function call if needed - (passwd (if (functionp passwd) (funcall passwd) passwd)) + (passwd (if (functionp passwd) + (if (eq passwd 'ldap-password-read) + (funcall passwd host) + (funcall passwd)) + passwd)) ;; get the binddn from the search-list or from the ;; auth-source user or binddn tokens (binddn (or (plist-get search-plist 'binddn) @@ -550,7 +593,7 @@ an alist of attribute/value pairs." (sizelimit (plist-get search-plist 'sizelimit)) (withdn (plist-get search-plist 'withdn)) (numres 0) - arglist dn name value record result) + arglist dn name value record result proc) (if (or (null filter) (equal "" filter)) (error "No search filter")) @@ -559,7 +602,13 @@ an alist of attribute/value pairs." (erase-buffer) (if (and host (not (equal "" host))) - (setq arglist (nconc arglist (list (format "-h%s" host))))) + (setq arglist (nconc arglist + (list (format + ;; Use -H if host is a new-style LDAP URI. + (if (string-match "^[a-zA-Z]+://" host) + "-H%s" + "-h%s") + host))))) (if (and attrsonly (not (equal "" attrsonly))) (setq arglist (nconc arglist (list "-A")))) @@ -575,9 +624,9 @@ an alist of attribute/value pairs." (if (and auth (equal 'simple auth)) (setq arglist (nconc arglist (list "-x")))) - (if (and passwd - (not (equal "" passwd))) - (setq arglist (nconc arglist (list (format "-w%s" passwd))))) + ;; Allow passwd to be set to "", representing a blank password. + (if passwd + (setq arglist (nconc arglist (list "-W")))) (if (and deref (not (equal "" deref))) (setq arglist (nconc arglist (list (format "-a%s" deref))))) @@ -587,14 +636,43 @@ an alist of attribute/value pairs." (if (and sizelimit (not (equal "" sizelimit))) (setq arglist (nconc arglist (list (format "-z%s" sizelimit))))) - (apply #'call-process ldap-ldapsearch-prog - ;; Ignore stderr, which can corrupt results - nil (list buf nil) nil - (append arglist ldap-ldapsearch-args filter)) + (if passwd + (let* ((process-connection-type nil) + (proc-args (append arglist ldap-ldapsearch-args + filter)) + (proc (apply #'start-process "ldapsearch" buf + ldap-ldapsearch-prog + proc-args))) + (while (null (progn + (goto-char (point-min)) + (re-search-forward + ldap-ldapsearch-password-prompt-regexp + (point-max) t))) + (accept-process-output proc 1)) + (process-send-string proc passwd) + (process-send-string proc "\n") + (while (not (memq (process-status proc) '(exit signal))) + (sit-for 0.1)) + (let ((status (process-exit-status proc))) + (when (not (eq status 0)) + ;; Handle invalid credentials exit status specially + ;; for ldap-password-read. + (if (eq status 49) + (error (concat "Incorrect LDAP password or" + " bind distinguished name (binddn)")) + (error "Failed ldapsearch invocation: %s \"%s\"" + ldap-ldapsearch-prog + (mapconcat 'identity proc-args "\" \"")))))) + (apply #'call-process ldap-ldapsearch-prog + ;; Ignore stderr, which can corrupt results + nil (list buf nil) nil + (append arglist ldap-ldapsearch-args filter))) (insert "\n") (goto-char (point-min)) - (while (re-search-forward "[\t\n\f]+ " nil t) + (while (re-search-forward (concat "[\t\n\f]+ \\|" + ldap-ldapsearch-password-prompt-regexp) + nil t) (replace-match "" nil nil)) (goto-char (point-min)) diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index ea03bc65499..e7b3150b792 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -45,6 +45,7 @@ (require 'tls) (require 'starttls) (require 'auth-source) +(require 'nsm) (autoload 'gnutls-negotiate "gnutls") (autoload 'open-gnutls-stream "gnutls") @@ -128,11 +129,14 @@ values: :use-starttls-if-possible is a boolean that says to do opportunistic STARTTLS upgrades even if Emacs doesn't have built-in TLS functionality. +:warn-unless-encrypted is a boolean which, if :return-list is +non-nil, is used warn the user if the connection isn't encrypted. + :nogreeting is a boolean that can be used to inhibit waiting for a greeting from the server. :nowait is a boolean that says the connection should be made - asynchronously, if possible." +asynchronously, if possible." (unless (featurep 'make-network-process) (error "Emacs was compiled without networking support")) (let ((type (plist-get parameters :type)) @@ -196,6 +200,8 @@ a greeting from the server. (stream (make-network-process :name name :buffer buffer :host host :service service :nowait (plist-get parameters :nowait)))) + (when (plist-get parameters :warn-unless-encrypted) + (setq stream (nsm-verify-connection stream host service nil t))) (list stream (network-stream-get-response stream start (plist-get parameters :end-of-command)) @@ -219,8 +225,6 @@ a greeting from the server. (capabilities (network-stream-command stream capability-command eo-capa)) (resulting-type 'plain) - (builtin-starttls (and (fboundp 'gnutls-available-p) - (gnutls-available-p))) starttls-available starttls-command error) ;; First check whether the server supports STARTTLS at all. @@ -231,14 +235,14 @@ a greeting from the server. ;; connection. (when (and starttls-command (setq starttls-available - (or builtin-starttls + (or (gnutls-available-p) (and (or require-tls (plist-get parameters :use-starttls-if-possible)) (starttls-available-p)))) (not (eq (plist-get parameters :type) 'plain))) ;; If using external STARTTLS, drop this connection and start ;; anew with `starttls-open-stream'. - (unless builtin-starttls + (unless (gnutls-available-p) (delete-process stream) (setq start (with-current-buffer buffer (point-max))) (let* ((starttls-extra-arguments @@ -271,7 +275,7 @@ a greeting from the server. (network-stream-command stream starttls-command eoc))) (and response (string-match success-string response))) ;; The server said it was OK to begin STARTTLS negotiations. - (if builtin-starttls + (if (gnutls-available-p) (let ((cert (network-stream-certificate host service parameters))) (condition-case nil (gnutls-negotiate :process stream :hostname host @@ -319,6 +323,12 @@ a greeting from the server. "' program was found")))) (delete-process stream) (setq stream nil)) + ;; Check certificate validity etc. + (when (gnutls-available-p) + (setq stream (nsm-verify-connection + stream host service + (eq resulting-type 'tls) + (plist-get parameters :warn-unless-encrypted)))) ;; Return value: (list stream greeting capabilities resulting-type error))) @@ -344,19 +354,20 @@ a greeting from the server. (defun network-stream-open-tls (name buffer host service parameters) (with-current-buffer buffer (let* ((start (point-max)) - (use-builtin-gnutls (and (fboundp 'gnutls-available-p) - (gnutls-available-p))) (stream - (funcall (if use-builtin-gnutls + (funcall (if (gnutls-available-p) 'open-gnutls-stream 'open-tls-stream) name buffer host service)) (eoc (plist-get parameters :end-of-command))) + ;; Check certificate validity etc. + (when (and (gnutls-available-p) stream) + (setq stream (nsm-verify-connection stream host service))) (if (null stream) (list nil nil nil 'plain) ;; If we're using tls.el, we have to delete the output from ;; openssl/gnutls-cli. - (when (and (null use-builtin-gnutls) + (when (and (not (gnutls-available-p)) eoc) (network-stream-get-response stream start eoc) (goto-char (point-min)) diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index 6dddf078fcd..5db04eb6745 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -6,7 +6,6 @@ ;; Filename: newst-backend.el ;; URL: http://www.nongnu.org/newsticker ;; Keywords: News, RSS, Atom -;; Time-stamp: "13. Mai 2011, 20:47:05 (ulf)" ;; Package: newsticker ;; ====================================================================== @@ -37,6 +36,7 @@ (require 'derived) (require 'xml) +(require 'url-parse) ;; Silence warnings (defvar w3-mode-map) @@ -47,9 +47,6 @@ "List of timers for news retrieval. This is an alist, each element consisting of (feed-name . timer).") -(defvar newsticker--download-logos nil - "If non-nil download feed logos if available.") - (defvar newsticker--sentinel-callback nil "Function called at end of `newsticker--sentinel'.") @@ -483,14 +480,6 @@ that can be added." ;; ====================================================================== ;;; Internal variables ;; ====================================================================== -(defvar newsticker--item-list nil - "List of newsticker items.") -(defvar newsticker--item-position 0 - "Actual position in list of newsticker items.") -(defvar newsticker--prev-message "There was no previous message yet!" - "Last message that the newsticker displayed.") -(defvar newsticker--scrollable-text "" - "The text which is scrolled smoothly in the echo area.") (defvar newsticker--buffer-uptodate-p nil "Tells whether the newsticker buffer is up to date.") (defvar newsticker--latest-update-time (current-time) @@ -756,10 +745,14 @@ from." (insert result) ;; remove MIME header (goto-char (point-min)) - (search-forward "\n\n") + (search-forward "\n\n" nil t) (delete-region (point-min) (point)) ;; read the rss/atom contents - (newsticker--sentinel-work nil t feed-name "url-retrieve" (current-buffer)) + (newsticker--sentinel-work nil + (or (not status) + (not (eq (car status) :error))) + feed-name "url-retrieve" + (current-buffer)) (when status (let ((status-type (car status)) (status-details (cdr status))) @@ -768,7 +761,7 @@ from." ) ((eq status-type :error) (message "%s: Error while retrieving news from %s: %s: \"%s\"" - (format-time-string "%A, %H:%M" (current-time)) + (format-time-string "%A, %H:%M") feed-name (car status-details) (cdr status-details)))))))) @@ -788,6 +781,7 @@ See `newsticker-get-news'." newsticker-wget-name args))) (set-process-coding-system proc 'no-conversion 'no-conversion) (set-process-sentinel proc 'newsticker--sentinel) + (process-put proc 'nt-feed-name feed-name) (setq newsticker--process-ids (cons (process-id proc) newsticker--process-ids)) (force-mode-line-update))))) @@ -797,7 +791,7 @@ See `newsticker-get-news'." FEED-NAME must be a string which occurs as the label (i.e. the first element) in an element of `newsticker-url-list' or `newsticker-url-list-defaults'." (newsticker--debug-msg "%s: Getting news for %s" - (format-time-string "%A, %H:%M" (current-time)) + (format-time-string "%A, %H:%M") feed-name) (let* ((item (or (assoc feed-name newsticker-url-list) (assoc feed-name newsticker-url-list-defaults) @@ -823,25 +817,26 @@ Argument PROCESS is the process which has just changed its state. Argument EVENT tells what has happened to the process." (let ((p-status (process-status process)) (exit-status (process-exit-status process)) - (name (process-name process)) + (feed-name (process-get process 'nt-feed-name)) (command (process-command process)) (buffer (process-buffer process))) (newsticker--sentinel-work event (and (eq p-status 'exit) (= exit-status 0)) - name command buffer))) + feed-name command buffer))) -(defun newsticker--sentinel-work (event status-ok name command buffer) +(defun newsticker--sentinel-work (event status-ok feed-name command buffer) "Actually do the sentinel work. Argument EVENT tells what has happened to the retrieval process. Argument STATUS-OK is the final status of the retrieval process, non-nil meaning retrieval was successful. -Argument NAME is the name of the retrieval process. +Argument FEED-NAME is the name of the retrieved feed. Argument COMMAND is the command of the retrieval process. Argument BUFFER is the buffer of the retrieval process." (let ((time (current-time)) - (name-symbol (intern name)) - (something-was-added nil)) + (name-symbol (intern feed-name)) + (something-was-added nil) + (ct (current-time))) ;; catch known errors (zombie processes, rubbish-xml etc. ;; if an error occurs the news feed is not updated! (catch 'oops @@ -855,73 +850,26 @@ Argument BUFFER is the buffer of the retrieval process." (concat "%s: Newsticker could not retrieve news from %s.\n" "Return status: `%s'\n" "Command was `%s'") - (format-time-string "%A, %H:%M" (current-time)) - name event command) + (format-time-string "%A, %H:%M") + feed-name event command) "" - (current-time) + ct 'new - 0 nil)) + 0 '((guid nil "newsticker--download-error")) + ct)) (message "%s: Error while retrieving news from %s" - (format-time-string "%A, %H:%M" (current-time)) - name) + (format-time-string "%A, %H:%M") + feed-name) (throw 'oops nil)) (let* ((coding-system 'utf-8) (node-list (save-current-buffer (set-buffer buffer) - ;; a very very dirty workaround to overcome the - ;; problems with the newest (20030621) xml.el: - ;; remove all unnecessary whitespace - (goto-char (point-min)) - (while (re-search-forward ">[ \t\r\n]+<" nil t) - (replace-match "><" nil t)) - ;; and another brutal workaround (20031105)! For some - ;; reason the xml parser does not like the colon in the - ;; doctype name "rdf:RDF" - (goto-char (point-min)) - (if (re-search-forward "<!DOCTYPE[ \t\n]+rdf:RDF" nil t) - (replace-match "<!DOCTYPE rdfColonRDF" nil t)) - ;; finally.... ~##^°!!!!! - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match "\n" nil t)) - ;; still more brutal workarounds (20040309)! The xml - ;; parser does not like doctype rss - (goto-char (point-min)) - (if (re-search-forward "<!DOCTYPE[ \t\n]+rss[ \t\n]*>" nil t) - (replace-match "" nil t)) - ;; And another one (20050618)! (Fixed in GNU Emacs 22.0.50.18) - ;; Remove comments to avoid this xml-parsing bug: - ;; "XML files can have only one toplevel tag" - (goto-char (point-min)) - (while (search-forward "<!--" nil t) - (let ((start (match-beginning 0))) - (unless (search-forward "-->" nil t) - (error "Can't find end of comment")) - (delete-region start (point)))) - ;; And another one (20050702)! If description is HTML - ;; encoded and starts with a `<', wrap the whole - ;; description in a CDATA expression. This happened for - ;; http://www.thefreedictionary.com/_/WoD/rss.aspx?type=quote - (goto-char (point-min)) - (while (re-search-forward - "<description>\\(<img.*?\\)</description>" nil t) - (replace-match - "<description><![CDATA[ \\1 ]]></description>")) - ;; And another one (20051123)! XML parser does not - ;; like this: <yweather:location city="Frankfurt/Main" - ;; region="" country="GM" /> - ;; try to "fix" empty attributes - ;; This happened for - ;; http://xml.weather.yahoo.com/forecastrss?p=GMXX0040&u=f - (goto-char (point-min)) - (while (re-search-forward "\\(<[^>]*\\)=\"\"" nil t) - (replace-match "\\1=\" \"")) - ;; - (set-buffer-modified-p nil) + (unless (fboundp 'libxml-parse-xml-region) + (newsticker--do-xml-workarounds)) ;; check coding system (goto-char (point-min)) - (if (re-search-forward "encoding=\"\\([^\"]+\\)\"" + (if (re-search-forward "encoding=['\"]\\([^\"]+?\\)['\"]" nil t) (setq coding-system (intern (downcase (match-string 1)))) (setq coding-system @@ -930,22 +878,25 @@ Argument BUFFER is the buffer of the retrieval process." (coding-system-error (message "newsticker.el: ignoring coding system %s for %s" - coding-system name) + coding-system feed-name) nil)))) ;; Decode if possible (when coding-system (decode-coding-region (point-min) (point-max) coding-system)) (condition-case errordata - ;; The xml parser might fail - ;; or the xml might be bugged - (xml-parse-region (point-min) (point-max)) + ;; The xml parser might fail or the xml might be + ;; bugged + (if (fboundp 'libxml-parse-xml-region) + (list (libxml-parse-xml-region (point-min) (point-max) + nil t)) + (xml-parse-region (point-min) (point-max))) (error (message "Could not parse %s: %s" (buffer-name) (cadr errordata)) (throw 'oops nil))))) (topnode (car node-list)) - (channelnode (car (xml-get-children topnode 'channel))) - (imageurl nil)) + (image-url nil) + (icon-url nil)) ;; mark all items as obsolete (newsticker--cache-replace-age newsticker--cache name-symbol @@ -963,41 +914,51 @@ Argument BUFFER is the buffer of the retrieval process." ;; RSS 0.91 ((and (eq 'rss (xml-node-name topnode)) (string= "0.91" (xml-get-attribute topnode 'version))) - (setq imageurl (newsticker--get-logo-url-rss-0.91 topnode)) - (newsticker--parse-rss-0.91 name time topnode)) + (setq image-url (newsticker--get-logo-url-rss-0.91 topnode)) + (newsticker--parse-rss-0.91 feed-name time topnode)) ;; RSS 0.92 ((and (eq 'rss (xml-node-name topnode)) (string= "0.92" (xml-get-attribute topnode 'version))) - (setq imageurl (newsticker--get-logo-url-rss-0.92 topnode)) - (newsticker--parse-rss-0.92 name time topnode)) + (setq image-url (newsticker--get-logo-url-rss-0.92 topnode)) + (newsticker--parse-rss-0.92 feed-name time topnode)) ;; RSS 1.0 - ((eq 'rdf:RDF (xml-node-name topnode)) - (setq imageurl (newsticker--get-logo-url-rss-1.0 topnode)) - (newsticker--parse-rss-1.0 name time topnode)) + ((or (eq 'RDF (xml-node-name topnode)) + (eq 'rdf:RDF (xml-node-name topnode))) + (setq image-url (newsticker--get-logo-url-rss-1.0 topnode)) + (newsticker--parse-rss-1.0 feed-name time topnode)) ;; RSS 2.0 ((and (eq 'rss (xml-node-name topnode)) (string= "2.0" (xml-get-attribute topnode 'version))) - (setq imageurl (newsticker--get-logo-url-rss-2.0 topnode)) - (newsticker--parse-rss-2.0 name time topnode)) + (setq image-url (newsticker--get-logo-url-rss-2.0 topnode)) + (newsticker--parse-rss-2.0 feed-name time topnode)) ;; Atom 0.3 ((and (eq 'feed (xml-node-name topnode)) (string= "http://purl.org/atom/ns#" (xml-get-attribute topnode 'xmlns))) - (setq imageurl (newsticker--get-logo-url-atom-0.3 topnode)) - (newsticker--parse-atom-0.3 name time topnode)) + (setq image-url (newsticker--get-logo-url-atom-0.3 topnode)) + (newsticker--parse-atom-0.3 feed-name time topnode)) ;; Atom 1.0 - ((and (eq 'feed (xml-node-name topnode)) - (string= "http://www.w3.org/2005/Atom" - (xml-get-attribute topnode 'xmlns))) - (setq imageurl (newsticker--get-logo-url-atom-1.0 topnode)) - (newsticker--parse-atom-1.0 name time topnode)) - ;; unknown feed type (t - (newsticker--debug-msg "Feed type unknown: %s: %s" - (xml-node-name topnode) name) - nil)) + ;; The test for Atom 1.0 does not work when using + ;; libxml, as with libxml the namespace attribute is + ;; not in the xml tree. For the time being we skip + ;; the check and assume that we are dealing with an + ;; Atom 1.0 feed. + + ;; (and (eq 'feed (xml-node-name topnode)) + ;; (string= "http://www.w3.org/2005/Atom" + ;; (xml-get-attribute topnode 'xmlns))) + (setq image-url (newsticker--get-logo-url-atom-1.0 topnode)) + (setq icon-url (newsticker--get-icon-url-atom-1.0 topnode)) + (newsticker--parse-atom-1.0 feed-name time topnode)) + ;; unknown feed type + ;; (t + ;; (newsticker--debug-msg "Feed type unknown: %s: %s" + ;; (xml-node-name topnode) feed-name) + ;; nil) + ) (setq something-was-added t)) - (error (message "sentinelerror in %s: %s" name error-data))) + (error (message "sentinelerror in %s: %s" feed-name error-data))) ;; Remove those old items from cache which have been removed from ;; the feed @@ -1038,17 +999,97 @@ Argument BUFFER is the buffer of the retrieval process." ;; kill the process buffer if wanted (unless newsticker-debug (kill-buffer buffer)) - ;; launch retrieval of image - (when (and imageurl newsticker--download-logos) - (newsticker--image-get name imageurl))))) + ;; launch retrieval of images + (when (and (boundp 'newsticker-download-logos) + newsticker-download-logos) + ;; feed logo + (when image-url + (newsticker--image-get feed-name feed-name (newsticker--images-dir) + image-url)) + ;; icon / favicon + (setq icon-url + (or icon-url + (let* ((feed-url (newsticker--link (cadr (newsticker--cache-get-feed + (intern feed-name))))) + (uri (url-generic-parse-url feed-url))) + (when (and feed-url uri) + (setf (url-filename uri) nil) + (setf (url-target uri) nil) + (concat (url-recreate-url uri) "favicon.ico"))))) + (when icon-url + (newsticker--image-get feed-name + (concat feed-name "." + (file-name-extension icon-url)) + (newsticker--icons-dir) + icon-url)))))) (when newsticker--sentinel-callback (funcall newsticker--sentinel-callback))) +(defun newsticker--do-xml-workarounds () + "Fix all issues which `xml-parse-region' could be choking on." + + ;; a very very dirty workaround to overcome the + ;; problems with the newest (20030621) xml.el: + ;; remove all unnecessary whitespace + (goto-char (point-min)) + (while (re-search-forward ">[ \t\r\n]+<" nil t) + (replace-match "><" nil t)) + ;; and another brutal workaround (20031105)! For some + ;; reason the xml parser does not like the colon in the + ;; doctype name "rdf:RDF" + (goto-char (point-min)) + (if (re-search-forward "<!DOCTYPE[ \t\n]+rdf:RDF" nil t) + (replace-match "<!DOCTYPE rdfColonRDF" nil t)) + ;; finally.... ~##^°!!!!! + (goto-char (point-min)) + (while (search-forward "\r\n" nil t) + (replace-match "\n" nil t)) + ;; still more brutal workarounds (20040309)! The xml + ;; parser does not like doctype rss + (goto-char (point-min)) + (if (re-search-forward "<!DOCTYPE[ \t\n]+rss[ \t\n]*>" nil t) + (replace-match "" nil t)) + ;; And another one (20050618)! (Fixed in GNU Emacs 22.0.50.18) + ;; Remove comments to avoid this xml-parsing bug: + ;; "XML files can have only one toplevel tag" + (goto-char (point-min)) + (while (search-forward "<!--" nil t) + (let ((start (match-beginning 0))) + (unless (search-forward "-->" nil t) + (error "Can't find end of comment")) + (delete-region start (point)))) + ;; And another one (20050702)! If description is HTML + ;; encoded and starts with a `<', wrap the whole + ;; description in a CDATA expression. This happened for + ;; http://www.thefreedictionary.com/_/WoD/rss.aspx?type=quote + (goto-char (point-min)) + (while (re-search-forward + "<description>\\(<img.*?\\)</description>" nil t) + (replace-match + "<description><![CDATA[ \\1 ]]></description>")) + ;; And another one (20051123)! XML parser does not + ;; like this: <yweather:location city="Frankfurt/Main" + ;; region="" country="GM" /> + ;; try to "fix" empty attributes + ;; This happened for + ;; http://xml.weather.yahoo.com/forecastrss?p=GMXX0040&u=f + (goto-char (point-min)) + (while (re-search-forward "\\(<[^>]*\\)=\"\"" nil t) + (replace-match "\\1=\" \"")) + ;; + (set-buffer-modified-p nil)) + + (defun newsticker--get-logo-url-atom-1.0 (node) "Return logo URL from atom 1.0 data in NODE." (car (xml-node-children (car (xml-get-children node 'logo))))) +(defun newsticker--get-icon-url-atom-1.0 (node) + "Return icon URL from atom 1.0 data in NODE." + (car (xml-node-children + (car (xml-get-children node 'icon))))) + (defun newsticker--get-logo-url-atom-0.3 (node) "Return logo URL from atom 0.3 data in NODE." (car (xml-node-children @@ -1125,6 +1166,30 @@ same as in `newsticker--parse-atom-1.0'." (xml-node-children node)))) (or new-item new-feed))) +(defun newsticker--unxml (node) + "Reverse parsing of an xml string. +Restore an xml-string from a an xml NODE that was returned by xml-parse..." + (if (or (not node) (stringp node)) + node + (newsticker--unxml-node node))) + +(defun newsticker--unxml-node (node) + "Actually restore xml-string of an xml NODE." + (let ((qname (symbol-name (car node))) + (att-list (cadr node)) + (children (cddr node))) + (concat "<" qname + (when att-list " ") + (mapconcat 'newsticker--unxml-attribute att-list " ") + ">" + (mapconcat 'newsticker--unxml children "") "</" qname ">"))) + +(defun newsticker--unxml-attribute (attribute) + "Actually restore xml-string of an ATTRIBUTE of an xml node." + (let ((name (symbol-name (car attribute))) + (value (cdr attribute))) + (concat name "=\"" value "\""))) + (defun newsticker--parse-atom-1.0 (name time topnode) "Parse Atom 1.0 data. Argument NAME gives the name of a news feed. TIME gives the @@ -1157,8 +1222,17 @@ URL `http://www.atompub.org/2005/08/17/draft-ietf-atompub-format-11.html'" (car (xml-get-children node 'title))))) ;; desc-fn (lambda (node) - (or (car (xml-node-children - (car (xml-get-children node 'content)))) + ;; unxml the content or the summary node. Atom + ;; allows for integrating (x)html into the atom + ;; structure but we need the raw html string. + ;; e.g. http://www.heise.de/open/news/news-atom.xml + ;; http://feeds.feedburner.com/ru_nix_blogs + (or (newsticker--unxml + (car (xml-node-children + (car (xml-get-children node 'content))))) + (newsticker--unxml + (car (xml-node-children + (car (xml-get-children node 'summary))))) (car (xml-node-children (car (xml-get-children node 'summary)))))) ;; link-fn @@ -1303,9 +1377,15 @@ For the RSS 1.0 specification see URL `http://web.resource.org/rss/1.0/spec'." (car (xml-node-children (car (xml-get-children channelnode 'title)))) ;; desc - (car (xml-node-children - (car (xml-get-children channelnode - 'description)))) + (or (car (xml-node-children + (car (xml-get-children channelnode + 'encoded)))) + (car (xml-node-children + (car (xml-get-children channelnode + 'content:encoded)))) + (car (xml-node-children + (car (xml-get-children channelnode + 'description))))) ;; link (car (xml-node-children (car (xml-get-children channelnode 'link)))) @@ -1329,8 +1409,10 @@ For the RSS 1.0 specification see URL `http://web.resource.org/rss/1.0/spec'." ;; time-fn (lambda (node) (newsticker--decode-iso8601-date - (car (xml-node-children - (car (xml-get-children node 'dc:date)))))) + (or (car (xml-node-children + (car (xml-get-children node 'dc:date)))) + (car (xml-node-children + (car (xml-get-children node 'date))))))) ;; guid-fn (lambda (node) nil) @@ -1354,9 +1436,15 @@ For the RSS 2.0 specification see URL `http://blogs.law.harvard.edu/tech/rss'." (car (xml-node-children (car (xml-get-children channelnode 'title)))) ;; desc - (car (xml-node-children - (car (xml-get-children channelnode - 'description)))) + (or (car (xml-node-children + (car (xml-get-children channelnode + 'encoded)))) + (car (xml-node-children + (car (xml-get-children channelnode + 'content:encoded)))) + (car (xml-node-children + (car (xml-get-children channelnode + 'description))))) ;; link (car (xml-node-children (car (xml-get-children channelnode 'link)))) @@ -1372,6 +1460,9 @@ For the RSS 2.0 specification see URL `http://blogs.law.harvard.edu/tech/rss'." (lambda (node) (or (car (xml-node-children (car (xml-get-children node + 'encoded)))) + (car (xml-node-children + (car (xml-get-children node 'content:encoded)))) (car (xml-node-children (car (xml-get-children node @@ -1464,7 +1555,7 @@ argument, which is one of the items in ITEMLIST." ;; decode numeric entities (setq title (xml-substitute-numeric-entities title)) (when desc - (setq desc (xml-substitute-numeric-entities desc))) + (setq desc (xml-substitute-numeric-entities desc))) (setq link (xml-substitute-numeric-entities link)) ;; remove whitespace from title, desc, and link (setq title (newsticker--remove-whitespace title)) @@ -1486,9 +1577,9 @@ argument, which is one of the items in ITEMLIST." (let ((prev-age (newsticker--age old-item))) (unless newsticker-automatically-mark-items-as-old ;; Some feeds deliver items multiply, the - ;; first time we find an 'obsolete-old one the - ;; cache, the following times we find an 'old - ;; one + ;; first time we find an 'obsolete-old one in + ;; the cache, the following times we find an + ;; 'old one (if (memq prev-age '(obsolete-old old)) (setq age2 'old) (setq age2 'new))) @@ -1498,11 +1589,16 @@ argument, which is one of the items in ITEMLIST." ;; item was not there (setq item-new-p t) (setq something-was-added t)) - (setq newsticker--cache - (newsticker--cache-add - newsticker--cache (intern name) title desc link - time age1 position (funcall extra-fn node) - time age2)) + (let ((extra-elements-with-guid (funcall extra-fn node))) + (unless (assoc 'guid extra-elements-with-guid) + (setq extra-elements-with-guid + (cons `(guid nil ,(funcall guid-fn node)) + extra-elements-with-guid))) + (setq newsticker--cache + (newsticker--cache-add + newsticker--cache (intern name) title desc link + time age1 position extra-elements-with-guid + time age2))) (when item-new-p (let ((item (newsticker--cache-contains newsticker--cache (intern name) title @@ -1712,31 +1808,44 @@ Checks list of active processes against list of newsticker processes." ;; ====================================================================== (defun newsticker--images-dir () "Return directory where feed images are saved." - (concat newsticker-dir "/images")) + (concat newsticker-dir "/images/")) -(defun newsticker--image-get (feed-name url) - "Get image of the news site FEED-NAME from URL. -If the image has been downloaded in the last 24h do nothing." - (let ((image-name (concat (newsticker--images-dir) feed-name))) +(defun newsticker--icons-dir () + "Return directory where feed icons are saved." + (concat newsticker-dir "/icons/")) + +(defun newsticker--image-get (feed-name filename directory url) + "Get image for FEED-NAME by returning FILENAME from DIRECTORY. +If the file does no exist or if it is older than 24 hours +download it from URL first." + (let ((image-name (concat directory feed-name))) (if (and (file-exists-p image-name) (time-less-p (current-time) (time-add (nth 5 (file-attributes image-name)) (seconds-to-time 86400)))) (newsticker--debug-msg "%s: Getting image for %s skipped" - (format-time-string "%A, %H:%M" (current-time)) + (format-time-string "%A, %H:%M") feed-name) ;; download (newsticker--debug-msg "%s: Getting image for %s" - (format-time-string "%A, %H:%M" (current-time)) + (format-time-string "%A, %H:%M") feed-name) - (let* ((buffername (concat " *newsticker-wget-image-" feed-name "*")) - (item (or (assoc feed-name newsticker-url-list) + (if (eq newsticker-retrieval-method 'intern) + (newsticker--image-download-by-url feed-name filename directory url) + (newsticker--image-download-by-wget feed-name filename directory url))))) + +(defun newsticker--image-download-by-wget (feed-name filename directory url) + "Download image for FEED-NAME using external program. +Save image as FILENAME in DIRECTORY, download it from URL." + (let* ((proc-name (concat feed-name "-" filename)) + (buffername (concat " *newsticker-wget-image-" proc-name "*")) + (item (or (assoc feed-name newsticker-url-list) (assoc feed-name newsticker-url-list-defaults) (error - "Cannot get news for %s: Check newsticker-url-list" + "Cannot get image for %s: Check newsticker-url-list" feed-name))) - (wget-arguments (or (car (cdr (cdr (cdr (cdr item))))) - newsticker-wget-arguments))) + (wget-arguments (or (car (cdr (cdr (cdr (cdr item))))) + newsticker-wget-arguments))) (with-current-buffer (get-buffer-create buffername) (erase-buffer) ;; throw an error if there is an old wget-process around @@ -1745,39 +1854,96 @@ If the image has been downloaded in the last 24h do nothing." feed-name)) ;; start wget (let* ((args (append wget-arguments (list url))) - (proc (apply 'start-process feed-name buffername + (proc (apply 'start-process proc-name buffername newsticker-wget-name args))) (set-process-coding-system proc 'no-conversion 'no-conversion) - (set-process-sentinel proc 'newsticker--image-sentinel))))))) + (set-process-sentinel proc 'newsticker--image-sentinel) + (process-put proc 'nt-directory directory) + (process-put proc 'nt-feed-name feed-name) + (process-put proc 'nt-filename filename))))) (defun newsticker--image-sentinel (process event) "Sentinel for image-retrieving PROCESS caused by EVENT." (let* ((p-status (process-status process)) (exit-status (process-exit-status process)) - (feed-name (process-name process))) + (feed-name (process-get process 'nt-feed-name)) + (directory (process-get process 'nt-directory)) + (filename (process-get process 'nt-filename))) ;; catch known errors (zombie processes, rubbish-xml, etc.) ;; if an error occurs the news feed is not updated! (catch 'oops (unless (and (eq p-status 'exit) (= exit-status 0)) (message "%s: Error while retrieving image from %s" - (format-time-string "%A, %H:%M" (current-time)) + (format-time-string "%A, %H:%M") feed-name) + (newsticker--image-remove directory feed-name) (throw 'oops nil)) - (let (image-name) - (with-current-buffer (process-buffer process) - (setq image-name (concat (newsticker--images-dir) feed-name)) - (set-buffer-file-coding-system 'no-conversion) - ;; make sure the cache dir exists - (unless (file-directory-p (newsticker--images-dir)) - (make-directory (newsticker--images-dir))) - ;; write and close buffer - (let ((require-final-newline nil) - (backup-inhibited t) - (coding-system-for-write 'no-conversion)) - (write-region nil nil image-name nil 'quiet)) - (set-buffer-modified-p nil) - (kill-buffer (current-buffer))))))) + (newsticker--image-save (process-buffer process) directory filename)))) + +(defun newsticker--image-save (buffer directory file-name) + "Save contents of BUFFER in DIRECTORY as FILE-NAME. +Finally kill buffer." + (with-current-buffer buffer + (let ((image-name (concat directory file-name))) + (set-buffer-file-coding-system 'no-conversion) + ;; make sure the cache dir exists + (unless (file-directory-p directory) + (make-directory directory)) + ;; write and close buffer + (let ((require-final-newline nil) + (backup-inhibited t) + (coding-system-for-write 'no-conversion)) + (write-region nil nil image-name nil 'quiet)) + (set-buffer-modified-p nil) + (kill-buffer buffer)))) + +(defun newsticker--image-remove (directory file-name) + "In DIRECTORY remove FILE-NAME." + (let ((image-name (concat directory file-name))) + (when (file-exists-p file-name) + (delete-file image-name)))) + +(defun newsticker--image-download-by-url (feed-name filename directory url) + "Download image for FEED-NAME using `url-retrieve'. +Save image as FILENAME in DIRECTORY, download it from URL." + (let ((coding-system-for-read 'no-conversion)) + (condition-case error-data + (url-retrieve url 'newsticker--image-download-by-url-callback + (list feed-name directory filename)) + (error (message "Error retrieving image from %s: %s" feed-name + error-data)))) + (force-mode-line-update)) + +(defun newsticker--image-download-by-url-callback (status feed-name directory filename) + "Callback function for `newsticker--image-download-by-url'. +STATUS is the return status as delivered by `url-retrieve'. +FEED-NAME is the name of the feed that the news were retrieved +from. +The image is saved in DIRECTORY as FILENAME." + (let ((do-save + (or (not status) + (let ((status-type (car status)) + (status-details (cdr status))) + (cond ((eq status-type :redirect) + ;; don't care about redirects + t) + ((eq status-type :error) + ;; silently ignore errors + nil)))))) + (when do-save + (let ((buf (get-buffer-create (concat " *newsticker-url-image-" feed-name "-" + directory "*"))) + (result (string-to-multibyte (buffer-string)))) + (set-buffer buf) + (erase-buffer) + (insert result) + ;; remove MIME header + (goto-char (point-min)) + (search-forward "\n\n") + (delete-region (point-min) (point)) + ;; save + (newsticker--image-save buf directory filename))))) (defun newsticker--insert-image (img string) "Insert IMG with STRING at point." @@ -2192,6 +2358,7 @@ If AGE is nil, the total number of items is returned." (defun newsticker-opml-export () "OPML subscription export. Export subscriptions to a buffer in OPML Format." + ;; FIXME: use newsticker-groups (interactive) (with-current-buffer (get-buffer-create "*OPML Export*") (set-buffer-file-coding-system 'utf-8) @@ -2211,7 +2378,8 @@ Export subscriptions to a buffer in OPML Format." (insert " <outline text=\"") (insert (newsticker--title sub)) (insert "\" xmlUrl=\"") - (insert (cadr sub)) + (insert (xml-escape-string (let ((url (cadr sub))) + (if (stringp url) url (prin1-to-string url))))) (insert "\"/>\n")) (append newsticker-url-list newsticker-url-list-defaults)) (insert " </body>\n</opml>\n")) diff --git a/lisp/net/newst-plainview.el b/lisp/net/newst-plainview.el index 9b9044b4efe..4ab000750ee 100644 --- a/lisp/net/newst-plainview.el +++ b/lisp/net/newst-plainview.el @@ -5,7 +5,6 @@ ;; Author: Ulf Jasper <ulf.jasper@web.de> ;; Filename: newst-plainview.el ;; URL: http://www.nongnu.org/newsticker -;; Time-stamp: "Mon 11-Feb-2013 20:27:11 gm on skiddaw" ;; Package: newsticker ;; ====================================================================== diff --git a/lisp/net/newst-reader.el b/lisp/net/newst-reader.el index 3e336e12801..be4179e4b11 100644 --- a/lisp/net/newst-reader.el +++ b/lisp/net/newst-reader.el @@ -5,7 +5,6 @@ ;; Author: Ulf Jasper <ulf.jasper@web.de> ;; Filename: newst-reader.el ;; URL: http://www.nongnu.org/newsticker -;; Time-stamp: "24. September 2011, 15:47:49 (ulf)" ;; Package: newsticker ;; ====================================================================== @@ -67,6 +66,12 @@ This must be one of the functions `newsticker-plainview' or :group 'newsticker-reader) ;; image related things +(defcustom newsticker-download-logos + t + "If non-nil newsticker downloads logo images of subscribed feeds." + :type 'boolean + :group 'newsticker-reader) + (defcustom newsticker-enable-logo-manipulations t "If non-nil newsticker manipulates logo images. @@ -105,7 +110,7 @@ window is used when filling. See also `newsticker-justification'." #'shr-render-region) "Function for rendering HTML contents. If non-nil, newsticker.el will call this function whenever it -finds HTML-like tags in item descriptions. +finds HTML-like tags in item descriptions. Possible functions include `shr-render-region', `w3m-region', `w3-region', and `newsticker-htmlr-render'. Newsticker automatically loads the respective package w3m, w3, or @@ -186,15 +191,18 @@ KEYMAP will be applied." 'nt-type 'desc)) (insert "\n"))))) -(defun newsticker--print-extra-elements (item keymap) +(defun newsticker--print-extra-elements (item keymap &optional htmlish) "Insert extra-elements of ITEM in a pretty form into the current buffer. -KEYMAP is applied." +KEYMAP is applied. If HTMLISH is non-nil then HTML-markup is used +for formatting." (let ((ignored-elements '(items link title description content - content:encoded dc:subject - dc:date entry item guid pubDate + content:encoded encoded + dc:subject subject + dc:date date entry item guid pubDate published updated enclosure)) (left-column-width 1)) + (if htmlish (insert "<ul>")) (mapc (lambda (extra-element) (when (listp extra-element) ;; take care of broken xml ;; data, 2007-05-25 @@ -209,15 +217,20 @@ KEYMAP is applied." (unless (memq (car extra-element) ignored-elements) (newsticker--do-print-extra-element extra-element left-column-width - keymap)))) - (newsticker--extra item)))) + keymap + htmlish)))) + (newsticker--extra item)) + (if htmlish (insert "</ul>")))) -(defun newsticker--do-print-extra-element (extra-element width keymap) +(defun newsticker--do-print-extra-element (extra-element width keymap htmlish) "Actually print an EXTRA-ELEMENT using the given WIDTH. -KEYMAP is applied." +KEYMAP is applied. If HTMLISH is non-nil then HTML-markup is used +for formatting." (let ((name (symbol-name (car extra-element)))) - (insert (format "%s: " name)) - (insert (make-string (- width (length name)) ? ))) + (if htmlish + (insert (format "<li>%s: " name)) + (insert (format "%s: " name)) + (insert (make-string (- width (length name)) ? )))) (let (;;(attributes (cadr extra-element)) ;FIXME!!!! (contents (cddr extra-element))) (cond ((listp contents) @@ -238,30 +251,58 @@ KEYMAP is applied." contents)) (t (insert (format "%s" contents)))) - (insert "\n"))) + (if htmlish + (insert "</li>") + (insert "\n")))) -(defun newsticker--image-read (feed-name-symbol disabled) +(defun newsticker--image-read (feed-name-symbol disabled &optional max-height) "Read the cached image for FEED-NAME-SYMBOL from disk. If DISABLED is non-nil the image will be converted to a disabled look \(unless `newsticker-enable-logo-manipulations' is not t\). +Optional argument MAX-HEIGHT specifies the maximal image height. Return the image." (let ((image-name (concat (newsticker--images-dir) - (symbol-name feed-name-symbol))) - (img nil)) + (symbol-name feed-name-symbol)))) (when (file-exists-p image-name) (condition-case error-data - (setq img (create-image - image-name nil nil - :conversion (and newsticker-enable-logo-manipulations - disabled - 'disabled) - :mask (and newsticker-enable-logo-manipulations - 'heuristic) - :ascent 70)) + (create-image + image-name + (and (fboundp 'imagemagick-types) + (imagemagick-types) + 'imagemagick) + nil + :conversion (and newsticker-enable-logo-manipulations + disabled + 'disabled) + :mask (and newsticker-enable-logo-manipulations + 'heuristic) + :ascent 100 + :max-height max-height) (error (message "Error: cannot create image for %s: %s" - feed-name-symbol error-data)))) - img)) + feed-name-symbol error-data)))))) + +(defun newsticker--icon-read (feed-name-symbol) + "Read the cached icon for FEED-NAME-SYMBOL from disk. +Return the image." + (catch 'icon + (when (file-exists-p (newsticker--icons-dir)) + (dolist (file (directory-files (newsticker--icons-dir) t + (concat (symbol-name feed-name-symbol) "\\..*"))) + (condition-case error-data + (throw 'icon (create-image + file (and (fboundp 'imagemagick-types) + (imagemagick-types) + 'imagemagick) + nil + :ascent 'center + :max-width 16 + :max-height 16)) + (error + (message "Error: cannot create icon for %s: %s" + feed-name-symbol error-data))))) + ;; Fallback: default icon. + (find-image '((:type png :file "newsticker/rss-feed.png" :ascent center))))) ;; the functions we need for retrieval and display ;;;###autoload diff --git a/lisp/net/newst-ticker.el b/lisp/net/newst-ticker.el index 5035287c580..9426bb7a8e4 100644 --- a/lisp/net/newst-ticker.el +++ b/lisp/net/newst-ticker.el @@ -6,7 +6,6 @@ ;; Filename: newst-ticker.el ;; URL: http://www.nongnu.org/newsticker ;; Keywords: News, RSS, Atom -;; Time-stamp: "6. Dezember 2009, 19:16:00 (ulf)" ;; Package: newsticker ;; ====================================================================== @@ -37,6 +36,14 @@ (require 'newst-backend) +(defvar newsticker--item-list nil + "List of newsticker items.") +(defvar newsticker--item-position 0 + "Actual position in list of newsticker items.") +(defvar newsticker--prev-message "There was no previous message yet!" + "Last message that the newsticker displayed.") +(defvar newsticker--scrollable-text "" + "The text which is scrolled smoothly in the echo area.") (defvar newsticker--ticker-timer nil "Timer for newsticker ticker.") diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el index bd2b96c9e1b..a9647501b48 100644 --- a/lisp/net/newst-treeview.el +++ b/lisp/net/newst-treeview.el @@ -83,6 +83,14 @@ "Face for newsticker selection." :group 'newsticker-treeview) +(defcustom newsticker-treeview-date-format + "%d.%m.%y, %H:%M" + "Format for the date column in the treeview list buffer. +See `format-time-string' for a list of valid specifiers." + :version "25.1" + :type 'string + :group 'newsticker-treeview) + (defcustom newsticker-treeview-own-frame nil "Decides whether newsticker treeview creates and uses its own frame." @@ -124,8 +132,9 @@ Example: (\"Topmost group\" \"feed1\" (\"subgroup1\" \"feed 2\") \"feed3\")") (defcustom newsticker-groups-filename - "~/.newsticker-groups" - "Name of the newsticker groups settings file." + nil + "Name of the newsticker groups settings file. This variable is obsolete." + :version "25.1" ; changed default value to nil :type 'string :group 'newsticker-treeview) (make-obsolete-variable 'newsticker-groups-filename 'newsticker-dir "23.1") @@ -230,23 +239,23 @@ their id stays constant." (newsticker--treeview-do-get-node-of-feed feed-name newsticker--treeview-vfeed-tree))) -(defun newsticker--treeview-do-get-node (id startnode) +(defun newsticker--treeview-do-get-node-by-id (id startnode) "Recursively search node with ID starting from STARTNODE." (if (newsticker--treeview-ids-eq id (widget-get startnode :nt-id)) (throw 'found startnode) (let ((children (widget-get startnode :children))) (dolist (w children) - (newsticker--treeview-do-get-node id w))))) + (newsticker--treeview-do-get-node-by-id id w))))) -(defun newsticker--treeview-get-node (id) +(defun newsticker--treeview-get-node-by-id (id) "Return node with ID in newsticker treeview tree." (catch 'found - (newsticker--treeview-do-get-node id newsticker--treeview-feed-tree) - (newsticker--treeview-do-get-node id newsticker--treeview-vfeed-tree))) + (newsticker--treeview-do-get-node-by-id id newsticker--treeview-feed-tree) + (newsticker--treeview-do-get-node-by-id id newsticker--treeview-vfeed-tree))) (defun newsticker--treeview-get-current-node () "Return current node in newsticker treeview tree." - (newsticker--treeview-get-node newsticker--treeview-current-node-id)) + (newsticker--treeview-get-node-by-id newsticker--treeview-current-node-id)) ;; ====================================================================== @@ -307,7 +316,7 @@ If string SHOW-FEED is non-nil it is shown in the item string." 0 10) (propertize " " 'display '(space :align-to 12))) "")) - (insert (format-time-string "%d.%m.%y, %H:%M" + (insert (format-time-string newsticker-treeview-date-format (newsticker--time item))) (insert (propertize " " 'display (list 'space :align-to (if show-feed 28 18)))) @@ -319,7 +328,8 @@ If string SHOW-FEED is non-nil it is shown in the item string." (while (search-forward "\n" nil t) (replace-match " ")) (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] 'newsticker-treeview-tree-click) + (dolist (key'([mouse-1] [mouse-3])) + (define-key map key 'newsticker-treeview-tree-click)) (define-key map "\n" 'newsticker-treeview-show-item) (define-key map "\C-m" 'newsticker-treeview-show-item) (add-text-properties pos1 (point-max) @@ -708,7 +718,9 @@ for the button." (remove-overlays) (when (and item feed-name-symbol) - (let ((wwidth (1- (window-width (newsticker--treeview-item-window))))) + (let ((wwidth (1- (if (window-live-p (newsticker--treeview-item-window)) + (window-width (newsticker--treeview-item-window)) + fill-column)))) (if newsticker-use-full-width (set (make-local-variable 'fill-column) wwidth)) (set (make-local-variable 'fill-column) (min fill-column @@ -727,7 +739,7 @@ for the button." (goto-char (point-min)) ;; insert logo at top (let* ((newsticker-enable-logo-manipulations nil) - (img (newsticker--image-read feed-name-symbol nil))) + (img (newsticker--image-read feed-name-symbol nil 40))) (if (and (display-images-p) img) (newsticker--insert-image img (car item)) (insert (newsticker--real-feed-name feed-name-symbol)))) @@ -773,8 +785,11 @@ for the button." (put-text-property pos (point) 'face 'newsticker-enclosure-face) (setq pos (point)) (insert "\n") - (newsticker--print-extra-elements item newsticker--treeview-url-keymap) - (put-text-property pos (point) 'face 'newsticker-extra-face) + (set-marker marker1 pos) + (newsticker--print-extra-elements item newsticker--treeview-url-keymap t) + (set-marker marker2 (point)) + (newsticker--treeview-render-text marker1 marker2) + (put-text-property marker1 marker2 'face 'newsticker-extra-face) (goto-char (point-min))))) (if (and newsticker-treeview-automatically-mark-displayed-items-as-old item @@ -818,6 +833,7 @@ Callback function for tree widget that adds nodes for feeds and subgroups." :nt-group ,(cdr g) :nt-feed ,g-name :nt-id ,nt-id + :leaf-icon newsticker--tree-widget-leaf-icon :keep (:nt-feed :num-new :nt-id :open);; :nt-group :open nil)) (let ((tag (newsticker--treeview-tree-get-tag g nil nt-id))) @@ -830,6 +846,23 @@ Callback function for tree widget that adds nodes for feeds and subgroups." :open t)))) group))) +(defun newsticker--tree-widget-icon-create (icon) + "Create the ICON widget." + (let* ((g (widget-get (widget-get icon :node) :nt-feed)) + (ico (and g (newsticker--icon-read (intern g))))) + (if ico + (progn + (widget-put icon :tag-glyph ico) + (widget-default-create icon) + ;; Insert space between the icon and the node widget. + (insert-char ? 1) + (put-text-property + (1- (point)) (point) + 'display (list 'space :width tree-widget-space-width))) + ;; fallback: default icon + (widget-put icon :leaf-icon 'tree-widget-leaf-icon) + (tree-widget-icon-create icon)))) + (defun newsticker--treeview-tree-expand-status (tree &optional changed-widget event) "Expand the vfeed TREE. @@ -864,6 +897,7 @@ Optional arguments CHANGED-WIDGET and EVENT are ignored." "Icon for a tree-widget leaf node." :tag "O" :glyph-name "leaf" + :create 'newsticker--tree-widget-icon-create :button-face 'default) (defun newsticker--treeview-tree-update () @@ -912,7 +946,8 @@ arguments NT-ID, FEED, and VFEED are added as properties." (map (make-sparse-keymap))) (if (and num-new (> num-new 0)) (setq face 'newsticker-treeview-new-face)) - (define-key map [mouse-1] 'newsticker-treeview-tree-click) + (dolist (key '([mouse-1] [mouse-3])) + (define-key map key 'newsticker-treeview-tree-click)) (define-key map "\n" 'newsticker-treeview-tree-do-click) (define-key map "\C-m" 'newsticker-treeview-tree-do-click) (propertize tag 'face face 'keymap map @@ -1158,12 +1193,14 @@ Arguments IGNORE are ignored." (unless newsticker--selection-overlay (with-current-buffer (newsticker--treeview-list-buffer) + (setq buffer-undo-list t) (setq newsticker--selection-overlay (make-overlay (point-min) (point-max))) (overlay-put newsticker--selection-overlay 'face 'newsticker-treeview-selection-face))) (unless newsticker--tree-selection-overlay (with-current-buffer (newsticker--treeview-tree-buffer) + (setq buffer-undo-list t) (setq newsticker--tree-selection-overlay (make-overlay (point-min) (point-max))) (overlay-put newsticker--tree-selection-overlay 'face @@ -1210,7 +1247,7 @@ Note: does not update the layout." (newsticker-treeview-save)) (defun newsticker-treeview-save () - "Save newsticker data including treeview settings." + "Save treeview group settings." (interactive) (let ((coding-system-for-write 'utf-8) (buf (find-file-noselect (concat newsticker-dir "/groups")))) @@ -1227,16 +1264,27 @@ Note: does not update the layout." "Load treeview settings." (let* ((coding-system-for-read 'utf-8) (filename - (or (and (file-exists-p newsticker-groups-filename) + (or (and newsticker-groups-filename + (not (string= + (expand-file-name newsticker-groups-filename) + (expand-file-name (concat newsticker-dir "/groups")))) + (file-exists-p newsticker-groups-filename) (y-or-n-p - (format "Old newsticker groups (%s) file exists. Read it? " - newsticker-groups-filename)) + (format + (concat "Obsolete variable `newsticker-groups-filename' " + "points to existing file \"%s\".\n" + "Read it? ") + newsticker-groups-filename)) newsticker-groups-filename) (concat newsticker-dir "/groups"))) (buf (and (file-exists-p filename) (find-file-noselect filename)))) - (and (file-exists-p newsticker-groups-filename) - (y-or-n-p (format "Delete old newsticker groups file? ")) + (and newsticker-groups-filename + (file-exists-p newsticker-groups-filename) + (y-or-n-p (format + (concat "Delete the file \"%s\",\nto which the obsolete " + "variable `newsticker-groups-filename' points ? ") + newsticker-groups-filename)) (delete-file newsticker-groups-filename)) (when buf (set-buffer buf) @@ -1590,10 +1638,8 @@ Return t if a new feed was activated, nil otherwise." "Recursively show subtree above the node that represents FEED-NAME." (let ((node (newsticker--treeview-get-node-of-feed feed-name))) (unless node - (let* ((group-name (or (car (newsticker--group-find-group-for-feed - feed-name)) - (newsticker--group-get-parent-group - feed-name)))) + (let* ((group-name (car (newsticker--group-find-parent-group + feed-name)))) (newsticker--treeview-unfold-node group-name)) (setq node (newsticker--treeview-get-node-of-feed feed-name))) (when node @@ -1617,20 +1663,31 @@ Return t if a new feed was activated, nil otherwise." ;; ====================================================================== ;;; Groups ;; ====================================================================== -(defun newsticker--group-do-find-group-for-feed (feed-name node) - "Recursively find FEED-NAME in NODE." - (if (member feed-name (cdr node)) - (throw 'found node) - (mapc (lambda (n) - (if (listp n) - (newsticker--group-do-find-group-for-feed feed-name n))) - (cdr node)))) - -(defun newsticker--group-find-group-for-feed (feed-name) - "Find group containing FEED-NAME." +(defun newsticker--group-do-find-group (feed-or-group-name parent-node node) + "Recursively find FEED-OR-GROUP-NAME in PARENT-NODE or NODE." + (cond ((stringp node) + (when (string= feed-or-group-name node) + (throw 'found parent-node))) + ((listp node) + (cond ((string= feed-or-group-name (car node)) + (throw 'found parent-node)) + ((member feed-or-group-name (cdr node)) + (throw 'found node)) + (t + (mapc (lambda (n) + (if (listp n) + (newsticker--group-do-find-group + feed-or-group-name node n))) + (cdr node))))))) + +(defun newsticker--group-find-parent-group (feed-or-group-name) + "Find group containing FEED-OR-GROUP-NAME." (catch 'found - (newsticker--group-do-find-group-for-feed feed-name - newsticker-groups) + (mapc (lambda (n) + (newsticker--group-do-find-group feed-or-group-name + newsticker-groups + n)) + newsticker-groups) nil)) (defun newsticker--group-do-get-group (name node) @@ -1651,26 +1708,6 @@ Return t if a new feed was activated, nil otherwise." newsticker-groups) nil)) -(defun newsticker--group-do-get-parent-group (name node parent) - "Recursively find parent group for NAME from NODE which is a child of PARENT." - (if (string= name (car node)) - (throw 'found parent) - (mapc (lambda (n) - (if (listp n) - (newsticker--group-do-get-parent-group name n (car node)))) - (cdr node)))) - -(defun newsticker--group-get-parent-group (name) - "Find parent group for group named NAME." - (catch 'found - (mapc (lambda (n) - (if (listp n) - (newsticker--group-do-get-parent-group - name n (car newsticker-groups)))) - newsticker-groups) - nil)) - - (defun newsticker--group-get-subgroups (group &optional recursive) "Return list of subgroups for GROUP. If RECURSIVE is non-nil recursively get subgroups and return a nested list." @@ -1706,9 +1743,9 @@ return a nested list." (defun newsticker-group-add-group (name parent) "Add group NAME to group PARENT." (interactive - (list (read-string "Group Name: ") + (list (read-string "Name of new group: ") (let ((completion-ignore-case t)) - (completing-read "Parent Group: " (newsticker--group-all-groups) + (completing-read "Name of parent group (optional): " (newsticker--group-all-groups) nil t)))) (if (newsticker--group-get-group name) (error "Group %s exists already" name)) @@ -1718,46 +1755,154 @@ return a nested list." (unless p (error "Parent %s does not exist" parent)) (setcdr p (cons (list name) (cdr p)))) - (newsticker--treeview-tree-update)) + (newsticker--treeview-tree-update) + (newsticker-treeview-jump newsticker--treeview-current-feed)) + +(defun newsticker-group-delete-group (name) + "Delete group NAME." + (interactive + (list (let ((completion-ignore-case t)) + (completing-read "Delete group: " + (newsticker--group-names) + nil t (car (newsticker--group-find-parent-group + newsticker--treeview-current-feed)))))) + (let ((parent-group (newsticker--group-find-parent-group name))) + (unless parent-group + (error "Parent %s does not exist" parent-group)) + (setcdr parent-group (cl-delete-if (lambda (g) + (and (listp g) + (string= name (car g)))) + (cdr parent-group))) + (newsticker--group-manage-orphan-feeds) + (newsticker--treeview-tree-update) + (newsticker-treeview-update) + (newsticker-treeview-jump newsticker--treeview-current-feed))) + +(defun newsticker--group-do-rename-group (old-name new-name) + "Actually rename group OLD-NAME to NEW-NAME." + (let ((parent-group (newsticker--group-find-parent-group old-name))) + (unless parent-group + (error "Parent of %s does not exist" old-name)) + (mapcar (lambda (elt) + (cond ((and (listp elt) + (string= old-name (car elt))) + (cons new-name (cdr elt))) + (t + elt))) parent-group))) + +(defun newsticker-group-rename-group (old-name new-name) + "Rename group OLD-NAME to NEW-NAME." + (interactive + (list (let* ((completion-ignore-case t)) + (completing-read "Rename group: " + (newsticker--group-names) + nil t (car (newsticker--group-find-parent-group + newsticker--treeview-current-feed)))) + (read-string "Rename to: "))) + (setq newsticker-groups (newsticker--group-do-rename-group old-name new-name)) + (newsticker--group-manage-orphan-feeds) + (newsticker--treeview-tree-update) + (newsticker-treeview-update) + (newsticker-treeview-jump newsticker--treeview-current-feed)) + +(defun newsticker--get-group-names (lst) + "Do get the group names from LST." + (delete nil (cons (car lst) + (apply 'append + (mapcar (lambda (e) + (cond ((listp e) + (newsticker--get-group-names e)) + (t + nil))) + (cdr lst)))))) + +(defun newsticker--group-names () + "Get names of all newsticker groups." + (newsticker--get-group-names newsticker-groups)) (defun newsticker-group-move-feed (name group-name &optional no-update) "Move feed NAME to group GROUP-NAME. Update treeview afterwards unless NO-UPDATE is non-nil." (interactive (let ((completion-ignore-case t)) - (list (completing-read "Feed Name: " - (mapcar 'car newsticker-url-list) + (list (completing-read "Name of feed or group to move: " + (append (mapcar 'car newsticker-url-list) + (newsticker--group-names)) nil t newsticker--treeview-current-feed) - (completing-read "Group Name: " (newsticker--group-all-groups) + (completing-read "Name of new parent group: " (newsticker--group-names) nil t)))) - (let ((group (if (and group-name (not (string= group-name ""))) - (newsticker--group-get-group group-name) - newsticker-groups))) + (let* ((group (if (and group-name (not (string= group-name ""))) + (newsticker--group-get-group group-name) + newsticker-groups)) + (moving-group-p (member name (newsticker--group-names))) + (moved-thing (if moving-group-p + (newsticker--group-get-group name) + name))) (unless group (error "Group %s does not exist" group-name)) (while (let ((old-group - (newsticker--group-find-group-for-feed name))) + (newsticker--group-find-parent-group name))) (when old-group - (delete name old-group)) + (delete moved-thing old-group)) old-group)) - (setcdr group (cons name (cdr group))) + (setcdr group (cons moved-thing (cdr group))) (unless no-update (newsticker--treeview-tree-update) - (newsticker-treeview-update)))) + (newsticker-treeview-update) + (newsticker-treeview-jump name)))) -(defun newsticker-group-delete-group (name) - "Remove group NAME." - (interactive - (let ((completion-ignore-case t)) - (list (completing-read "Group Name: " (newsticker--group-all-groups) - nil t)))) - (let* ((g (newsticker--group-get-group name)) - (p (or (newsticker--group-get-parent-group name) - newsticker-groups))) - (unless g - (error "Group %s does not exist" name)) - (delete g p)) - (newsticker--treeview-tree-update)) +(defun newsticker-group-shift-feed-down () + "Shift current feed down in its group." + (interactive) + (newsticker--group-shift 1)) + +(defun newsticker-group-shift-feed-up () + "Shift current feed down in its group." + (interactive) + (newsticker--group-shift -1)) + +(defun newsticker-group-shift-group-down () + "Shift current group down in its group." + (interactive) + (newsticker--group-shift 1 t)) + +(defun newsticker-group-shift-group-up () + "Shift current group down in its group." + (interactive) + (newsticker--group-shift -1 t)) + +(defun newsticker--group-shift (delta &optional move-group) + "Shift current feed or group within its parent group. +DELTA is an integer which specifies the direction and the amount +of the shift. If MOVE-GROUP is nil the currently selected feed +`newsticker--treeview-current-feed' is shifted, if it is t then +the current feed's parent group is shifted.." + (let* ((cur-feed newsticker--treeview-current-feed) + (thing (if move-group + (newsticker--group-find-parent-group cur-feed) + cur-feed)) + (parent-group (newsticker--group-find-parent-group + (if move-group (car thing) thing)))) + (unless parent-group + (error "Group not found!")) + (let* ((siblings (cdr parent-group)) + (pos (cl-position thing siblings :test 'equal)) + (tpos (+ pos delta )) + (new-pos (max 0 (min (length siblings) tpos))) + (beg (cl-subseq siblings 0 (min pos new-pos))) + (end (cl-subseq siblings (+ 1 (max pos new-pos)))) + (p (elt siblings new-pos))) + (when (not (= pos new-pos)) + (setcdr parent-group + (cl-concatenate 'list + beg + (if (> delta 0) + (list p thing) + (list thing p)) + end)) + (newsticker--treeview-tree-update) + (newsticker-treeview-update) + (newsticker-treeview-jump cur-feed))))) (defun newsticker--count-groups (group) "Recursively count number of subgroups of GROUP." @@ -1804,7 +1949,7 @@ Return t if groups have changed, nil otherwise." (let ((new-feed nil) (grouped-feeds (newsticker--count-grouped-feeds newsticker-groups))) (mapc (lambda (f) - (unless (newsticker--group-find-group-for-feed (car f)) + (unless (newsticker--group-find-parent-group (car f)) (setq new-feed t) (newsticker-group-move-feed (car f) nil t))) (append newsticker-url-list-defaults newsticker-url-list)) @@ -1817,37 +1962,22 @@ Return t if groups have changed, nil otherwise." ;; ====================================================================== ;;; Modes ;; ====================================================================== -(defun newsticker--treeview-create-groups-menu (group-list - excluded-group) - "Create menu for GROUP-LIST omitting EXCLUDED-GROUP." - (let ((menu (make-sparse-keymap (if (stringp (car group-list)) - (car group-list) - "Move to group...")))) - (mapc (lambda (g) - (when (listp g) - (let ((title (if (stringp (car g)) - (car g) - "Move to group..."))) - (unless (eq g excluded-group) - (define-key menu (vector (intern title)) - (list 'menu-item title - (newsticker--treeview-create-groups-menu - (cdr g) excluded-group))))))) - (reverse group-list)) - menu)) - -(defun newsticker--treeview-create-tree-menu (feed-name) - "Create tree menu for FEED-NAME." - (let ((menu (make-sparse-keymap feed-name))) +(defun newsticker--treeview-tree-open-menu (event) + "Open tree menu at position of EVENT." + (let* ((feed-name newsticker--treeview-current-feed) + (menu (make-sparse-keymap feed-name))) (define-key menu [newsticker-treeview-mark-list-items-old] (list 'menu-item "Mark all items old" 'newsticker-treeview-mark-list-items-old)) - (define-key menu [move] - (list 'menu-item "Move to group..." - (newsticker--treeview-create-groups-menu - newsticker-groups - (newsticker--group-get-group feed-name)))) - menu)) + (define-key menu [newsticker-treeview-get-news] + (list 'menu-item (concat "Get news for " feed-name) + 'newsticker-treeview-get-news)) + (define-key menu [newsticker-get-all-news] + (list 'menu-item "Get news for all feeds" + 'newsticker-get-all-news)) + (let ((choice (x-popup-menu event menu))) + (when choice + (funcall (car choice)))))) (defvar newsticker-treeview-list-menu (let ((menu (make-sparse-keymap "Newsticker List"))) @@ -1906,6 +2036,12 @@ Return t if groups have changed, nil otherwise." ;;(define-key map "\C-m" 'newsticker-treeview-scroll-item) (define-key map "\M-m" 'newsticker-group-move-feed) (define-key map "\M-a" 'newsticker-group-add-group) + (define-key map "\M-d" 'newsticker-group-delete-group) + (define-key map "\M-r" 'newsticker-group-rename-group) + (define-key map [M-down] 'newsticker-group-shift-feed-down) + (define-key map [M-up] 'newsticker-group-shift-feed-up) + (define-key map [M-S-down] 'newsticker-group-shift-group-down) + (define-key map [M-S-up] 'newsticker-group-shift-group-up) map) "Mode map for newsticker treeview.") @@ -1950,7 +2086,7 @@ Return t if groups have changed, nil otherwise." (newsticker--treeview-restore-layout) (save-excursion (switch-to-buffer (window-buffer (posn-window (event-end event)))) - (newsticker-treeview-tree-do-click (posn-point (event-end event))))) + (newsticker-treeview-tree-do-click (posn-point (event-end event)) event))) (defun newsticker-treeview-tree-do-click (&optional pos event) "Actually handle click event. @@ -1964,13 +2100,17 @@ POS gives the position where EVENT occurred." (newsticker-treeview-show-item)) (t ;; click in tree buffer - (let ((w (newsticker--treeview-get-node nt-id))) + (let ((w (newsticker--treeview-get-node-by-id nt-id))) (when w (newsticker--treeview-tree-update-tag w t t) - (setq w (newsticker--treeview-get-node nt-id)) + (setq w (newsticker--treeview-get-node-by-id nt-id)) (widget-put w :nt-selected t) (widget-apply w :action event) - (newsticker--treeview-set-current-node w)))))) + (newsticker--treeview-set-current-node w) + (and event + (eq 'mouse-3 (car event)) + (sit-for 0) + (newsticker--treeview-tree-open-menu event))))))) (newsticker--treeview-tree-update-highlight)) (defun newsticker--treeview-restore-layout () diff --git a/lisp/net/newsticker.el b/lisp/net/newsticker.el index 730b7f8fc65..9b16c1f0749 100644 --- a/lisp/net/newsticker.el +++ b/lisp/net/newsticker.el @@ -7,8 +7,6 @@ ;; URL: http://www.nongnu.org/newsticker ;; Created: 17. June 2003 ;; Keywords: News, RSS, Atom -;; Time-stamp: "6. Dezember 2009, 19:15:18 (ulf)" -;; Version: 1.99 ;; ====================================================================== @@ -28,6 +26,7 @@ ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. (defconst newsticker-version "1.99" "Version number of newsticker.el.") +(make-obsolete-variable 'newsticker-version 'emacs-version "25.1") ;; ====================================================================== ;;; Commentary: diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el new file mode 100644 index 00000000000..2312e22d96a --- /dev/null +++ b/lisp/net/nsm.el @@ -0,0 +1,502 @@ +;;; nsm.el --- Network Security Manager + +;; Copyright (C) 2014-2015 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> +;; Keywords: encryption, security, network + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'cl-lib) + +(defvar nsm-permanent-host-settings nil) +(defvar nsm-temporary-host-settings nil) + +(defgroup nsm nil + "Network Security Manager" + :version "25.1" + :group 'comm) + +(defcustom network-security-level 'medium + "How secure the network should be. +If a potential problem with the security of the network +connection is found, the user is asked to give input into how the +connection should be handled. + +The following values are possible: + +`low': Absolutely no checks are performed. +`medium': This is the default level, should be reasonable for most usage. +`high': This warns about additional things that many people would +not find useful. +`paranoid': On this level, the user is queried for most new connections. + +See the Emacs manual for a description of all things that are +checked and warned against." + :version "25.1" + :group 'nsm + :type '(choice (const :tag "Low" low) + (const :tag "Medium" medium) + (const :tag "High" high) + (const :tag "Paranoid" paranoid))) + +(defcustom nsm-settings-file (expand-file-name "network-security.data" + user-emacs-directory) + "The file the security manager settings will be stored in." + :version "25.1" + :group 'nsm + :type 'file) + +(defcustom nsm-save-host-names nil + "If non-nil, always save host names in the structures in `nsm-settings-file'. +By default, only hosts that have exceptions have their names +stored in plain text." + :version "25.1" + :group 'nsm + :type 'boolean) + +(defvar nsm-noninteractive nil + "If non-nil, the connection is opened in a non-interactive context. +This means that no queries should be performed.") + +(defun nsm-verify-connection (process host port &optional + save-fingerprint warn-unencrypted) + "Verify the security status of PROCESS that's connected to HOST:PORT. +If PROCESS is a gnutls connection, the certificate validity will +be examined. If it's a non-TLS connection, it may be compared +against previous connections. If the function determines that +there is something odd about the connection, the user will be +queried about what to do about it. + +The process it returned if everything is OK, and otherwise, the +process will be deleted and nil is returned. + +If SAVE-FINGERPRINT, always save the fingerprint of the +server (if the connection is a TLS connection). This is useful +to keep track of the TLS status of STARTTLS servers. + +If WARN-UNENCRYPTED, query the user if the connection is +unencrypted." + (if (eq network-security-level 'low) + process + (let* ((status (gnutls-peer-status process)) + (id (nsm-id host port)) + (settings (nsm-host-settings id))) + (cond + ((not (process-live-p process)) + nil) + ((not status) + ;; This is a non-TLS connection. + (nsm-check-plain-connection process host port settings + warn-unencrypted)) + (t + (let ((process + (nsm-check-tls-connection process host port status settings))) + (when (and process save-fingerprint + (null (nsm-host-settings id))) + (nsm-save-host host port status 'fingerprint 'always)) + process)))))) + +(defun nsm-check-tls-connection (process host port status settings) + (let ((process (nsm-check-certificate process host port status settings))) + (if (and process + (>= (nsm-level network-security-level) (nsm-level 'high))) + ;; Do further protocol-level checks if the security is high. + (nsm-check-protocol process host port status settings) + process))) + +(defun nsm-check-certificate (process host port status settings) + (let ((warnings (plist-get status :warnings))) + (cond + + ;; The certificate validated, but perhaps we want to do + ;; certificate pinning. + ((null warnings) + (cond + ((< (nsm-level network-security-level) (nsm-level 'high)) + process) + ;; The certificate is fine, but if we're paranoid, we might + ;; want to check whether it's changed anyway. + ((and (>= (nsm-level network-security-level) (nsm-level 'high)) + (not (nsm-fingerprint-ok-p host port status settings))) + (delete-process process) + nil) + ;; We haven't seen this before, and we're paranoid. + ((and (eq network-security-level 'paranoid) + (null settings) + (not (nsm-new-fingerprint-ok-p host port status))) + (delete-process process) + nil) + ((>= (nsm-level network-security-level) (nsm-level 'high)) + ;; Save the host fingerprint so that we can check it the + ;; next time we connect. + (nsm-save-host host port status 'fingerprint 'always) + process) + (t + process))) + + ;; The certificate did not validate. + ((not (equal network-security-level 'low)) + ;; We always want to pin the certificate of invalid connections + ;; to track man-in-the-middle or the like. + (if (not (nsm-fingerprint-ok-p host port status settings)) + (progn + (delete-process process) + nil) + ;; We have a warning, so query the user. + (if (and (not (nsm-warnings-ok-p status settings)) + (not (nsm-query + host port status 'conditions + "The TLS connection to %s:%s is insecure for the following reason%s:\n\n%s" + host port + (if (> (length warnings) 1) + "s" "") + (mapconcat #'gnutls-peer-status-warning-describe + warnings + "\n")))) + (progn + (delete-process process) + nil) + process)))))) + +(defun nsm-check-protocol (process host port status settings) + (let ((prime-bits (plist-get status :diffie-hellman-prime-bits)) + (encryption (format "%s-%s-%s" + (plist-get status :key-exchange) + (plist-get status :cipher) + (plist-get status :mac))) + (protocol (plist-get status :protocol))) + (cond + ((and prime-bits + (< prime-bits 1024) + (not (memq :diffie-hellman-prime-bits + (plist-get settings :conditions))) + (not + (nsm-query + host port status :diffie-hellman-prime-bits + "The Diffie-Hellman prime bits (%s) used for this connection to %s:%s is less than what is considered safe (%s)." + prime-bits host port 1024))) + (delete-process process) + nil) + ((and (string-match "\\bRC4\\b" encryption) + (not (memq :rc4 (plist-get settings :conditions))) + (not + (nsm-query + host port status :rc4 + "The connection to %s:%s uses the RC4 algorithm (%s), which is believed to be unsafe." + host port encryption))) + (delete-process process) + nil) + ((and protocol + (string-match "SSL" protocol) + (not (memq :ssl (plist-get settings :conditions))) + (not + (nsm-query + host port status :ssl + "The connection to %s:%s uses the %s protocol, which is believed to be unsafe." + host port protocol))) + (delete-process process) + nil) + (t + process)))) + +(defun nsm-fingerprint (status) + (plist-get (plist-get status :certificate) :public-key-id)) + +(defun nsm-fingerprint-ok-p (host port status settings) + (let ((did-query nil)) + (if (and settings + (not (eq (plist-get settings :fingerprint) :none)) + (not (equal (nsm-fingerprint status) + (plist-get settings :fingerprint))) + (not + (setq did-query + (nsm-query + host port status 'fingerprint + "The fingerprint for the connection to %s:%s has changed from %s to %s" + host port + (plist-get settings :fingerprint) + (nsm-fingerprint status))))) + ;; Not OK. + nil + (when did-query + ;; Remove any exceptions that have been set on the previous + ;; certificate. + (plist-put settings :conditions nil)) + t))) + +(defun nsm-new-fingerprint-ok-p (host port status) + (nsm-query + host port status 'fingerprint + "The fingerprint for the connection to %s:%s is new: %s" + host port + (nsm-fingerprint status))) + +(defun nsm-check-plain-connection (process host port settings warn-unencrypted) + ;; If this connection used to be TLS, but is now plain, then it's + ;; possible that we're being Man-In-The-Middled by a proxy that's + ;; stripping out STARTTLS announcements. + (cond + ((and (plist-get settings :fingerprint) + (not (eq (plist-get settings :fingerprint) :none)) + (not + (nsm-query + host port nil 'conditions + "The connection to %s:%s used to be an encrypted connection, but is now unencrypted. This might mean that there's a man-in-the-middle tapping this connection." + host port))) + (delete-process process) + nil) + ((and warn-unencrypted + (not (memq :unencrypted (plist-get settings :conditions))) + (not (nsm-query + host port nil 'conditions + "The connection to %s:%s is unencrypted." + host port))) + (delete-process process) + nil) + (t + process))) + +(defun nsm-query (host port status what message &rest args) + ;; If there is no user to answer queries, then say `no' to everything. + (if (or noninteractive + nsm-noninteractive) + nil + (let ((response + (condition-case nil + (nsm-query-user message args (nsm-format-certificate status)) + ;; Make sure we manage to close the process if the user hits + ;; `C-g'. + (quit 'no) + (error 'no)))) + (if (eq response 'no) + nil + (nsm-save-host host port status what response) + t)))) + +(defun nsm-query-user (message args cert) + (let ((buffer (get-buffer-create "*Network Security Manager*"))) + (with-help-window buffer + (with-current-buffer buffer + (erase-buffer) + (when (> (length cert) 0) + (insert cert "\n")) + (let ((start (point))) + (insert (apply 'format message args)) + (goto-char start) + ;; Fill the first line of the message, which usually + ;; contains lots of explanatory text. + (fill-region (point) (line-end-position))))) + (let ((responses '((?n . no) + (?s . session) + (?a . always))) + (prefix "") + response) + (while (not response) + (setq response + (cdr + (assq (downcase + (read-char + (concat prefix + "Continue connecting? (No, Session only, Always)"))) + responses))) + (unless response + (ding) + (setq prefix "Invalid choice. "))) + (kill-buffer buffer) + ;; If called from a callback, `read-char' will insert things + ;; into the pending input. Clear that. + (clear-this-command-keys) + response))) + +(defun nsm-save-host (host port status what permanency) + (let* ((id (nsm-id host port)) + (saved + (list :id id + :fingerprint (or (nsm-fingerprint status) + ;; Plain connection. + :none)))) + (when (or (eq what 'conditions) + nsm-save-host-names) + (nconc saved (list :host (format "%s:%s" host port)))) + ;; We either want to save/update the fingerprint or the conditions + ;; of the certificate/unencrypted connection. + (cond + ((eq what 'conditions) + (cond + ((not status) + (nconc saved '(:conditions (:unencrypted)))) + ((plist-get status :warnings) + (nconc saved + (list :conditions (plist-get status :warnings)))))) + ((not (eq what 'fingerprint)) + ;; Store additional protocol settings. + (let ((settings (nsm-host-settings id))) + (when settings + (setq saved settings)) + (if (plist-get saved :conditions) + (nconc (plist-get saved :conditions) (list what)) + (nconc saved (list :conditions (list what))))))) + (if (eq permanency 'always) + (progn + (nsm-remove-temporary-setting id) + (nsm-remove-permanent-setting id) + (push saved nsm-permanent-host-settings) + (nsm-write-settings)) + (nsm-remove-temporary-setting id) + (push saved nsm-temporary-host-settings)))) + +(defun nsm-write-settings () + (with-temp-file nsm-settings-file + (insert "(\n") + (dolist (setting nsm-permanent-host-settings) + (insert " ") + (prin1 setting (current-buffer)) + (insert "\n")) + (insert ")\n"))) + +(defun nsm-read-settings () + (setq nsm-permanent-host-settings + (with-temp-buffer + (insert-file-contents nsm-settings-file) + (goto-char (point-min)) + (ignore-errors (read (current-buffer)))))) + +(defun nsm-id (host port) + (concat "sha1:" (sha1 (format "%s:%s" host port)))) + +(defun nsm-host-settings (id) + (when (and (not nsm-permanent-host-settings) + (file-exists-p nsm-settings-file)) + (nsm-read-settings)) + (let ((result nil)) + (dolist (elem (append nsm-temporary-host-settings + nsm-permanent-host-settings)) + (when (and (not result) + (equal (plist-get elem :id) id)) + (setq result elem))) + result)) + +(defun nsm-warnings-ok-p (status settings) + (let ((ok t) + (conditions (plist-get settings :conditions))) + (dolist (warning (plist-get status :warnings)) + (unless (memq warning conditions) + (setq ok nil))) + ok)) + +(defun nsm-remove-permanent-setting (id) + (setq nsm-permanent-host-settings + (cl-delete-if + (lambda (elem) + (equal (plist-get elem :id) id)) + nsm-permanent-host-settings))) + +(defun nsm-remove-temporary-setting (id) + (setq nsm-temporary-host-settings + (cl-delete-if + (lambda (elem) + (equal (plist-get elem :id) id)) + nsm-temporary-host-settings))) + +(defun nsm-format-certificate (status) + (let ((cert (plist-get status :certificate))) + (when cert + (with-temp-buffer + (insert + "Certificate information\n" + "Issued by:" + (nsm-certificate-part (plist-get cert :issuer) "CN" t) "\n" + "Issued to:" + (or (nsm-certificate-part (plist-get cert :subject) "O") + (nsm-certificate-part (plist-get cert :subject) "OU" t)) + "\n" + "Hostname:" + (nsm-certificate-part (plist-get cert :subject) "CN" t) "\n") + (when (and (plist-get cert :public-key-algorithm) + (plist-get cert :signature-algorithm)) + (insert + "Public key:" (plist-get cert :public-key-algorithm) + ", signature: " (plist-get cert :signature-algorithm) "\n")) + (when (and (plist-get status :key-exchange) + (plist-get status :cipher) + (plist-get status :mac) + (plist-get status :protocol)) + (insert + "Protocol:" (plist-get status :protocol) + ", key: " (plist-get status :key-exchange) + ", cipher: " (plist-get status :cipher) + ", mac: " (plist-get status :mac) "\n")) + (when (plist-get cert :certificate-security-level) + (insert + "Security level:" + (propertize (plist-get cert :certificate-security-level) + 'face 'bold) + "\n")) + (insert + "Valid:From " (plist-get cert :valid-from) + " to " (plist-get cert :valid-to) "\n\n") + (goto-char (point-min)) + (while (re-search-forward "^[^:]+:" nil t) + (insert (make-string (- 20 (current-column)) ? ))) + (buffer-string))))) + +(defun nsm-certificate-part (string part &optional full) + (let ((part (cadr (assoc part (nsm-parse-subject string))))) + (cond + (part part) + (full string) + (t nil)))) + +(defun nsm-parse-subject (string) + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (let ((start (point)) + (result nil)) + (while (not (eobp)) + (push (replace-regexp-in-string + "[\\]\\(.\\)" "\\1" + (buffer-substring start + (if (re-search-forward "[^\\]," nil 'move) + (1- (point)) + (point)))) + result) + (setq start (point))) + (mapcar + (lambda (elem) + (let ((pos (cl-position ?= elem))) + (if pos + (list (substring elem 0 pos) + (substring elem (1+ pos))) + elem))) + (nreverse result))))) + +(defun nsm-level (symbol) + "Return a numerical level for SYMBOL for easier comparison." + (cond + ((eq symbol 'low) 0) + ((eq symbol 'medium) 1) + ((eq symbol 'high) 2) + (t 3))) + +(provide 'nsm) + +;;; nsm.el ends here diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el index 9b231a09b91..5f02e2977ef 100644 --- a/lisp/net/ntlm.el +++ b/lisp/net/ntlm.el @@ -80,8 +80,8 @@ is not given." (request-msgType (concat (make-string 1 1) (make-string 3 0))) ;0x01 0x00 0x00 0x00 (request-flags (concat (make-string 1 7) (make-string 1 178) - (make-string 2 0))) - ;0x07 0xb2 0x00 0x00 + (make-string 1 8) (make-string 1 0))) + ;0x07 0xb2 0x08 0x00 lu ld off-d off-u) (when (string-match "@" user) (unless domain @@ -144,11 +144,35 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of (setq domain (substring user (1+ (match-beginning 0)))) (setq user (substring user 0 (match-beginning 0)))) - ;; generate response data - (setq lmRespData - (ntlm-smb-owf-encrypt (car password-hashes) challengeData)) - (setq ntRespData - (ntlm-smb-owf-encrypt (cadr password-hashes) challengeData)) + ;; check if "negotiate NTLM2 key" flag is set in type 2 message + (if (not (zerop (logand (aref flags 2) 8))) + (let (randomString + sessionHash) + ;; generate NTLM2 session response data + (setq randomString (string-make-unibyte + (concat + (make-string 1 (random 256)) + (make-string 1 (random 256)) + (make-string 1 (random 256)) + (make-string 1 (random 256)) + (make-string 1 (random 256)) + (make-string 1 (random 256)) + (make-string 1 (random 256)) + (make-string 1 (random 256))))) + (setq sessionHash (secure-hash 'md5 + (concat challengeData randomString) + nil nil t)) + (setq sessionHash (substring sessionHash 0 8)) + + (setq lmRespData (concat randomString (make-string 16 0))) + (setq ntRespData (ntlm-smb-owf-encrypt + (cadr password-hashes) sessionHash))) + (progn + ;; generate response data + (setq lmRespData + (ntlm-smb-owf-encrypt (car password-hashes) challengeData)) + (setq ntRespData + (ntlm-smb-owf-encrypt (cadr password-hashes) challengeData)))) ;; get offsets to fields to pack the response struct in a string (setq lu (length user)) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index dade37dfd9c..74d03f59f3d 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1,10 +1,10 @@ -;;; rcirc.el --- default, simple IRC client. +;;; rcirc.el --- default, simple IRC client -*- lexical-binding: t; -*- ;; Copyright (C) 2005-2015 Free Software Foundation, Inc. ;; Author: Ryan Yeske <rcyeske@gmail.com> ;; Maintainers: Ryan Yeske <rcyeske@gmail.com>, -;; Deniz Dogan <deniz@dogan.se> +;; Leo Liu <sdl.web@gmail.com> ;; Keywords: comm ;; This file is part of GNU Emacs. @@ -43,9 +43,9 @@ ;;; Code: +(require 'cl-lib) (require 'ring) (require 'time-date) -(eval-when-compile (require 'cl)) (defgroup rcirc nil "Simple IRC client." @@ -145,11 +145,13 @@ for connections using SSL/TLS." (defcustom rcirc-fill-column nil "Column beyond which automatic line-wrapping should happen. -If nil, use value of `fill-column'. If 'frame-width, use the -maximum frame width." - :type '(choice (const :tag "Value of `fill-column'") - (const :tag "Full frame width" frame-width) - (integer :tag "Number of columns")) +If nil, use value of `fill-column'. +If a function (e.g., `frame-text-width' or `window-text-width'), +call it to compute the number of columns." + :risky t ; can get funcalled + :type '(choice (const :tag "Value of `fill-column'" nil) + (integer :tag "Number of columns") + (function :tag "Function returning the number of columns")) :group 'rcirc) (defcustom rcirc-fill-prefix nil @@ -489,7 +491,7 @@ If ARG is non-nil, instead prompt for connection parameters." (when (string= server (process-name p)) (setq connected p))) (if (not connected) - (condition-case e + (condition-case nil (rcirc-connect server port nick user-name full-name channels password encryption) (quit (message "Quit connecting to %s" server))) @@ -521,6 +523,7 @@ If ARG is non-nil, instead prompt for connection parameters." (defvar rcirc-user-authenticated nil) (defvar rcirc-user-disconnect nil) (defvar rcirc-connecting nil) +(defvar rcirc-connection-info nil) (defvar rcirc-process nil) ;;;###autoload @@ -549,22 +552,23 @@ If ARG is non-nil, instead prompt for connection parameters." (set-process-sentinel process 'rcirc-sentinel) (set-process-filter process 'rcirc-filter) - (set (make-local-variable 'rcirc-process) process) - (set (make-local-variable 'rcirc-server) server) - (set (make-local-variable 'rcirc-server-name) server) ; Update when we get 001 response. - (set (make-local-variable 'rcirc-buffer-alist) nil) - (set (make-local-variable 'rcirc-nick-table) - (make-hash-table :test 'equal)) - (set (make-local-variable 'rcirc-nick) nick) - (set (make-local-variable 'rcirc-process-output) nil) - (set (make-local-variable 'rcirc-startup-channels) startup-channels) - (set (make-local-variable 'rcirc-last-server-message-time) - (current-time)) - - (set (make-local-variable 'rcirc-timeout-timer) nil) - (set (make-local-variable 'rcirc-user-disconnect) nil) - (set (make-local-variable 'rcirc-user-authenticated) nil) - (set (make-local-variable 'rcirc-connecting) t) + (setq-local rcirc-connection-info + (list server port nick user-name full-name startup-channels + password encryption)) + (setq-local rcirc-process process) + (setq-local rcirc-server server) + (setq-local rcirc-server-name server) ; Update when we get 001 response. + (setq-local rcirc-buffer-alist nil) + (setq-local rcirc-nick-table (make-hash-table :test 'equal)) + (setq-local rcirc-nick nick) + (setq-local rcirc-process-output nil) + (setq-local rcirc-startup-channels startup-channels) + (setq-local rcirc-last-server-message-time (current-time)) + + (setq-local rcirc-timeout-timer nil) + (setq-local rcirc-user-disconnect nil) + (setq-local rcirc-user-authenticated nil) + (setq-local rcirc-connecting t) (add-hook 'auto-save-hook 'rcirc-log-write) @@ -595,10 +599,10 @@ If ARG is non-nil, instead prompt for connection parameters." `(with-current-buffer rcirc-server-buffer ,@body)) -(defun rcirc-float-time () +(defalias 'rcirc-float-time (if (featurep 'xemacs) - (time-to-seconds (current-time)) - (float-time))) + 'time-to-seconds + 'float-time)) (defun rcirc-prompt-for-encryption (server-plist) "Prompt the user for the encryption method to use. @@ -629,7 +633,7 @@ last ping." (cancel-timer rcirc-keepalive-timer)) (setq rcirc-keepalive-timer nil))) -(defun rcirc-handler-ctcp-KEEPALIVE (process target sender message) +(defun rcirc-handler-ctcp-KEEPALIVE (process _target _sender message) (with-rcirc-process-buffer process (setq header-line-format (format "%f" (- (rcirc-float-time) (string-to-number message)))))) @@ -656,6 +660,16 @@ is non-nil." "Hook functions called when the process sentinel is called. Functions are called with PROCESS and SENTINEL arguments.") +(defcustom rcirc-reconnect-delay 0 + "The minimum interval in seconds between reconnect attempts. +When 0, do not auto-reconnect." + :version "25.1" + :type 'integer + :group 'rcirc) + +(defvar rcirc-last-connect-time nil + "The last time the buffer was connected.") + (defun rcirc-sentinel (process sentinel) "Called when PROCESS receives SENTINEL." (let ((sentinel (replace-regexp-in-string "\n" "" sentinel))) @@ -667,8 +681,17 @@ Functions are called with PROCESS and SENTINEL arguments.") (format "%s: %s (%S)" (process-name process) sentinel - (process-status process)) (not rcirc-target)) + (process-status process)) + (not rcirc-target)) (rcirc-disconnect-buffer))) + (when (and (string= sentinel "deleted") + (< 0 rcirc-reconnect-delay)) + (let ((now (current-time))) + (when (or (null rcirc-last-connect-time) + (< rcirc-reconnect-delay + (float-time (time-subtract now rcirc-last-connect-time)))) + (setq rcirc-last-connect-time now) + (rcirc-cmd-reconnect nil)))) (run-hook-with-args 'rcirc-sentinel-functions process sentinel)))) (defun rcirc-disconnect-buffer (&optional buffer) @@ -752,7 +775,7 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (defvar rcirc-responses-no-activity '("305" "306") "Responses that don't trigger activity in the mode-line indicator.") -(defun rcirc-handler-generic (process response sender args text) +(defun rcirc-handler-generic (process response sender args _text) "Generic server response handler." (rcirc-print process sender response nil (mapconcat 'identity (cdr args) " ") @@ -782,11 +805,11 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (defun rcirc-buffer-process (&optional buffer) "Return the process associated with channel BUFFER. With no argument or nil as argument, use the current buffer." - (or (get-buffer-process (if buffer - (with-current-buffer buffer - rcirc-server-buffer) - rcirc-server-buffer)) - rcirc-process)) + (let ((buffer (or buffer (and (buffer-live-p rcirc-server-buffer) + rcirc-server-buffer)))) + (if buffer + (with-current-buffer buffer rcirc-process) + rcirc-process))) (defun rcirc-server-name (process) "Return PROCESS server name, given by the 001 response." @@ -928,12 +951,12 @@ IRC command completion is performed only if '/' is the first input char." (defun set-rcirc-decode-coding-system (coding-system) "Set the decode coding system used in this channel." (interactive "zCoding system for incoming messages: ") - (set (make-local-variable 'rcirc-decode-coding-system) coding-system)) + (setq-local rcirc-decode-coding-system coding-system)) (defun set-rcirc-encode-coding-system (coding-system) "Set the encode coding system used in this channel." (interactive "zCoding system for outgoing messages: ") - (set (make-local-variable 'rcirc-encode-coding-system) coding-system)) + (setq-local rcirc-encode-coding-system coding-system)) (defvar rcirc-mode-map (let ((map (make-sparse-keymap))) @@ -990,25 +1013,26 @@ This number is independent of the number of lines in the buffer.") (setq major-mode 'rcirc-mode) (setq mode-line-process nil) - (set (make-local-variable 'rcirc-input-ring) - ;; If rcirc-input-ring is already a ring with desired size do - ;; not re-initialize. - (if (and (ring-p rcirc-input-ring) - (= (ring-size rcirc-input-ring) - rcirc-input-ring-size)) - rcirc-input-ring - (make-ring rcirc-input-ring-size))) - (set (make-local-variable 'rcirc-server-buffer) (process-buffer process)) - (set (make-local-variable 'rcirc-target) target) - (set (make-local-variable 'rcirc-topic) nil) - (set (make-local-variable 'rcirc-last-post-time) (current-time)) - (set (make-local-variable 'fill-paragraph-function) 'rcirc-fill-paragraph) - (set (make-local-variable 'rcirc-recent-quit-alist) nil) - (set (make-local-variable 'rcirc-current-line) 0) + (setq-local rcirc-input-ring + ;; If rcirc-input-ring is already a ring with desired + ;; size do not re-initialize. + (if (and (ring-p rcirc-input-ring) + (= (ring-size rcirc-input-ring) + rcirc-input-ring-size)) + rcirc-input-ring + (make-ring rcirc-input-ring-size))) + (setq-local rcirc-server-buffer (process-buffer process)) + (setq-local rcirc-target target) + (setq-local rcirc-topic nil) + (setq-local rcirc-last-post-time (current-time)) + (setq-local fill-paragraph-function 'rcirc-fill-paragraph) + (setq-local rcirc-recent-quit-alist nil) + (setq-local rcirc-current-line 0) + (setq-local rcirc-last-connect-time (current-time)) (use-hard-newlines t) - (set (make-local-variable 'rcirc-short-buffer-name) nil) - (set (make-local-variable 'rcirc-urls) nil) + (setq-local rcirc-short-buffer-name nil) + (setq-local rcirc-urls nil) ;; setup for omitting responses (setq buffer-invisibility-spec '()) @@ -1023,18 +1047,18 @@ This number is independent of the number of lines in the buffer.") (serv (if (consp (car i)) (cdar i) ""))) (when (and (string-match chan (or target "")) (string-match serv (rcirc-server-name process))) - (set (make-local-variable 'rcirc-decode-coding-system) - (if (consp (cdr i)) (cadr i) (cdr i))) - (set (make-local-variable 'rcirc-encode-coding-system) - (if (consp (cdr i)) (cddr i) (cdr i)))))) + (setq-local rcirc-decode-coding-system + (if (consp (cdr i)) (cadr i) (cdr i))) + (setq-local rcirc-encode-coding-system + (if (consp (cdr i)) (cddr i) (cdr i)))))) ;; setup the prompt and markers - (set (make-local-variable 'rcirc-prompt-start-marker) (point-max-marker)) - (set (make-local-variable 'rcirc-prompt-end-marker) (point-max-marker)) + (setq-local rcirc-prompt-start-marker (point-max-marker)) + (setq-local rcirc-prompt-end-marker (point-max-marker)) (rcirc-update-prompt) (goto-char rcirc-prompt-end-marker) - (set (make-local-variable 'overlay-arrow-position) (make-marker)) + (setq-local overlay-arrow-position (make-marker)) ;; if the user changes the major mode or kills the buffer, there is ;; cleanup work to do @@ -1222,13 +1246,13 @@ Create the buffer if it doesn't exist." (ring-insert rcirc-input-ring input) (setq rcirc-input-ring-index 0)))))) -(defun rcirc-fill-paragraph (&optional arg) - (interactive "p") +(defun rcirc-fill-paragraph (&optional justify) + (interactive "P") (when (> (point) rcirc-prompt-end-marker) (save-restriction (narrow-to-region rcirc-prompt-end-marker (point-max)) (let ((fill-column rcirc-max-message-length)) - (fill-region (point-min) (point-max)))))) + (fill-region (point-min) (point-max) justify))))) (defun rcirc-process-input-line (line) (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" line) @@ -1393,9 +1417,9 @@ is found by looking up RESPONSE in `rcirc-response-formats'." (rcirc-add-face start (match-beginning 0) face) (setq start (match-beginning 0)) (replace-match - (case (aref (match-string 1) 0) + (cl-case (aref (match-string 1) 0) (?f (setq face - (case (string-to-char (match-string 3)) + (cl-case (string-to-char (match-string 3)) (?w 'font-lock-warning-face) (?p 'rcirc-server-prefix) (?s 'rcirc-server) @@ -1431,9 +1455,9 @@ is found by looking up RESPONSE in `rcirc-response-formats'." (rcirc-add-face start (match-beginning 0) face)) (buffer-substring (point-min) (point-max)))) -(defun rcirc-target-buffer (process sender response target text) +(defun rcirc-target-buffer (process sender response target _text) "Return a buffer to print the server response." - (assert (not (bufferp target))) + (cl-assert (not (bufferp target))) (with-rcirc-process-buffer process (cond ((not target) (rcirc-any-buffer process)) @@ -1474,11 +1498,10 @@ Returns nil if the information is not recorded." (defun rcirc-last-line (process nick target) "Return the line from the last activity from NICK in TARGET." - (let* ((chanbuf (rcirc-get-buffer process target)) - (line (or (cdr (assoc-string target - (gethash nick (with-rcirc-server-buffer - rcirc-nick-table)) t)) - (rcirc-last-quit-line process nick target)))) + (let ((line (or (cdr (assoc-string target + (gethash nick (with-rcirc-server-buffer + rcirc-nick-table)) t)) + (rcirc-last-quit-line process nick target)))) (if line line ;;(message "line is nil for %s in %s" nick target) @@ -1883,7 +1906,9 @@ Uninteresting lines are those whose responses are listed in (message "Rcirc-Omit mode enabled")) (remove-from-invisibility-spec '(rcirc-omit . nil)) (message "Rcirc-Omit mode disabled")) - (recenter (when (> (point) rcirc-prompt-start-marker) -1))) + (dolist (window (get-buffer-window-list (current-buffer))) + (with-selected-window window + (recenter (when (> (point) rcirc-prompt-start-marker) -1))))) (defun rcirc-switch-to-server-buffer () "Switch to the server buffer associated with current channel buffer." @@ -1956,7 +1981,7 @@ activity. Only run if the buffer is not visible and (let ((t1 (with-current-buffer b1 rcirc-last-post-time)) (t2 (with-current-buffer b2 rcirc-last-post-time))) (time-less-p t2 t1))))) - (pushnew type rcirc-activity-types) + (cl-pushnew type rcirc-activity-types) (unless (and (equal rcirc-activity old-activity) (member type old-types)) (rcirc-update-activity-string))))) @@ -1977,13 +2002,13 @@ activity. Only run if the buffer is not visible and (defun rcirc-split-activity (activity) "Return a cons cell with ACTIVITY split into (lopri . hipri)." (let (lopri hipri) - (dolist (buf rcirc-activity) + (dolist (buf activity) (with-current-buffer buf (if (and rcirc-low-priority-flag (not (member 'nick rcirc-activity-types))) - (add-to-list 'lopri buf t) - (add-to-list 'hipri buf t)))) - (cons lopri hipri))) + (push buf lopri) + (push buf hipri)))) + (cons (nreverse lopri) (nreverse hipri)))) (defvar rcirc-update-activity-string-hook nil "Hook run whenever the activity string is updated.") @@ -2015,7 +2040,7 @@ activity. Only run if the buffer is not visible and (with-current-buffer b (dolist (type rcirc-activity-types) (rcirc-add-face 0 (length s) - (case type + (cl-case type (nick 'rcirc-track-nick) (keyword 'rcirc-track-keyword)) s))) @@ -2123,7 +2148,7 @@ activity. Only run if the buffer is not visible and (when (and (listp x) (listp (cadr x))) (setcdr x (if (> (length (cdr x)) 1) (rcirc-make-trees (cdr x)) - (setcdr x (list (cdadr x))))))) + (setcdr x (list (cl-cdadr x))))))) alist))) ;;; /commands these are called with 3 args: PROCESS, TARGET, which is @@ -2211,6 +2236,19 @@ CHANNELS is a comma- or space-separated string of channel names." reason rcirc-id-string)))) +(defun-rcirc-command reconnect (_) + "Reconnect to current server." + (interactive "i") + (with-rcirc-server-buffer + (cond + (rcirc-connecting (message "Already connecting")) + ((process-live-p process) (message "Server process is alive")) + (t (let ((conn-info rcirc-connection-info)) + (setf (nth 5 conn-info) + (cl-remove-if-not #'rcirc-channel-p + (mapcar #'car rcirc-buffer-alist))) + (apply #'rcirc-connect conn-info)))))) + (defun-rcirc-command nick (nick) "Change nick to NICK." (interactive "i") @@ -2281,7 +2319,7 @@ With a prefix arg, prompt for new topic." (mapconcat 'identity (cdr arglist) " ")))) (rcirc-send-string process (concat "KICK " target " " argstring)))) -(defun rcirc-cmd-ctcp (args &optional process target) +(defun rcirc-cmd-ctcp (args &optional process _target) (if (string-match "^\\([^ ]+\\)\\s-+\\(.+\\)$" args) (let* ((target (match-string 1 args)) (request (upcase (match-string 2 args))) @@ -2292,7 +2330,7 @@ With a prefix arg, prompt for new topic." (rcirc-print process (rcirc-nick process) "ERROR" nil "usage: /ctcp NICK REQUEST"))) -(defun rcirc-ctcp-sender-PING (process target request) +(defun rcirc-ctcp-sender-PING (process target _request) "Send a CTCP PING message to TARGET." (let ((timestamp (format "%.0f" (rcirc-float-time)))) (rcirc-send-ctcp process target "PING" timestamp))) @@ -2412,21 +2450,20 @@ If ARG is given, opens the URL in a new browser window." (lambda (x) (>= point (cdr x))) rcirc-urls)) (completions (mapcar (lambda (x) (car x)) filtered)) - (initial-input (caar filtered)) - (history (mapcar (lambda (x) (car x)) (cdr filtered)))) - (browse-url (completing-read "rcirc browse-url: " - completions nil nil initial-input 'history) + (defaults (mapcar (lambda (x) (car x)) filtered))) + (browse-url (completing-read "Rcirc browse-url: " + completions nil nil (car defaults) nil defaults) arg))) -(defun rcirc-markup-timestamp (sender response) +(defun rcirc-markup-timestamp (_sender _response) (goto-char (point-min)) (insert (rcirc-facify (format-time-string rcirc-time-format) 'rcirc-timestamp))) -(defun rcirc-markup-attributes (sender response) +(defun rcirc-markup-attributes (_sender _response) (while (re-search-forward "\\([\C-b\C-_\C-v]\\).*?\\(\\1\\|\C-o\\)" nil t) (rcirc-add-face (match-beginning 0) (match-end 0) - (case (char-after (match-beginning 1)) + (cl-case (char-after (match-beginning 1)) (?\C-b 'bold) (?\C-v 'italic) (?\C-_ 'underline))) @@ -2440,7 +2477,7 @@ If ARG is given, opens the URL in a new browser window." (while (re-search-forward "\C-o+" nil t) (delete-region (match-beginning 0) (match-end 0)))) -(defun rcirc-markup-my-nick (sender response) +(defun rcirc-markup-my-nick (_sender response) (with-syntax-table rcirc-nick-syntax-table (while (re-search-forward (concat "\\b" (regexp-quote (rcirc-nick @@ -2454,7 +2491,7 @@ If ARG is given, opens the URL in a new browser window." 'rcirc-nick-in-message-full-line) (rcirc-record-activity (current-buffer) 'nick))))) -(defun rcirc-markup-urls (sender response) +(defun rcirc-markup-urls (_sender _response) (while (and rcirc-url-regexp ;; nil means disable URL catching (re-search-forward rcirc-url-regexp nil t)) (let* ((start (match-beginning 0)) @@ -2485,7 +2522,7 @@ If ARG is given, opens the URL in a new browser window." (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-keyword) (rcirc-record-activity (current-buffer) 'keyword)))))) -(defun rcirc-markup-bright-nicks (sender response) +(defun rcirc-markup-bright-nicks (_sender response) (when (and rcirc-bright-nicks (string= response "NAMES")) (with-syntax-table rcirc-nick-syntax-table @@ -2493,16 +2530,15 @@ If ARG is given, opens the URL in a new browser window." (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-bright-nick))))) -(defun rcirc-markup-fill (sender response) +(defun rcirc-markup-fill (_sender response) (when (not (string= response "372")) ; /motd (let ((fill-prefix (or rcirc-fill-prefix (make-string (- (point) (line-beginning-position)) ?\s))) - (fill-column (- (cond ((eq rcirc-fill-column 'frame-width) - (1- (frame-width))) - (rcirc-fill-column - rcirc-fill-column) - (t fill-column)) + (fill-column (- (cond ((null rcirc-fill-column) fill-column) + ((functionp rcirc-fill-column) + (funcall rcirc-fill-column)) + (t rcirc-fill-column)) ;; make sure ... doesn't cause line wrapping 3))) (fill-region (point) (point-max) nil t)))) @@ -2574,7 +2610,7 @@ If ARG is given, opens the URL in a new browser window." sender))) message t)))) -(defun rcirc-check-auth-status (process sender args text) +(defun rcirc-check-auth-status (process sender args _text) "Check if the user just authenticated. If authenticated, runs `rcirc-authenticated-hook' with PROCESS as the only argument." @@ -2602,10 +2638,10 @@ the only argument." (run-hook-with-args 'rcirc-authenticated-hook process) (remove-hook 'rcirc-authenticated-hook 'rcirc-join-channels-post-auth t)))))) -(defun rcirc-handler-WALLOPS (process sender args text) +(defun rcirc-handler-WALLOPS (process sender args _text) (rcirc-print process sender "WALLOPS" sender (car args) t)) -(defun rcirc-handler-JOIN (process sender args text) +(defun rcirc-handler-JOIN (process sender args _text) (let ((channel (car args))) (with-current-buffer (rcirc-get-buffer-create process channel) ;; when recently rejoining, restore the linestamp @@ -2626,7 +2662,7 @@ the only argument." (rcirc-print process sender "JOIN" sender channel)))) ;; PART and KICK are handled the same way -(defun rcirc-handler-PART-or-KICK (process response channel sender nick args) +(defun rcirc-handler-PART-or-KICK (process _response channel _sender nick _args) (rcirc-ignore-update-automatic nick) (if (not (string= nick (rcirc-nick process))) ;; this is someone else leaving @@ -2643,7 +2679,7 @@ the only argument." (when buffer (rcirc-disconnect-buffer buffer))))) -(defun rcirc-handler-PART (process sender args text) +(defun rcirc-handler-PART (process sender args _text) (let* ((channel (car args)) (reason (cadr args)) (message (concat channel " " reason))) @@ -2654,10 +2690,10 @@ the only argument." (rcirc-handler-PART-or-KICK process "PART" channel sender sender reason))) -(defun rcirc-handler-KICK (process sender args text) +(defun rcirc-handler-KICK (process sender args _text) (let* ((channel (car args)) (nick (cadr args)) - (reason (caddr args)) + (reason (cl-caddr args)) (message (concat nick " " channel " " reason))) (rcirc-print process sender "KICK" channel message t) ;; print in private chat buffer if it exists @@ -2682,7 +2718,7 @@ the only argument." (cons (cons nick line) rcirc-recent-quit-alist)))))))))) -(defun rcirc-handler-QUIT (process sender args text) +(defun rcirc-handler-QUIT (process sender args _text) (rcirc-ignore-update-automatic sender) (mapc (lambda (channel) ;; broadcast quit message each channel @@ -2692,7 +2728,7 @@ the only argument." (rcirc-nick-channels process sender)) (rcirc-nick-remove process sender)) -(defun rcirc-handler-NICK (process sender args text) +(defun rcirc-handler-NICK (process sender args _text) (let* ((old-nick sender) (new-nick (car args)) (channels (rcirc-nick-channels process old-nick))) @@ -2723,25 +2759,25 @@ the only argument." ;; reauthenticate (when rcirc-auto-authenticate-flag (rcirc-authenticate)))))) -(defun rcirc-handler-PING (process sender args text) +(defun rcirc-handler-PING (process _sender args _text) (rcirc-send-string process (concat "PONG :" (car args)))) -(defun rcirc-handler-PONG (process sender args text) +(defun rcirc-handler-PONG (_process _sender _args _text) ;; do nothing ) -(defun rcirc-handler-TOPIC (process sender args text) +(defun rcirc-handler-TOPIC (process sender args _text) (let ((topic (cadr args))) (rcirc-print process sender "TOPIC" (car args) topic) (with-current-buffer (rcirc-get-buffer process (car args)) (setq rcirc-topic topic)))) (defvar rcirc-nick-away-alist nil) -(defun rcirc-handler-301 (process sender args text) +(defun rcirc-handler-301 (process _sender args text) "RPL_AWAY" (let* ((nick (cadr args)) (rec (assoc-string nick rcirc-nick-away-alist)) - (away-message (caddr args))) + (away-message (cl-caddr args))) (when (or (not rec) (not (string= (cdr rec) away-message))) ;; away message has changed @@ -2751,7 +2787,7 @@ the only argument." (setq rcirc-nick-away-alist (cons (cons nick away-message) rcirc-nick-away-alist)))))) -(defun rcirc-handler-317 (process sender args text) +(defun rcirc-handler-317 (process sender args _text) "RPL_WHOISIDLE" (let* ((nick (nth 1 args)) (idle-secs (string-to-number (nth 2 args))) @@ -2765,31 +2801,31 @@ the only argument." nick idle-string signon-string))) (rcirc-print process sender "317" nil message t))) -(defun rcirc-handler-332 (process sender args text) +(defun rcirc-handler-332 (process _sender args _text) "RPL_TOPIC" (let ((buffer (or (rcirc-get-buffer process (cadr args)) (rcirc-get-temp-buffer-create process (cadr args))))) (with-current-buffer buffer - (setq rcirc-topic (caddr args))))) + (setq rcirc-topic (cl-caddr args))))) -(defun rcirc-handler-333 (process sender args text) +(defun rcirc-handler-333 (process sender args _text) "333 says who set the topic and when. Not in rfc1459.txt" (let ((buffer (or (rcirc-get-buffer process (cadr args)) (rcirc-get-temp-buffer-create process (cadr args))))) (with-current-buffer buffer - (let ((setter (caddr args)) + (let ((setter (cl-caddr args)) (time (current-time-string (seconds-to-time - (string-to-number (cadddr args)))))) + (string-to-number (cl-cadddr args)))))) (rcirc-print process sender "TOPIC" (cadr args) (format "%s (%s on %s)" rcirc-topic setter time)))))) -(defun rcirc-handler-477 (process sender args text) +(defun rcirc-handler-477 (process sender args _text) "ERR_NOCHANMODES" - (rcirc-print process sender "477" (cadr args) (caddr args))) + (rcirc-print process sender "477" (cadr args) (cl-caddr args))) -(defun rcirc-handler-MODE (process sender args text) +(defun rcirc-handler-MODE (process sender args _text) (let ((target (car args)) (msg (mapconcat 'identity (cdr args) " "))) (rcirc-print process sender "MODE" @@ -2809,7 +2845,7 @@ Not in rfc1459.txt" (let ((tmpnam (concat " " (downcase channel) "TMP" (process-name process)))) (get-buffer-create tmpnam))) -(defun rcirc-handler-353 (process sender args text) +(defun rcirc-handler-353 (process _sender args _text) "RPL_NAMREPLY" (let ((channel (nth 2 args)) (names (or (nth 3 args) ""))) @@ -2822,7 +2858,7 @@ Not in rfc1459.txt" (goto-char (point-max)) (insert (car (last args)) " ")))) -(defun rcirc-handler-366 (process sender args text) +(defun rcirc-handler-366 (process sender args _text) "RPL_ENDOFNAMES" (let* ((channel (cadr args)) (buffer (rcirc-get-temp-buffer-create process channel))) @@ -2847,14 +2883,14 @@ Passwords are stored in `rcirc-authinfo' (which see)." (dolist (i rcirc-authinfo) (let ((process (rcirc-buffer-process)) (server (car i)) - (nick (caddr i)) + (nick (cl-caddr i)) (method (cadr i)) - (args (cdddr i))) + (args (cl-cdddr i))) (when (and (string-match server rcirc-server)) (if (and (memq method '(nickserv chanserv bitlbee)) (string-match nick rcirc-nick)) ;; the following methods rely on the user's nickname. - (case method + (cl-case method (nickserv (rcirc-send-privmsg process @@ -2878,10 +2914,10 @@ Passwords are stored in `rcirc-authinfo' (which see)." "Q@CServe.quakenet.org" (format "AUTH %s %s" nick (car args)))))))))) -(defun rcirc-handler-INVITE (process sender args text) +(defun rcirc-handler-INVITE (process sender args _text) (rcirc-print process sender "INVITE" nil (mapconcat 'identity args " ") t)) -(defun rcirc-handler-ERROR (process sender args text) +(defun rcirc-handler-ERROR (process sender args _text) (rcirc-print process sender "ERROR" nil (mapconcat 'identity args " "))) (defun rcirc-handler-CTCP (process target sender text) @@ -2899,7 +2935,7 @@ Passwords are stored in `rcirc-authinfo' (which see)." (rcirc-print process sender "CTCP" target (format "%s" text) t)))))) -(defun rcirc-handler-ctcp-VERSION (process target sender args) +(defun rcirc-handler-ctcp-VERSION (process _target sender _args) (rcirc-send-string process (concat "NOTICE " sender " :\C-aVERSION " rcirc-id-string @@ -2908,12 +2944,12 @@ Passwords are stored in `rcirc-authinfo' (which see)." (defun rcirc-handler-ctcp-ACTION (process target sender args) (rcirc-print process sender "ACTION" target args t)) -(defun rcirc-handler-ctcp-TIME (process target sender args) +(defun rcirc-handler-ctcp-TIME (process _target sender _args) (rcirc-send-string process (concat "NOTICE " sender " :\C-aTIME " (current-time-string) "\C-a"))) -(defun rcirc-handler-CTCP-response (process target sender message) +(defun rcirc-handler-CTCP-response (process _target sender message) (rcirc-print process sender "CTCP" nil message t)) (defgroup rcirc-faces nil diff --git a/lisp/net/shr.el b/lisp/net/shr.el index dcc1654aba8..a0c9eba4144 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -33,11 +33,13 @@ (eval-when-compile (require 'cl)) (eval-when-compile (require 'url)) ;For url-filename's setf handler. (require 'browse-url) +(require 'subr-x) +(require 'dom) (defgroup shr nil "Simple HTML Renderer" - :version "24.1" - :group 'hypermedia) + :version "25.1" + :group 'web) (defcustom shr-max-image-proportion 0.9 "How big pictures displayed are in relation to the window they're in. @@ -76,11 +78,12 @@ If nil, don't draw horizontal table lines." :group 'shr :type 'character) -(defcustom shr-width fill-column +(defcustom shr-width nil "Frame width to use for rendering. May either be an integer specifying a fixed width in characters, or nil, meaning that the full width of the window should be used." + :version "25.1" :type '(choice (integer :tag "Fixed width in characters") (const :tag "Use the width of the window" nil)) :group 'shr) @@ -123,19 +126,24 @@ cid: URL as the argument.") "Font for link elements." :group 'shr) +(defvar shr-inhibit-images nil + "If non-nil, inhibit loading images.") + ;;; Internal variables. (defvar shr-folding-mode nil) (defvar shr-state nil) (defvar shr-start nil) (defvar shr-indentation 0) -(defvar shr-inhibit-images nil) +(defvar shr-internal-width (or shr-width (1- (window-width)))) (defvar shr-list-mode nil) (defvar shr-content-cache nil) (defvar shr-kinsoku-shorten nil) (defvar shr-table-depth 0) (defvar shr-stylesheet nil) (defvar shr-base nil) +(defvar shr-depth 0) +(defvar shr-warning nil) (defvar shr-ignore-cache nil) (defvar shr-external-rendering-functions nil) (defvar shr-target-id nil) @@ -197,9 +205,13 @@ DOM should be a parse tree as generated by (shr-state nil) (shr-start nil) (shr-base nil) - (shr-width (or shr-width (1- (window-width))))) - (shr-descend (shr-transform-dom dom)) - (shr-remove-trailing-whitespace start (point)))) + (shr-depth 0) + (shr-warning nil) + (shr-internal-width (or shr-width (1- (window-width))))) + (shr-descend dom) + (shr-remove-trailing-whitespace start (point)) + (when shr-warning + (message "%s" shr-warning)))) (defun shr-remove-trailing-whitespace (start end) (let ((width (window-width))) @@ -214,12 +226,16 @@ DOM should be a parse tree as generated by (overlay-put overlay 'before-string nil)))) (forward-line 1))))) -(defun shr-copy-url () +(defun shr-copy-url (&optional image-url) "Copy the URL under point to the kill ring. +If IMAGE-URL (the prefix) is non-nil, or there is no link under +point, but there is an image under point then copy the URL of the +image under point instead. If called twice, then try to fetch the URL and see whether it redirects somewhere else." - (interactive) - (let ((url (get-text-property (point) 'shr-url))) + (interactive "P") + (let ((url (or (get-text-property (point) 'shr-url) + (get-text-property (point) 'image-url)))) (cond ((not url) (message "No URL under point")) @@ -242,16 +258,17 @@ redirects somewhere else." ;; Copy the URL to the kill ring. (t (with-temp-buffer - (insert url) + (insert (url-encode-url url)) (copy-region-as-kill (point-min) (point-max)) - (message "Copied %s" url)))))) + (message "Copied %s" (buffer-string))))))) (defun shr-next-link () "Skip to the next link." (interactive) (let ((skip (text-property-any (point) (point-max) 'help-echo nil))) - (if (not (setq skip (text-property-not-all skip (point-max) - 'help-echo nil))) + (if (or (eobp) + (not (setq skip (text-property-not-all skip (point-max) + 'help-echo nil)))) (message "No next link") (goto-char skip) (message "%s" (get-text-property (point) 'help-echo))))) @@ -286,7 +303,7 @@ redirects somewhere else." (let ((text (get-text-property (point) 'shr-alt))) (if (not text) (message "No image under point") - (message "%s" text)))) + (message "%s" (shr-fold-text text))))) (defun shr-browse-image (&optional copy-url) "Browse the image under point. @@ -353,78 +370,80 @@ size, and full-buffer size." ;;; Utility functions. -(defun shr-transform-dom (dom) - (let ((result (list (pop dom)))) - (dolist (arg (pop dom)) - (push (cons (intern (concat ":" (symbol-name (car arg))) obarray) - (cdr arg)) - result)) - (dolist (sub dom) - (if (stringp sub) - (push (cons 'text sub) result) - (push (shr-transform-dom sub) result))) - (nreverse result))) - -(defsubst shr-generic (cont) - (dolist (sub cont) - (cond - ((eq (car sub) 'text) - (shr-insert (cdr sub))) - ((listp (cdr sub)) - (shr-descend sub))))) +(defsubst shr-generic (dom) + (dolist (sub (dom-children dom)) + (if (stringp sub) + (shr-insert sub) + (shr-descend sub)))) (defun shr-descend (dom) (let ((function (or ;; Allow other packages to override (or provide) rendering ;; of elements. - (cdr (assq (car dom) shr-external-rendering-functions)) - (intern (concat "shr-tag-" (symbol-name (car dom))) obarray))) - (style (cdr (assq :style (cdr dom)))) + (cdr (assq (dom-tag dom) shr-external-rendering-functions)) + (intern (concat "shr-tag-" (symbol-name (dom-tag dom))) obarray))) + (style (dom-attr dom 'style)) (shr-stylesheet shr-stylesheet) + (shr-depth (1+ shr-depth)) (start (point))) - (when style - (if (string-match "color\\|display\\|border-collapse" style) - (setq shr-stylesheet (nconc (shr-parse-style style) - shr-stylesheet)) - (setq style nil))) - ;; If we have a display:none, then just ignore this part of the DOM. - (unless (equal (cdr (assq 'display shr-stylesheet)) "none") - (if (fboundp function) - (funcall function (cdr dom)) - (shr-generic (cdr dom))) - (when (and shr-target-id - (equal (cdr (assq :id (cdr dom))) shr-target-id)) - ;; If the element was empty, we don't have anything to put the - ;; anchor on. So just insert a dummy character. - (when (= start (point)) - (insert "*")) - (put-text-property start (1+ start) 'shr-target-id shr-target-id)) - ;; If style is set, then this node has set the color. + ;; shr uses about 12 frames per nested node. + (if (> shr-depth (/ max-specpdl-size 12)) + (setq shr-warning "Too deeply nested to render properly; consider increasing `max-specpdl-size'") (when style - (shr-colorize-region start (point) - (cdr (assq 'color shr-stylesheet)) - (cdr (assq 'background-color shr-stylesheet))))))) - -(defmacro shr-char-breakable-p (char) + (if (string-match "color\\|display\\|border-collapse" style) + (setq shr-stylesheet (nconc (shr-parse-style style) + shr-stylesheet)) + (setq style nil))) + ;; If we have a display:none, then just ignore this part of the DOM. + (unless (equal (cdr (assq 'display shr-stylesheet)) "none") + (if (fboundp function) + (funcall function dom) + (shr-generic dom)) + (when (and shr-target-id + (equal (dom-attr dom 'id) shr-target-id)) + ;; If the element was empty, we don't have anything to put the + ;; anchor on. So just insert a dummy character. + (when (= start (point)) + (insert "*")) + (put-text-property start (1+ start) 'shr-target-id shr-target-id)) + ;; If style is set, then this node has set the color. + (when style + (shr-colorize-region + start (point) + (cdr (assq 'color shr-stylesheet)) + (cdr (assq 'background-color shr-stylesheet)))))))) + +(defun shr-fold-text (text) + (if (zerop (length text)) + text + (with-temp-buffer + (let ((shr-indentation 0) + (shr-state nil) + (shr-start nil) + (shr-internal-width (window-width))) + (shr-insert text) + (buffer-string))))) + +(define-inline shr-char-breakable-p (char) "Return non-nil if a line can be broken before and after CHAR." - `(aref fill-find-break-point-function-table ,char)) -(defmacro shr-char-nospace-p (char) + (inline-quote (aref fill-find-break-point-function-table ,char))) +(define-inline shr-char-nospace-p (char) "Return non-nil if no space is required before and after CHAR." - `(aref fill-nospace-between-words-table ,char)) + (inline-quote (aref fill-nospace-between-words-table ,char))) ;; KINSOKU is a Japanese word meaning a rule that should not be violated. ;; In Emacs, it is a term used for characters, e.g. punctuation marks, ;; parentheses, and so on, that should not be placed in the beginning ;; of a line or the end of a line. -(defmacro shr-char-kinsoku-bol-p (char) +(define-inline shr-char-kinsoku-bol-p (char) "Return non-nil if a line ought not to begin with CHAR." - `(let ((char ,char)) - (and (not (eq char ?')) - (aref (char-category-set char) ?>)))) -(defmacro shr-char-kinsoku-eol-p (char) + (inline-letevals (char) + (inline-quote (and (not (eq ,char ?')) + (aref (char-category-set ,char) ?>))))) +(define-inline shr-char-kinsoku-eol-p (char) "Return non-nil if a line ought not to end with CHAR." - `(aref (char-category-set ,char) ?<)) + (inline-quote (aref (char-category-set ,char) ?<))) (unless (shr-char-kinsoku-bol-p (make-char 'japanese-jisx0208 33 35)) (load "kinsoku" nil t)) @@ -467,8 +486,8 @@ size, and full-buffer size." (insert elem) (setq shr-state nil) (let (found) - (while (and (> (current-column) shr-width) - (> shr-width 0) + (while (and (> (current-column) shr-internal-width) + (> shr-internal-width 0) (progn (setq found (shr-find-fill-point)) (not (eolp)))) @@ -482,10 +501,10 @@ size, and full-buffer size." (when (> shr-indentation 0) (shr-indent)) (end-of-line)) - (if (<= (current-column) shr-width) + (if (<= (current-column) shr-internal-width) (insert " ") ;; In case we couldn't get a valid break point (because of a - ;; word that's longer than `shr-width'), just break anyway. + ;; word that's longer than `shr-internal-width'), just break anyway. (insert "\n") (when (> shr-indentation 0) (shr-indent))))) @@ -493,7 +512,7 @@ size, and full-buffer size." (delete-char -1))))) (defun shr-find-fill-point () - (when (> (move-to-column shr-width) shr-width) + (when (> (move-to-column shr-internal-width) shr-internal-width) (backward-char 1)) (let ((bp (point)) failed) @@ -533,7 +552,7 @@ size, and full-buffer size." ;; so we look for the second best position. (while (and (progn (forward-char 1) - (<= (current-column) shr-width)) + (<= (current-column) shr-internal-width)) (progn (setq bp (point)) (shr-char-kinsoku-eol-p (following-char))))) @@ -570,6 +589,8 @@ size, and full-buffer size." ;; Always chop off anchors. (when (string-match "#.*" url) (setq url (substring url 0 (match-beginning 0)))) + ;; NB: <base href="" > URI may itself be relative to the document s URI + (setq url (shr-expand-url url)) (let* ((parsed (url-generic-parse-url url)) (local (url-filename parsed))) (setf (url-filename parsed) "") @@ -592,6 +613,7 @@ size, and full-buffer size." (defun shr-expand-url (url &optional base) (setq base (if base + ;; shr-parse-base should never call this with non-nil base! (shr-parse-base base) ;; Bound by the parser. shr-base)) @@ -600,8 +622,8 @@ size, and full-buffer size." (cond ((or (not url) (not base) (string-match "\\`[a-z]*:" url)) - ;; Absolute URL. - (or url (car base))) + ;; Absolute or empty URI + (or url (nth 3 base))) ((eq (aref url 0) ?/) (if (and (> (length url) 1) (eq (aref url 1) ?/)) @@ -644,9 +666,9 @@ size, and full-buffer size." (when (> shr-indentation 0) (insert (make-string shr-indentation ? )))) -(defun shr-fontize-cont (cont &rest types) +(defun shr-fontize-dom (dom &rest types) (let (shr-start) - (shr-generic cont) + (shr-generic dom) (dolist (type types) (shr-add-font (or shr-start (point)) (point) type)))) @@ -759,6 +781,8 @@ element is the data blob and the second element is the content-type." ((eq size 'original) (create-image data nil t :ascent 100 :format content-type)) + ((eq content-type 'image/svg+xml) + (create-image data 'svg t :ascent 100)) ((eq size 'full) (ignore-errors (shr-rescale-image data content-type))) @@ -821,14 +845,24 @@ Return a string with image data." (shr-parse-image-data))))) (defun shr-parse-image-data () - (list - (buffer-substring (point) (point-max)) - (save-excursion - (save-restriction - (narrow-to-region (point-min) (point)) - (let ((content-type (mail-fetch-field "content-type"))) - (and content-type - (intern content-type obarray))))))) + (let ((data (buffer-substring (point) (point-max))) + (content-type + (save-excursion + (save-restriction + (narrow-to-region (point-min) (point)) + (let ((content-type (mail-fetch-field "content-type"))) + (and content-type + ;; Remove any comments in the type string. + (intern (replace-regexp-in-string ";.*" "" content-type) + obarray))))))) + ;; SVG images may contain references to further images that we may + ;; want to block. So special-case these by parsing the XML data + ;; and remove the blocked bits. + (when (eq content-type 'image/svg+xml) + (setq data + (shr-dom-to-xml + (libxml-parse-xml-region (point) (point-max))))) + (list data content-type))) (defun shr-image-displayer (content-function) "Return a function to display an image. @@ -850,9 +884,9 @@ START, and END. Note that START and END should be markers." (list (current-buffer) start end) t t))))) -(defun shr-heading (cont &rest types) +(defun shr-heading (dom &rest types) (shr-ensure-paragraph) - (apply #'shr-fontize-cont cont types) + (apply #'shr-fontize-dom dom types) (shr-ensure-paragraph)) (defun shr-urlify (start url &optional title) @@ -860,7 +894,12 @@ START, and END. Note that START and END should be markers." (add-text-properties start (point) (list 'shr-url url - 'help-echo (if title (format "%s (%s)" url title) url) + 'help-echo (let ((iri (or (ignore-errors + (decode-coding-string + (url-unhex-string url) + 'utf-8 t)) + url))) + (if title (format "%s (%s)" iri title) iri)) 'follow-link t 'mouse-face 'highlight 'keymap shr-map))) @@ -961,105 +1000,106 @@ ones, in case fg and bg are nil." ;;; Tag-specific rendering rules. -(defun shr-tag-body (cont) +(defun shr-tag-body (dom) (let* ((start (point)) - (fgcolor (cdr (or (assq :fgcolor cont) - (assq :text cont)))) - (bgcolor (cdr (assq :bgcolor cont))) + (fgcolor (or (dom-attr dom 'fgcolor) (dom-attr dom 'text))) + (bgcolor (dom-attr dom 'bgcolor)) (shr-stylesheet (list (cons 'color fgcolor) (cons 'background-color bgcolor)))) - (shr-generic cont) + (shr-generic dom) (shr-colorize-region start (point) fgcolor bgcolor))) -(defun shr-tag-style (_cont) +(defun shr-tag-style (_dom) ) -(defun shr-tag-script (_cont) +(defun shr-tag-script (_dom) ) -(defun shr-tag-comment (_cont) +(defun shr-tag-comment (_dom) ) (defun shr-dom-to-xml (dom) + (with-temp-buffer + (shr-dom-print dom) + (buffer-string))) + +(defun shr-dom-print (dom) "Convert DOM into a string containing the xml representation." - (let ((arg " ") - (text "") - url) - (dolist (sub (cdr dom)) + (insert (format "<%s" (dom-tag dom))) + (dolist (attr (dom-attributes dom)) + ;; Ignore attributes that start with a colon because they are + ;; private elements. + (unless (= (aref (format "%s" (car attr)) 0) ?:) + (insert (format " %s=\"%s\"" (car attr) (cdr attr))))) + (insert ">") + (let (url) + (dolist (elem (dom-children dom)) (cond - ((listp (cdr sub)) - ;; Ignore external image definitions if required. - ;; <image xlink:href="http://TRACKING_URL/"/> - (when (or (not (eq (car sub) 'image)) - (not (setq url (cdr (assq ':xlink:href (cdr sub))))) - (not shr-blocked-images) - (not (string-match shr-blocked-images url))) - (setq text (concat text (shr-dom-to-xml sub))))) - ((eq (car sub) 'text) - (setq text (concat text (cdr sub)))) - (t - (setq arg (concat arg (format "%s=\"%s\" " - (substring (symbol-name (car sub)) 1) - (cdr sub))))))) - (format "<%s%s>%s</%s>" - (car dom) - (substring arg 0 (1- (length arg))) - text - (car dom)))) - -(defun shr-tag-svg (cont) + ((stringp elem) + (insert elem)) + ((eq (dom-tag elem) 'comment) + ) + ((or (not (eq (dom-tag elem) 'image)) + ;; Filter out blocked elements inside the SVG image. + (not (setq url (dom-attr elem ':xlink:href))) + (not shr-blocked-images) + (not (string-match shr-blocked-images url))) + (insert " ") + (shr-dom-print elem))))) + (insert (format "</%s>" (dom-tag dom)))) + +(defun shr-tag-svg (dom) (when (and (image-type-available-p 'svg) (not shr-inhibit-images)) - (funcall shr-put-image-function - (shr-dom-to-xml (cons 'svg cont)) - "SVG Image"))) + (funcall shr-put-image-function (list (shr-dom-to-xml dom) 'image/svg+xml) + "SVG Image"))) -(defun shr-tag-sup (cont) +(defun shr-tag-sup (dom) (let ((start (point))) - (shr-generic cont) + (shr-generic dom) (put-text-property start (point) 'display '(raise 0.5)))) -(defun shr-tag-sub (cont) +(defun shr-tag-sub (dom) (let ((start (point))) - (shr-generic cont) + (shr-generic dom) (put-text-property start (point) 'display '(raise -0.5)))) -(defun shr-tag-label (cont) - (shr-generic cont) +(defun shr-tag-label (dom) + (shr-generic dom) (shr-ensure-paragraph)) -(defun shr-tag-p (cont) +(defun shr-tag-p (dom) (shr-ensure-paragraph) (shr-indent) - (shr-generic cont) + (shr-generic dom) (shr-ensure-paragraph)) -(defun shr-tag-div (cont) +(defun shr-tag-div (dom) (shr-ensure-newline) (shr-indent) - (shr-generic cont) + (shr-generic dom) (shr-ensure-newline)) -(defun shr-tag-s (cont) - (shr-fontize-cont cont 'shr-strike-through)) +(defun shr-tag-s (dom) + (shr-fontize-dom dom 'shr-strike-through)) -(defun shr-tag-del (cont) - (shr-fontize-cont cont 'shr-strike-through)) +(defun shr-tag-del (dom) + (shr-fontize-dom dom 'shr-strike-through)) -(defun shr-tag-b (cont) - (shr-fontize-cont cont 'bold)) +(defun shr-tag-b (dom) + (shr-fontize-dom dom 'bold)) -(defun shr-tag-i (cont) - (shr-fontize-cont cont 'italic)) +(defun shr-tag-i (dom) + (shr-fontize-dom dom 'italic)) -(defun shr-tag-em (cont) - (shr-fontize-cont cont 'italic)) +(defun shr-tag-em (dom) + (shr-fontize-dom dom 'italic)) -(defun shr-tag-strong (cont) - (shr-fontize-cont cont 'bold)) +(defun shr-tag-strong (dom) + (shr-fontize-dom dom 'bold)) -(defun shr-tag-u (cont) - (shr-fontize-cont cont 'underline)) +(defun shr-tag-u (dom) + (shr-fontize-dom dom 'underline)) (defun shr-parse-style (style) (when style @@ -1081,20 +1121,19 @@ ones, in case fg and bg are nil." plist))))) plist))) -(defun shr-tag-base (cont) - (let ((base (cdr (assq :href cont)))) - (when base - (setq shr-base (shr-parse-base base)))) - (shr-generic cont)) +(defun shr-tag-base (dom) + (when-let (base (dom-attr dom 'href)) + (setq shr-base (shr-parse-base base))) + (shr-generic dom)) -(defun shr-tag-a (cont) - (let ((url (cdr (assq :href cont))) - (title (cdr (assq :title cont))) +(defun shr-tag-a (dom) + (let ((url (dom-attr dom 'href)) + (title (dom-attr dom 'title)) (start (point)) shr-start) - (shr-generic cont) + (shr-generic dom) (when (and shr-target-id - (equal (cdr (assq :name cont)) shr-target-id)) + (equal (dom-attr dom 'name) shr-target-id)) ;; We have a zero-length <a name="foo"> element, so just ;; insert... something. (when (= start (point)) @@ -1105,19 +1144,33 @@ ones, in case fg and bg are nil." (not shr-inhibit-decoration)) (shr-urlify (or shr-start start) (shr-expand-url url) title)))) -(defun shr-tag-object (cont) - (let ((start (point)) - url) - (dolist (elem cont) - (when (eq (car elem) 'embed) - (setq url (or url (cdr (assq :src (cdr elem)))))) - (when (and (eq (car elem) 'param) - (equal (cdr (assq :name (cdr elem))) "movie")) - (setq url (or url (cdr (assq :value (cdr elem))))))) - (when url - (shr-insert " [multimedia] ") - (shr-urlify start (shr-expand-url url))) - (shr-generic cont))) +(defun shr-tag-object (dom) + (unless shr-inhibit-images + (let ((start (point)) + url multimedia image) + (when-let (type (dom-attr dom 'type)) + (when (string-match "\\`image/svg" type) + (setq url (dom-attr dom 'data) + image t))) + (dolist (child (dom-non-text-children dom)) + (cond + ((eq (dom-tag child) 'embed) + (setq url (or url (dom-attr child 'src)) + multimedia t)) + ((and (eq (dom-tag child) 'param) + (equal (dom-attr child 'name) "movie")) + (setq url (or url (dom-attr child 'value)) + multimedia t)))) + (when url + (cond + (image + (shr-tag-img dom url) + (setq dom nil)) + (multimedia + (shr-insert " [multimedia] ") + (shr-urlify start (shr-expand-url url))))) + (when dom + (shr-generic dom))))) (defcustom shr-prefer-media-type-alist '(("webm" . 1.0) ("ogv" . 1.0) @@ -1136,10 +1189,10 @@ url if no type is specified. The value should be a float in the range 0.0 to (defun shr--get-media-pref (elem) "Determine the preference for ELEM. The preference is a float determined from `shr-prefer-media-type'." - (let ((type (cdr (assq :type elem))) + (let ((type (dom-attr elem 'type)) (p 0.0)) (unless type - (setq type (cdr (assq :src elem)))) + (setq type (dom-attr elem 'src))) (when type (dolist (pref shr-prefer-media-type-alist) (when (and @@ -1148,61 +1201,61 @@ The preference is a float determined from `shr-prefer-media-type'." (setq p (cdr pref))))) p)) -(defun shr--extract-best-source (cont &optional url pref) - "Extract the best `:src' property from <source> blocks in CONT." +(defun shr--extract-best-source (dom &optional url pref) + "Extract the best `:src' property from <source> blocks in DOM." (setq pref (or pref -1.0)) (let (new-pref) - (dolist (elem cont) - (when (and (eq (car elem) 'source) + (dolist (elem (dom-non-text-children dom)) + (when (and (eq (dom-tag elem) 'source) (< pref (setq new-pref (shr--get-media-pref elem)))) (setq pref new-pref - url (cdr (assq :src elem))) + url (dom-attr elem 'src)) ;; libxml's html parser isn't HTML5 compliant and non terminated ;; source tags might end up as children. So recursion it is... - (dolist (child (cdr elem)) - (when (eq (car child) 'source) + (dolist (child (dom-non-text-children elem)) + (when (eq (dom-tag child) 'source) (let ((ret (shr--extract-best-source (list child) url pref))) (when (< pref (cdr ret)) (setq url (car ret) pref (cdr ret))))))))) (cons url pref)) -(defun shr-tag-video (cont) - (let ((image (cdr (assq :poster cont))) - (url (cdr (assq :src cont))) +(defun shr-tag-video (dom) + (let ((image (dom-attr dom 'poster)) + (url (dom-attr dom 'src)) (start (point))) (unless url - (setq url (car (shr--extract-best-source cont)))) + (setq url (car (shr--extract-best-source dom)))) (if image (shr-tag-img nil image) (shr-insert " [video] ")) (shr-urlify start (shr-expand-url url)))) -(defun shr-tag-audio (cont) - (let ((url (cdr (assq :src cont))) +(defun shr-tag-audio (dom) + (let ((url (dom-attr dom 'src)) (start (point))) (unless url - (setq url (car (shr--extract-best-source cont)))) + (setq url (car (shr--extract-best-source dom)))) (shr-insert " [audio] ") (shr-urlify start (shr-expand-url url)))) -(defun shr-tag-img (cont &optional url) +(defun shr-tag-img (dom &optional url) (when (or url - (and cont - (> (length (cdr (assq :src cont))) 0))) + (and dom + (> (length (dom-attr dom 'src)) 0))) (when (and (> (current-column) 0) (not (eq shr-state 'image))) (insert "\n")) - (let ((alt (cdr (assq :alt cont))) - (url (shr-expand-url (or url (cdr (assq :src cont)))))) + (let ((alt (dom-attr dom 'alt)) + (url (shr-expand-url (or url (dom-attr dom 'src))))) (let ((start (point-marker))) (when (zerop (length alt)) (setq alt "*")) (cond - ((or (member (cdr (assq :height cont)) '("0" "1")) - (member (cdr (assq :width cont)) '("0" "1"))) + ((or (member (dom-attr dom 'height) '("0" "1")) + (member (dom-attr dom 'width) '("0" "1"))) ;; Ignore zero-sized or single-pixel images. ) ((and (not shr-inhibit-images) @@ -1248,52 +1301,51 @@ The preference is a float determined from `shr-prefer-media-type'." (put-text-property start (point) 'image-displayer (shr-image-displayer shr-content-function)) (put-text-property start (point) 'help-echo - (or (cdr (assq :title cont)) - alt))) + (shr-fold-text (or (dom-attr dom 'title) alt)))) (setq shr-state 'image))))) -(defun shr-tag-pre (cont) +(defun shr-tag-pre (dom) (let ((shr-folding-mode 'none)) (shr-ensure-newline) (shr-indent) - (shr-generic cont) + (shr-generic dom) (shr-ensure-newline))) -(defun shr-tag-blockquote (cont) +(defun shr-tag-blockquote (dom) (shr-ensure-paragraph) (shr-indent) (let ((shr-indentation (+ shr-indentation 4))) - (shr-generic cont)) + (shr-generic dom)) (shr-ensure-paragraph)) -(defun shr-tag-dl (cont) +(defun shr-tag-dl (dom) (shr-ensure-paragraph) - (shr-generic cont) + (shr-generic dom) (shr-ensure-paragraph)) -(defun shr-tag-dt (cont) +(defun shr-tag-dt (dom) (shr-ensure-newline) - (shr-generic cont) + (shr-generic dom) (shr-ensure-newline)) -(defun shr-tag-dd (cont) +(defun shr-tag-dd (dom) (shr-ensure-newline) (let ((shr-indentation (+ shr-indentation 4))) - (shr-generic cont))) + (shr-generic dom))) -(defun shr-tag-ul (cont) +(defun shr-tag-ul (dom) (shr-ensure-paragraph) (let ((shr-list-mode 'ul)) - (shr-generic cont)) + (shr-generic dom)) (shr-ensure-paragraph)) -(defun shr-tag-ol (cont) +(defun shr-tag-ol (dom) (shr-ensure-paragraph) (let ((shr-list-mode 1)) - (shr-generic cont)) + (shr-generic dom)) (shr-ensure-paragraph)) -(defun shr-tag-li (cont) +(defun shr-tag-li (dom) (shr-ensure-newline) (shr-indent) (let* ((bullet @@ -1304,9 +1356,9 @@ The preference is a float determined from `shr-prefer-media-type'." shr-bullet)) (shr-indentation (+ shr-indentation (length bullet)))) (insert bullet) - (shr-generic cont))) + (shr-generic dom))) -(defun shr-tag-br (cont) +(defun shr-tag-br (dom) (when (and (not (bobp)) ;; Only add a newline if we break the current line, or ;; the previous line isn't a blank line. @@ -1315,42 +1367,42 @@ The preference is a float determined from `shr-prefer-media-type'." (not (= (char-after (- (point) 2)) ?\n))))) (insert "\n") (shr-indent)) - (shr-generic cont)) + (shr-generic dom)) -(defun shr-tag-span (cont) - (shr-generic cont)) +(defun shr-tag-span (dom) + (shr-generic dom)) -(defun shr-tag-h1 (cont) - (shr-heading cont 'bold 'underline)) +(defun shr-tag-h1 (dom) + (shr-heading dom 'bold 'underline)) -(defun shr-tag-h2 (cont) - (shr-heading cont 'bold)) +(defun shr-tag-h2 (dom) + (shr-heading dom 'bold)) -(defun shr-tag-h3 (cont) - (shr-heading cont 'italic)) +(defun shr-tag-h3 (dom) + (shr-heading dom 'italic)) -(defun shr-tag-h4 (cont) - (shr-heading cont)) +(defun shr-tag-h4 (dom) + (shr-heading dom)) -(defun shr-tag-h5 (cont) - (shr-heading cont)) +(defun shr-tag-h5 (dom) + (shr-heading dom)) -(defun shr-tag-h6 (cont) - (shr-heading cont)) +(defun shr-tag-h6 (dom) + (shr-heading dom)) -(defun shr-tag-hr (_cont) +(defun shr-tag-hr (_dom) (shr-ensure-newline) - (insert (make-string shr-width shr-hr-line) "\n")) + (insert (make-string shr-internal-width shr-hr-line) "\n")) -(defun shr-tag-title (cont) - (shr-heading cont 'bold 'underline)) +(defun shr-tag-title (dom) + (shr-heading dom 'bold 'underline)) -(defun shr-tag-font (cont) +(defun shr-tag-font (dom) (let* ((start (point)) - (color (cdr (assq :color cont))) + (color (dom-attr dom 'color)) (shr-stylesheet (nconc (list (cons 'color color)) shr-stylesheet))) - (shr-generic cont) + (shr-generic dom) (when color (shr-colorize-region start (point) color (cdr (assq 'background-color shr-stylesheet)))))) @@ -1365,23 +1417,22 @@ The preference is a float determined from `shr-prefer-media-type'." ;; main buffer). Now we know how much space each TD really takes, so ;; we then render everything again with the new widths, and finally ;; insert all these boxes into the main buffer. -(defun shr-tag-table-1 (cont) - (setq cont (or (cdr (assq 'tbody cont)) - cont)) +(defun shr-tag-table-1 (dom) + (setq dom (or (dom-child-by-tag dom 'tbody) dom)) (let* ((shr-inhibit-images t) (shr-table-depth (1+ shr-table-depth)) (shr-kinsoku-shorten t) ;; Find all suggested widths. - (columns (shr-column-specs cont)) + (columns (shr-column-specs dom)) ;; Compute how many characters wide each TD should be. (suggested-widths (shr-pro-rate-columns columns)) ;; Do a "test rendering" to see how big each TD is (this can ;; be smaller (if there's little text) or bigger (if there's ;; unbreakable text). - (sketch (shr-make-table cont suggested-widths)) + (sketch (shr-make-table dom suggested-widths)) ;; Compute the "natural" width by setting each column to 500 ;; characters and see how wide they really render. - (natural (shr-make-table cont (make-vector (length columns) 500))) + (natural (shr-make-table dom (make-vector (length columns) 500))) (sketch-widths (shr-table-widths sketch natural suggested-widths))) ;; This probably won't work very well. (when (> (+ (loop for width across sketch-widths @@ -1390,15 +1441,16 @@ The preference is a float determined from `shr-prefer-media-type'." (frame-width)) (setq truncate-lines t)) ;; Then render the table again with these new "hard" widths. - (shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths))) + (shr-insert-table (shr-make-table dom sketch-widths t) sketch-widths))) -(defun shr-tag-table (cont) +(defun shr-tag-table (dom) (shr-ensure-paragraph) - (let* ((caption (cdr (assq 'caption cont))) - (header (cdr (assq 'thead cont))) - (body (or (cdr (assq 'tbody cont)) cont)) - (footer (cdr (assq 'tfoot cont))) - (bgcolor (cdr (assq :bgcolor cont))) + (let* ((caption (dom-children (dom-child-by-tag dom 'caption))) + (header (dom-non-text-children (dom-child-by-tag dom 'thead))) + (body (dom-non-text-children (or (dom-child-by-tag dom 'tbody) + dom))) + (footer (dom-non-text-children (dom-child-by-tag dom 'tfoot))) + (bgcolor (dom-attr dom 'bgcolor)) (start (point)) (shr-stylesheet (nconc (list (cons 'background-color bgcolor)) shr-stylesheet)) @@ -1407,51 +1459,71 @@ The preference is a float determined from `shr-prefer-media-type'." (nfooter (if footer (shr-max-columns footer)))) (if (and (not caption) (not header) - (not (cdr (assq 'tbody cont))) - (not (cdr (assq 'tr cont))) + (not (dom-child-by-tag dom 'tbody)) + (not (dom-child-by-tag dom 'tr)) (not footer)) ;; The table is totally invalid and just contains random junk. ;; Try to output it anyway. - (shr-generic cont) + (shr-generic dom) ;; It's a real table, so render it. (shr-tag-table-1 (nconc - (if caption `((tr (td ,@caption)))) - (if header - (if footer - ;; header + body + footer - (if (= nheader nbody) - (if (= nbody nfooter) - `((tr (td (table (tbody ,@header ,@body ,@footer))))) - (nconc `((tr (td (table (tbody ,@header ,@body))))) - (if (= nfooter 1) - footer - `((tr (td (table (tbody ,@footer)))))))) - (nconc `((tr (td (table (tbody ,@header))))) - (if (= nbody nfooter) - `((tr (td (table (tbody ,@body ,@footer))))) - (nconc `((tr (td (table (tbody ,@body))))) - (if (= nfooter 1) - footer - `((tr (td (table (tbody ,@footer)))))))))) - ;; header + body - (if (= nheader nbody) - `((tr (td (table (tbody ,@header ,@body))))) - (if (= nheader 1) - `(,@header (tr (td (table (tbody ,@body))))) - `((tr (td (table (tbody ,@header)))) - (tr (td (table (tbody ,@body)))))))) - (if footer - ;; body + footer - (if (= nbody nfooter) - `((tr (td (table (tbody ,@body ,@footer))))) - (nconc `((tr (td (table (tbody ,@body))))) - (if (= nfooter 1) - footer - `((tr (td (table (tbody ,@footer)))))))) - (if caption - `((tr (td (table (tbody ,@body))))) - body)))))) + (list 'table nil) + (if caption `((tr nil (td nil ,@caption)))) + (cond (header + (if footer + ;; header + body + footer + (if (= nheader nbody) + (if (= nbody nfooter) + `((tr nil (td nil (table nil + (tbody nil ,@header + ,@body ,@footer))))) + (nconc `((tr nil (td nil (table nil + (tbody nil ,@header + ,@body))))) + (if (= nfooter 1) + footer + `((tr nil (td nil (table + nil (tbody + nil ,@footer)))))))) + (nconc `((tr nil (td nil (table nil (tbody + nil ,@header))))) + (if (= nbody nfooter) + `((tr nil (td nil (table + nil (tbody nil ,@body + ,@footer))))) + (nconc `((tr nil (td nil (table + nil (tbody nil + ,@body))))) + (if (= nfooter 1) + footer + `((tr nil (td nil (table + nil + (tbody + nil + ,@footer)))))))))) + ;; header + body + (if (= nheader nbody) + `((tr nil (td nil (table nil (tbody nil ,@header + ,@body))))) + (if (= nheader 1) + `(,@header (tr nil (td nil (table + nil (tbody nil ,@body))))) + `((tr nil (td nil (table nil (tbody nil ,@header)))) + (tr nil (td nil (table nil (tbody nil ,@body))))))))) + (footer + ;; body + footer + (if (= nbody nfooter) + `((tr nil (td nil (table + nil (tbody nil ,@body ,@footer))))) + (nconc `((tr nil (td nil (table nil (tbody nil ,@body))))) + (if (= nfooter 1) + footer + `((tr nil (td nil (table + nil (tbody nil ,@footer))))))))) + (caption + `((tr nil (td nil (table nil (tbody nil ,@body)))))) + (body))))) (when bgcolor (shr-colorize-region start (point) (cdr (assq 'color shr-stylesheet)) bgcolor)) @@ -1459,17 +1531,10 @@ The preference is a float determined from `shr-prefer-media-type'." ;; model isn't strong enough to allow us to put the images actually ;; into the tables. (when (zerop shr-table-depth) - (dolist (elem (shr-find-elements cont 'img)) - (shr-tag-img (cdr elem)))))) - -(defun shr-find-elements (cont type) - (let (result) - (dolist (elem cont) - (cond ((eq (car elem) type) - (push elem result)) - ((consp (cdr elem)) - (setq result (nconc (shr-find-elements (cdr elem) type) result))))) - (nreverse result))) + (dolist (elem (dom-by-tag dom 'object)) + (shr-tag-object elem)) + (dolist (elem (dom-by-tag dom 'img)) + (shr-tag-img elem))))) (defun shr-insert-table (table widths) (let* ((collapse (equal (cdr (assq 'border-collapse shr-stylesheet)) @@ -1552,22 +1617,22 @@ The preference is a float determined from `shr-prefer-media-type'." (aref widths i)))))))) widths)) -(defun shr-make-table (cont widths &optional fill) - (or (cadr (assoc (list cont widths fill) shr-content-cache)) - (let ((data (shr-make-table-1 cont widths fill))) - (push (list (list cont widths fill) data) +(defun shr-make-table (dom widths &optional fill) + (or (cadr (assoc (list dom widths fill) shr-content-cache)) + (let ((data (shr-make-table-1 dom widths fill))) + (push (list (list dom widths fill) data) shr-content-cache) data))) -(defun shr-make-table-1 (cont widths &optional fill) +(defun shr-make-table-1 (dom widths &optional fill) (let ((trs nil) (shr-inhibit-decoration (not fill)) (rowspans (make-vector (length widths) 0)) width colspan) - (dolist (row cont) - (when (eq (car row) 'tr) + (dolist (row (dom-non-text-children dom)) + (when (eq (dom-tag row) 'tr) (let ((tds nil) - (columns (cdr row)) + (columns (dom-children row)) (i 0) (width-column 0) column) @@ -1581,12 +1646,12 @@ The preference is a float determined from `shr-prefer-media-type'." (pop columns) (aset rowspans i (1- (aref rowspans i))) '(td))) - (when (or (memq (car column) '(td th)) - (not column)) - (when (cdr (assq :rowspan (cdr column))) + (when (and (not (stringp column)) + (or (memq (dom-tag column) '(td th)) + (not column))) + (when-let (span (dom-attr column 'rowspan)) (aset rowspans i (+ (aref rowspans i) - (1- (string-to-number - (cdr (assq :rowspan (cdr column)))))))) + (1- (string-to-number span))))) ;; Sanity check for invalid column-spans. (when (>= width-column (length widths)) (setq width-column 0)) @@ -1595,7 +1660,7 @@ The preference is a float determined from `shr-prefer-media-type'." (aref widths width-column) 10)) (when (and fill - (setq colspan (cdr (assq :colspan (cdr column))))) + (setq colspan (dom-attr column 'colspan))) (setq colspan (min (string-to-number colspan) ;; The colspan may be wrong, so ;; truncate it to the length of the @@ -1610,18 +1675,18 @@ The preference is a float determined from `shr-prefer-media-type'." (setq width-column (+ width-column (1- colspan)))) (when (or column (not fill)) - (push (shr-render-td (cdr column) width fill) + (push (shr-render-td column width fill) tds)) (setq i (1+ i) width-column (1+ width-column)))) (push (nreverse tds) trs)))) (nreverse trs))) -(defun shr-render-td (cont width fill) +(defun shr-render-td (dom width fill) (with-temp-buffer - (let ((bgcolor (cdr (assq :bgcolor cont))) - (fgcolor (cdr (assq :fgcolor cont))) - (style (cdr (assq :style cont))) + (let ((bgcolor (dom-attr dom 'bgcolor)) + (fgcolor (dom-attr dom 'fgcolor)) + (style (dom-attr dom 'style)) (shr-stylesheet shr-stylesheet) actual-colors) (when style @@ -1633,9 +1698,9 @@ The preference is a float determined from `shr-prefer-media-type'." (setq style (nconc (list (cons 'color fgcolor)) style))) (when style (setq shr-stylesheet (append style shr-stylesheet))) - (let ((shr-width width) + (let ((shr-internal-width width) (shr-indentation 0)) - (shr-descend (cons 'td cont))) + (shr-descend dom)) ;; Delete padding at the bottom of the TDs. (delete-region (point) @@ -1656,7 +1721,7 @@ The preference is a float determined from `shr-prefer-media-type'." (if (zerop (buffer-size)) (insert (make-string width ? )) ;; Otherwise, fill the buffer. - (let ((align (cdr (assq :align cont))) + (let ((align (dom-attr dom 'align)) length) (while (not (eobp)) (end-of-line) @@ -1705,19 +1770,21 @@ The preference is a float determined from `shr-prefer-media-type'." (dotimes (i (length columns)) (aset widths i (max (truncate (* (aref columns i) total-percentage - (- shr-width (1+ (length columns))))) + (- shr-internal-width + (1+ (length columns))))) 10))) widths)) ;; Return a summary of the number and shape of the TDs in the table. -(defun shr-column-specs (cont) - (let ((columns (make-vector (shr-max-columns cont) 1))) - (dolist (row cont) - (when (eq (car row) 'tr) +(defun shr-column-specs (dom) + (let ((columns (make-vector (shr-max-columns dom) 1))) + (dolist (row (dom-non-text-children dom)) + (when (eq (dom-tag row) 'tr) (let ((i 0)) - (dolist (column (cdr row)) - (when (memq (car column) '(td th)) - (let ((width (cdr (assq :width (cdr column))))) + (dolist (column (dom-children row)) + (when (and (not (stringp column)) + (memq (dom-tag column) '(td th))) + (let ((width (dom-attr column 'width))) (when (and width (string-match "\\([0-9]+\\)%" width) (not (zerop (setq width (string-to-number @@ -1726,19 +1793,21 @@ The preference is a float determined from `shr-prefer-media-type'." (setq i (1+ i))))))) columns)) -(defun shr-count (cont elem) +(defun shr-count (dom elem) (let ((i 0)) - (dolist (sub cont) - (when (eq (car sub) elem) + (dolist (sub (dom-children dom)) + (when (and (not (stringp sub)) + (eq (dom-tag sub) elem)) (setq i (1+ i)))) i)) -(defun shr-max-columns (cont) +(defun shr-max-columns (dom) (let ((max 0)) - (dolist (row cont) - (when (eq (car row) 'tr) - (setq max (max max (+ (shr-count (cdr row) 'td) - (shr-count (cdr row) 'th)))))) + (dolist (row (dom-children dom)) + (when (and (not (stringp row)) + (eq (dom-tag row) 'tr)) + (setq max (max max (+ (shr-count row 'td) + (shr-count row 'th)))))) max)) (provide 'shr) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 8e65686e353..80a256c8d3b 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -65,6 +65,22 @@ files conditionalize this setup based on the TERM environment variable." :type 'string) ;;;###tramp-autoload +(defcustom tramp-histfile-override "/dev/null" + "When invoking a shell, override the HISTFILE with this value. +By default, the HISTFILE is set to the \"/dev/null\" value, which +is special on Unix systems and indicates the shell history should +not be logged (this avoids clutter due to Tramp commands). + +If you set this variable to nil, however, the *override* is +disabled, so the history will go to the default storage +location, e.g. \"$HOME/.sh_history\"." + :group 'tramp + :version "25.1" + :type '(choice (const :tag "Do not override HISTFILE" nil) + (const :tag "Empty the history (/dev/null)" "/dev/null") + (string :tag "Redirect to a file"))) + +;;;###tramp-autoload (defconst tramp-color-escape-sequence-regexp "\e[[;0-9]+m" "Escape sequences produced by the \"ls\" command.") @@ -2839,16 +2855,27 @@ the result will be a local, non-Tramp, file name." (list (replace-match " \\\\\n" nil nil (cadr args)))) (setq i (+ i 250)))) (cdr args))) + ;; Use a human-friendly prompt, for example for `shell'. + (prompt (format "PS1=%s" + (format "%s %s" + (file-remote-p default-directory) + tramp-initial-end-of-output))) + ;; We use as environment the difference to toplevel + ;; `process-environment'. + env + (env + (dolist + (elt + (cons prompt (nreverse (copy-sequence process-environment))) + env) + (or (member elt (default-toplevel-value 'process-environment)) + (setq env (cons elt env))))) (command (when (stringp program) - (format "cd %s && exec %s env PS1=%s %s" + (format "cd %s && exec %s env %s %s" (tramp-shell-quote-argument localname) (if heredoc (format "<<'%s'" tramp-end-of-heredoc) "") - ;; Use a human-friendly prompt, for example for `shell'. - (tramp-shell-quote-argument - (format "%s %s" - (file-remote-p default-directory) - tramp-initial-end-of-output)) + (mapconcat 'tramp-shell-quote-argument env " ") (if heredoc (format "%s\n(\n%s\n) </dev/tty\n%s" program (car args) tramp-end-of-heredoc) @@ -2935,10 +2962,20 @@ the result will be a local, non-Tramp, file name." (error "Implementation does not handle immediate return")) (with-parsed-tramp-file-name default-directory nil - (let (command input tmpinput stderr tmpstderr outbuf ret) + (let (command env input tmpinput stderr tmpstderr outbuf ret) ;; Compute command. (setq command (mapconcat 'tramp-shell-quote-argument (cons program args) " ")) + ;; We use as environment the difference to toplevel `process-environment'. + (setq env + (dolist (elt (nreverse (copy-sequence process-environment)) env) + (or (member elt (default-toplevel-value 'process-environment)) + (setq env (cons elt env))))) + (when env + (setq command + (format + "env %s %s" + (mapconcat 'tramp-shell-quote-argument env " ") command))) ;; Determine input. (if (null infile) (setq input "/dev/null") @@ -3865,7 +3902,10 @@ file exists and nonzero exit status otherwise." ;; the prompt in /bin/bash, it must be discarded as well. (tramp-send-command vec (format - "exec env ENV='' HISTFILE=/dev/null PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s" + "exec env ENV=''%s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s" + (if tramp-histfile-override + (concat " HISTFILE=" tramp-histfile-override) + "") (tramp-shell-quote-argument tramp-end-of-output) shell (or extra-args "")) t)) @@ -4587,7 +4627,8 @@ connection if a previous connection has died for some reason." (delete-process p)) (setenv "TERM" tramp-terminal-type) (setenv "LC_ALL" "en_US.utf8") - (setenv "HISTFILE" "/dev/null") + (when tramp-histfile-override + (setenv "HISTFILE" tramp-histfile-override)) (setenv "PROMPT_COMMAND") (setenv "PS1" tramp-initial-end-of-output) (let* ((target-alist (tramp-compute-multi-hops vec)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 3afb487ec3d..ba0d13eab8b 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3228,7 +3228,7 @@ User is always nil." t))) (defun tramp-handle-make-symbolic-link - (filename linkname &optional ok-if-already-exists) + (filename linkname &optional _ok-if-already-exists) "Like `make-symbolic-link' for Tramp files." (with-parsed-tramp-file-name (if (tramp-tramp-file-p filename) filename linkname) nil diff --git a/lisp/newcomment.el b/lisp/newcomment.el index b9e75f16d90..e307eac94eb 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -1390,22 +1390,12 @@ unless optional argument SOFT is non-nil." ;; If we're not inside a comment, just try to indent. ((not compos) (indent-according-to-mode)) (t - (let* ((comment-column - ;; The continuation indentation should be somewhere between - ;; the current line's indentation (plus 2 for good measure) - ;; and the current comment's indentation, with a preference - ;; for comment-column. - (save-excursion - ;; FIXME: use prev line's info rather than first line's. - (goto-char compos) - (min (current-column) (max comment-column - (+ 2 (current-indentation)))))) - (comstart (buffer-substring compos comin)) + (let* ((comstart (buffer-substring compos comin)) (normalp (string-match (regexp-quote (comment-string-strip comment-start t t)) comstart)) - (comment-end + (comend (if normalp comment-end ;; The comment starter is not the normal comment-start ;; so we can't just use comment-end. @@ -1416,19 +1406,42 @@ unless optional argument SOFT is non-nil." (buffer-substring (save-excursion (comment-enter-backward) (point)) (point)) - nil t))))) - (comment-start comstart) - (continuep (or comment-multi-line - (cadr (assoc comment-style comment-styles)))) - ;; Force comment-continue to be recreated from comment-start. - ;; FIXME: wrong if comment-continue was set explicitly! - ;; FIXME: use prev line's continuation if available. - (comment-continue nil)) - (if (and comment-multi-line (> (length comment-end) 0)) + nil t)))))) + (if (and comment-multi-line (> (length comend) 0)) (indent-according-to-mode) (insert-and-inherit ?\n) (forward-char -1) - (comment-indent continuep) + (let* ((comment-column + ;; The continuation indentation should be somewhere + ;; between the current line's indentation (plus 2 for + ;; good measure) and the current comment's indentation, + ;; with a preference for comment-column. + (save-excursion + ;; FIXME: use prev line's info rather than first + ;; line's. + (goto-char compos) + (min (current-column) + (max comment-column + (+ 2 (current-indentation)))))) + (comment-indent-function + ;; If the previous comment is on its own line, then + ;; reuse its indentation unconditionally. + ;; Important for modes like Python/Haskell where + ;; auto-indentation is unreliable. + (if (save-excursion (goto-char compos) + (skip-chars-backward " \t") + (bolp)) + (lambda () comment-column) comment-indent-function)) + (comment-start comstart) + (comment-end comend) + (continuep (or comment-multi-line + (cadr (assoc comment-style + comment-styles)))) + ;; Recreate comment-continue from comment-start. + ;; FIXME: wrong if comment-continue was set explicitly! + ;; FIXME: use prev line's continuation if available. + (comment-continue nil)) + (comment-indent continuep)) (save-excursion (let ((pt (point))) (end-of-line) diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index f489404a9cb..6c5c85b2fcc 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -449,6 +449,9 @@ reference.") (when rng-validate-mode (rng-validate-while-idle (current-buffer))))) +(defvar tildify-space-string) +(defvar tildify-foreach-region-function) + ;;;###autoload (define-derived-mode nxml-mode text-mode "nXML" ;; We use C-c C-i instead of \\[nxml-balanced-close-start-tag-inline] @@ -505,6 +508,19 @@ be treated as a single markup item, set the variable Many aspects this mode can be customized using \\[customize-group] nxml RET." ;; (kill-all-local-variables) + ;; If encoding does not allow non-break space character, use reference. + ;; FIXME: This duplicates code from sgml-mode, perhaps derive from it? + ;; FIXME: Perhaps use if possible (e.g. XHTML)? + (setq-local tildify-space-string + (if (equal (decode-coding-string + (encode-coding-string " " buffer-file-coding-system) + buffer-file-coding-system) " ") + " " " ")) + ;; FIXME: Use the fact that we're parsing the document already + ;; rather than using regex-based filtering. + (setq-local tildify-foreach-region-function + (apply-partially 'tildify-foreach-ignore-environments + '(("<! *--" . "-- *>") ("<" . ">")))) (set (make-local-variable 'mode-line-process) '((nxml-degraded "/degraded"))) ;; We'll determine the fill prefix ourselves (make-local-variable 'adaptive-fill-mode) @@ -2567,7 +2583,7 @@ With a prefix argument, inserts the character directly." (> (prefix-numeric-value arg) 0)))) (when (not (eq new nxml-char-ref-extra-display)) (setq nxml-char-ref-extra-display new) - (font-lock-fontify-buffer)))) + (font-lock-flush)))) (put 'nxml-char-ref 'evaporate t) diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el index ae039a5910c..e95ad08d1bd 100644 --- a/lisp/nxml/rng-uri.el +++ b/lisp/nxml/rng-uri.el @@ -85,7 +85,7 @@ Signal an error if URI is not a valid file URL." ((not (string= (downcase scheme) "file")) (rng-uri-error "URI `%s' does not use the `file:' scheme" uri))) (when (not (member authority - (cons system-name '(nil "" "localhost")))) + (cons (system-name) '(nil "" "localhost")))) (rng-uri-error "URI `%s' does not start with `file:///' or `file://localhost/'" uri)) (when query diff --git a/lisp/obsolete/cl-compat.el b/lisp/obsolete/cl-compat.el index 9dd9cc3f32d..d6918da3e56 100644 --- a/lisp/obsolete/cl-compat.el +++ b/lisp/obsolete/cl-compat.el @@ -129,14 +129,6 @@ (if test-not (not (funcall test-not item elt)) (funcall (or test 'eql) item elt)))) - -;;; Rounding functions with old-style multiple value returns. - -(defun cl-floor (a &optional b) (Values-list (floor* a b))) -(defun cl-ceiling (a &optional b) (Values-list (ceiling* a b))) -(defun cl-round (a &optional b) (Values-list (round* a b))) -(defun cl-truncate (a &optional b) (Values-list (truncate* a b))) - (defun safe-idiv (a b) (let* ((q (/ (abs a) (abs b))) (s (* (signum a) (signum b)))) diff --git a/lisp/emacs-lisp/gulp.el b/lisp/obsolete/gulp.el index ccefc094127..5ff99f2df55 100644 --- a/lisp/emacs-lisp/gulp.el +++ b/lisp/obsolete/gulp.el @@ -5,6 +5,7 @@ ;; Author: Sam Shteingold <shteingd@math.ucla.edu> ;; Maintainer: emacs-devel@gnu.org ;; Keywords: maint +;; Obsolete-since: 25.1 ;; This file is part of GNU Emacs. @@ -136,7 +137,7 @@ is left in the `*gulp*' buffer at the end." "Create the maintainer/package alist for files in FLIST in DIR. That is a list of elements, each of the form (MAINTAINER PACKAGES...)." (save-excursion - (let (mplist filen node mnt-tm mnt tm fl-tm) + (let (mplist filen node mnt tm fl-tm) (get-buffer-create gulp-tmp-buffer) (set-buffer gulp-tmp-buffer) (setq buffer-undo-list t) diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el index 4b00c17edf6..6b1e5347e21 100644 --- a/lisp/obsolete/iswitchb.el +++ b/lisp/obsolete/iswitchb.el @@ -1416,9 +1416,6 @@ See the variable `iswitchb-case' for details." (isearch-no-upper-case-p iswitchb-text) (isearch-no-upper-case-p iswitchb-text t)))) -;; NB obsolete/ is not scanned for autoloads. -;; If you change any of the following doc, copy the changes to simple.el. - ;;;###autoload (define-minor-mode iswitchb-mode "Toggle Iswitchb mode. @@ -1433,10 +1430,6 @@ between buffers using substrings. See `iswitchb' for details." (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup) (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))) -;;;###autoload -(make-obsolete 'iswitchb-mode - "use `icomplete-mode' or `ido-mode' instead." "24.4") - (provide 'iswitchb) ;;; iswitchb.el ends here diff --git a/lisp/obsolete/lucid.el b/lisp/obsolete/lucid.el index d88ae4700db..569abb60870 100644 --- a/lisp/obsolete/lucid.el +++ b/lisp/obsolete/lucid.el @@ -30,27 +30,6 @@ (defalias 'current-time-seconds 'current-time) -(defun read-number (prompt &optional integers-only) - "Read a number from the minibuffer. -Keep reentering the minibuffer until we get suitable input. -If optional argument INTEGERS-ONLY is non-nil, insist on an integer." - (interactive) - (let (success - (number nil) - (predicate (if integers-only 'integerp 'numberp))) - (while (not success) - (let ((input-string (read-string prompt))) - (condition-case () - (setq number (read input-string)) - (error)) - (if (funcall predicate number) - (setq success t) - (let ((cursor-in-echo-area t)) - (message "Please type %s" - (if integers-only "an integer" "a number")) - (sit-for 1))))) - number)) - (defun real-path-name (name &optional default) (file-truename (expand-file-name name default))) diff --git a/lisp/obsolete/mailpost.el b/lisp/obsolete/mailpost.el index 880780c577c..bcd468c2b06 100644 --- a/lisp/obsolete/mailpost.el +++ b/lisp/obsolete/mailpost.el @@ -75,12 +75,7 @@ site-init." (if mail-interactive (with-current-buffer errbuf (erase-buffer)))) - (let ((m (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes 384) - (setq temfile (make-temp-file ",rpost"))) - (set-default-file-modes m))) + (with-file-modes 384 (setq temfile (make-temp-file ",rpost"))) (apply 'call-process (append (list (if (boundp 'post-mail-program) post-mail-program diff --git a/lisp/obsolete/mouse-sel.el b/lisp/obsolete/mouse-sel.el index 074d712d131..25eb3e66a65 100644 --- a/lisp/obsolete/mouse-sel.el +++ b/lisp/obsolete/mouse-sel.el @@ -97,8 +97,8 @@ ;; In this mode, mouse-insert-selection just calls mouse-yank-at-click. ;; ;; Selection/kill-ring interaction is retained -;; interprogram-cut-function = x-select-text -;; interprogram-paste-function = x-selection-value +;; interprogram-cut-function = gui-select-text +;; interprogram-paste-function = gui-selection-value ;; ;; What you lose is the ability to select some text in ;; delete-selection-mode and yank over the top of it. @@ -190,12 +190,9 @@ If nil, point will always be placed at the beginning of the region." ;;=== User Command ======================================================== -(defvar mouse-sel-has-been-enabled nil - "Non-nil if Mouse Sel mode has been enabled at least once.") - (defvar mouse-sel-original-bindings nil) -(defvar mouse-sel-original-interprogram-cut-function nil) -(defvar mouse-sel-original-interprogram-paste-function nil) + +(defalias 'mouse-sel--ignore #'ignore) ;;;###autoload (define-minor-mode mouse-sel-mode @@ -242,14 +239,11 @@ kill ring; mouse-1 or mouse-3 kills it." (global-set-key event (cdr binding))))) mouse-sel-bound-events)) ;; Update interprogram functions. - (setq mouse-sel-original-interprogram-cut-function - interprogram-cut-function - mouse-sel-original-interprogram-paste-function - interprogram-paste-function - mouse-sel-has-been-enabled t) (unless (eq mouse-sel-default-bindings 'interprogram-cut-paste) - (setq interprogram-cut-function nil - interprogram-paste-function nil)))) + (add-function :override interprogram-cut-function + #'mouse-sel--ignore) + (add-function :override interprogram-paste-function + #'mouse-sel--ignore)))) ;; Restore original bindings (remove-hook 'x-lost-selection-functions 'mouse-sel-lost-selection-hook) @@ -257,11 +251,8 @@ kill ring; mouse-1 or mouse-3 kills it." (global-set-key (car binding) (cdr binding))) ;; Restore the old values of these variables, ;; only if they were actually saved previously. - (if mouse-sel-has-been-enabled - (setq interprogram-cut-function - mouse-sel-original-interprogram-cut-function - interprogram-paste-function - mouse-sel-original-interprogram-paste-function)))) + (remove-function interprogram-cut-function #'mouse-sel--ignore) + (remove-function interprogram-paste-function #'mouse-sel--ignore))) (make-obsolete 'mouse-sel-mode "use the normal mouse modes" "24.3") @@ -301,15 +292,13 @@ where SELECTION-NAME = name of selection SELECTION-THING-SYMBOL = name of variable where the current selection type for this selection should be stored.") -(declare-function x-select-text "term/common-win" (text)) - (defvar mouse-sel-set-selection-function (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) - 'x-set-selection + 'gui-set-selection (lambda (selection value) (if (eq selection 'PRIMARY) - (x-select-text value) - (x-set-selection selection value)))) + (gui-select-text value) + (gui-set-selection selection value)))) "Function to call to set selection. Called with two arguments: @@ -319,14 +308,13 @@ Called with two arguments: This sets the selection, unless `mouse-sel-default-bindings' is `interprogram-cut-paste'.") -(declare-function x-selection-value "term/x-win" ()) (defvar mouse-sel-get-selection-function (lambda (selection) (if (eq selection 'PRIMARY) - (or (x-selection-value) - (bound-and-true-p x-last-selected-text) - (bound-and-true-p x-last-selected-text-primary)) + (or (gui-selection-value) + (bound-and-true-p x-last-selected-text-primary) + gui-last-selected-text) (x-get-selection selection))) "Function to call to get the selection. Called with one argument: diff --git a/lisp/obsolete/pc-select.el b/lisp/obsolete/pc-select.el index 3a37ac0ddfc..371c33848a5 100644 --- a/lisp/obsolete/pc-select.el +++ b/lisp/obsolete/pc-select.el @@ -337,7 +337,7 @@ but before calling PC Selection mode): (cadr pc-select-meta-moves-sexps-key-bindings)) (if (or pc-select-selection-keys-only (eq window-system 'x) - (memq system-name '(ms-dos windows-nt))) + (memq system-type '(ms-dos windows-nt))) nil pc-select-tty-key-bindings))) @@ -346,7 +346,7 @@ but before calling PC Selection mode): (unless (or pc-select-selection-keys-only (eq window-system 'x) - (memq system-name '(ms-dos windows-nt))) + (memq system-type '(ms-dos windows-nt))) ;; it is not clear that we need the following line ;; I hope it doesn't do too much harm to leave it in, though... (setq pc-select-old-M-delete-binding @@ -355,7 +355,7 @@ but before calling PC Selection mode): (when (and (not pc-select-selection-keys-only) (or (eq window-system 'x) - (memq system-name '(ms-dos windows-nt))) + (memq system-type '(ms-dos windows-nt))) (fboundp 'normal-erase-is-backspace-mode)) (pc-select-save-and-set-mode normal-erase-is-backspace-mode 1 normal-erase-is-backspace)) @@ -378,24 +378,24 @@ but before calling PC Selection mode): (current-global-map)) (unless (or pc-select-selection-keys-only (eq window-system 'x) - (memq system-name '(ms-dos windows-nt))) + (memq system-type '(ms-dos windows-nt))) ;; it is not clear that we need the following line ;; I hope it doesn't do too much harm to leave it in, though... (define-key function-key-map [M-delete] [?\M-d])) (when (and (not pc-select-selection-keys-only) (or (eq window-system 'x) - (memq system-name '(ms-dos windows-nt))) + (memq system-type '(ms-dos windows-nt))) (fboundp 'normal-erase-is-backspace-mode)) (normal-erase-is-backspace-mode 1)) (setq highlight-nonselected-windows nil) - (setq transient-mark-mode t) + (transient-mark-mode 1) (setq mark-even-if-inactive t) (delete-selection-mode 1)) ;;else (when pc-select-key-bindings-alist (when (and (not pc-select-selection-keys-only) (or (eq window-system 'x) - (memq system-name '(ms-dos windows-nt)))) + (memq system-type '(ms-dos windows-nt)))) (pc-select-restore-mode normal-erase-is-backspace-mode)) (pc-select-restore-keys diff --git a/lisp/obsolete/pgg-pgp.el b/lisp/obsolete/pgg-pgp.el index b7963727cdc..af2b2aa7aed 100644 --- a/lisp/obsolete/pgg-pgp.el +++ b/lisp/obsolete/pgg-pgp.el @@ -202,15 +202,11 @@ passphrase cache or user." (defun pgg-pgp-verify-region (start end &optional signature) "Verify region between START and END as the detached signature SIGNATURE." (let* ((orig-file (pgg-make-temp-file "pgg")) - (args "+verbose=1 +batchmode +language=us") - (orig-mode (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes 448) - (let ((coding-system-for-write 'binary) - jka-compr-compression-info-list jam-zcat-filename-list) - (write-region start end orig-file))) - (set-default-file-modes orig-mode)) + (args "+verbose=1 +batchmode +language=us")) + (with-file-modes 448 + (let ((coding-system-for-write 'binary) + jka-compr-compression-info-list jam-zcat-filename-list) + (write-region start end orig-file))) (if (stringp signature) (progn (copy-file signature (setq signature (concat orig-file ".asc"))) diff --git a/lisp/obsolete/pgg-pgp5.el b/lisp/obsolete/pgg-pgp5.el index bf1543c2fa5..97caedbe5b3 100644 --- a/lisp/obsolete/pgg-pgp5.el +++ b/lisp/obsolete/pgg-pgp5.el @@ -208,15 +208,11 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." (defun pgg-pgp5-verify-region (start end &optional signature) "Verify region between START and END as the detached signature SIGNATURE." (let ((orig-file (pgg-make-temp-file "pgg")) - (args '("+verbose=1" "+batchmode=1" "+language=us")) - (orig-mode (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes 448) - (let ((coding-system-for-write 'binary) - jka-compr-compression-info-list jam-zcat-filename-list) - (write-region start end orig-file))) - (set-default-file-modes orig-mode)) + (args '("+verbose=1" "+batchmode=1" "+language=us"))) + (with-file-modes 448 + (let ((coding-system-for-write 'binary) + jka-compr-compression-info-list jam-zcat-filename-list) + (write-region start end orig-file))) (when (stringp signature) (copy-file signature (setq signature (concat orig-file ".asc"))) (setq args (append args (list signature)))) diff --git a/lisp/vc/vc-arch.el b/lisp/obsolete/vc-arch.el index c7c1eb51596..2469f761a91 100644 --- a/lisp/vc/vc-arch.el +++ b/lisp/obsolete/vc-arch.el @@ -231,8 +231,7 @@ Only the value `maybe' can be trusted :-(." "Return the administrative directory of FILE." (expand-file-name "{arch}" (vc-arch-root file))) -(defun vc-arch-register (files &optional rev _comment) - (if rev (error "Explicit initial revision not supported for Arch")) +(defun vc-arch-register (files &optional _comment) (dolist (file files) (let ((tagmet (vc-arch-tagging-method file))) (if (and (memq tagmet '(tagline implicit)) comment-start) @@ -262,10 +261,6 @@ Only the value `maybe' can be trusted :-(." ;; Strip the terminating newline. (buffer-substring (point-min) (1- (point-max))))))))) -(defun vc-arch-workfile-unchanged-p (_file) - "Stub: arch workfiles are always considered to be in a changed state," - nil) - (defun vc-arch-state (file) ;; There's no checkout operation and merging is not done from VC ;; so the only operation that's state dependent that VC supports is commit @@ -315,10 +310,11 @@ Only the value `maybe' can be trusted :-(." 'up-to-date 'edited))))))))) -;; -dir-status called from vc-dir, which loads vc, which loads vc-dispatcher. +;; dir-status-files called from vc-dir, which loads vc, +;; which loads vc-dispatcher. (declare-function vc-exec-after "vc-dispatcher" (code)) -(defun vc-arch-dir-status (dir callback) +(defun vc-arch-dir-status-files (dir _files callback) "Run 'tla inventory' for DIR and pass results to CALLBACK. CALLBACK expects (ENTRIES &optional MORE-TO-COME); see `vc-dir-refresh'." @@ -441,8 +437,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see (autoload 'vc-switches "vc") -(defun vc-arch-checkin (files rev comment) - (if rev (error "Committing to a specific revision is unsupported")) +(defun vc-arch-checkin (files comment) ;; FIXME: This implementation probably only works for singleton filesets (let ((summary (file-relative-name (car files) (vc-arch-root (car files))))) ;; Extract a summary from the comment. @@ -453,7 +448,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see (vc-arch-command nil 0 files "commit" "-s" summary "-L" comment "--" (vc-switches 'Arch 'checkin)))) -(defun vc-arch-diff (files &optional oldvers newvers buffer) +(defun vc-arch-diff (files &optional oldvers newvers buffer async) "Get a difference report using Arch between two versions of FILES." ;; FIXME: This implementation only works for singleton filesets. To make ;; it work for more cases, we have to either call `file-diffs' manually on @@ -470,7 +465,6 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see (if newvers (error "Diffing specific revisions not implemented") (let* (process-file-side-effects - (async (not vc-disable-async-diff)) ;; Run the command from the root dir. (default-directory (vc-arch-root file)) (status @@ -497,8 +491,6 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see "A wrapper around `vc-do-command' for use in vc-arch.el." (apply 'vc-do-command (or buffer "*vc*") okstatus vc-arch-program file flags)) -(defun vc-arch-init-revision () nil) - ;;; Completion of versions and revisions. (defun vc-arch--version-completion-table (root string) diff --git a/lisp/obsolete/vi.el b/lisp/obsolete/vi.el index bb57735b0a9..fbdf7a1e920 100644 --- a/lisp/obsolete/vi.el +++ b/lisp/obsolete/vi.el @@ -1200,7 +1200,7 @@ SPECIAL FEATURE: char argument can be used to specify shift amount(1-9)." (let ((aelt (assq char vi-mark-alist))) (if aelt (move-marker (cdr aelt) (point)) ; fixed 6/12/86 - (setq aelt (cons char (copy-marker (point)))) + (setq aelt (cons char (point-marker))) (setq vi-mark-alist (cons aelt vi-mark-alist)))))) (defun vi-find-matching-paren () diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index b75f2baa1f3..081da5db73b 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -1,11 +1,36 @@ +2014-12-29 Paul Eggert <eggert@cs.ucla.edu> + + * org-clock.el (org-clock-save): Prefer (system-name) to system-name. + +2014-10-29 Paul Eggert <eggert@cs.ucla.edu> + + Simplify use of current-time and friends. + * org-archive.el (org-archive-subtree) + (org-archive-to-archive-sibling): + * org-clock.el (org-resolve-clocks, org-clock-get-sum-start) + (org-clock-special-range): + * org-timer.el (org-timer-seconds): + * org.el (org-read-date-analyze, org-get-cursor-date): + * ox-html.el (org-html-format-spec): + * ox-icalendar.el (org-icalendar--vtodo): + Omit unnecessary call to current-time. + * org-clock.el (org-clock-get-table-data): Omit unnecessary, lossy + conversion from floating point to Emacs time and back. + (org-resolve-clocks): Prefer two-argument floor. + * org-compat.el (org-float-time): Simplify to an alias because + time-to-seconds now behaves like float-time with respect to nil arg. + * org.el (org-get-cursor-date): + Don't call current-time twice to get the current time stamp, + as this can lead to inconsistent results. + 2014-10-20 Glenn Morris <rgm@gnu.org> - * Version 24.4 released. + * Merge in all changes up to 24.4 release. 2014-10-12 Marco Wahl <marcowahlsoft@gmail.com> - * org-agenda.el (org-get-entries-from-diary): Use - `diary-fancy-display' instead of the obsolete + * org-agenda.el (org-get-entries-from-diary): + Use `diary-fancy-display' instead of the obsolete `diary-display-hook'. 2014-10-12 Nicolas Goaziou <mail@nicolasgoaziou.fr> @@ -14,13 +39,11 @@ expressions. * ox-publish.el (org-publish, org-publish-all) - (org-publish-current-file): Replace `ignore', per limit stated - above. + (org-publish-current-file): Replace `ignore', per limit stated above. 2014-10-12 Christopher Schmidt <ch@ristopher.com> - * org.el (orgstruct-make-binding): Do not use loop in interpreted - code. + * org.el (orgstruct-make-binding): Do not use loop in interpreted code. 2014-10-12 Mike McLean <mike.mclean@pobox.com> (tiny change) @@ -28,10 +51,9 @@ 2014-10-12 Nicolas Goaziou <mail@nicolasgoaziou.fr> - * ox.el (org-export-async-start): Allow to use symbols as - function. + * ox.el (org-export-async-start): Allow to use symbols as function. -2014-10-02 Achim Gratz <Stromeko@Stromeko.DE> +2014-10-03 Achim Gratz <Stromeko@Stromeko.DE> * ob-sh.el (org-babel-sh-initiate-session): After initiating a session, initialize the marker `comint-last-output-start' since it @@ -78,12 +100,12 @@ returns nil, do not run make-directory. Remove superfluous when clauses by using short-circuiting `and' instead. -2014-10-02 Alex Kosorukoff <alex@3form.com> (tiny change) +2014-10-03 Alex Kosorukoff <alex@3form.com> (tiny change) * org-capture.el (org-capture-fill-template): Set `mark-active' to nil. -2014-10-02 Bastien Guerry <bzg@gnu.org> +2014-10-03 Bastien Guerry <bzg@gnu.org> * org-agenda.el (org-agenda-prepare): Reset preset filters when using sticky agendas. @@ -91,8 +113,8 @@ * org-agenda.el (org-agenda-get-sexps): Don't add tags as text properties. - * org-capture.el (org-capture-fill-template): Take - `org-extend-today-until' into account when setting the format time + * org-capture.el (org-capture-fill-template): + Take `org-extend-today-until' into account when setting the format time string. * org.el (org-paste-subtree): Fix match subexpression. @@ -117,8 +139,8 @@ (org-agenda-tag-filter-while-redo): Delete. (org-agenda-list, org-agenda-redo, org-agenda-filter-by-tag): Remove unused code. - (org-agenda-clockreport-mode, org-agenda-set-mode-name): Don't - consider tag filters. + (org-agenda-clockreport-mode, org-agenda-set-mode-name): + Don't consider tag filters. * org.el (org-fix-ellipsis-at-bol) (org-first-headline-recenter): Use `set-window-start' instead @@ -139,8 +161,8 @@ * org.el (org-overview): Don't call `recenter'. - * org-agenda.el (org-agenda-custom-commands-local-options): Fix - misquoted values. + * org-agenda.el (org-agenda-custom-commands-local-options): + Fix misquoted values. * org.el (org-property-re): Also match null properties by default. (org-entry-delete): Also delete null properties. @@ -148,8 +170,8 @@ (org-delete-property): Throw a message when there is not property to delete. - * org-agenda.el (org-agenda-insert-diary-make-new-entry): Fix - docstring. + * org-agenda.el (org-agenda-insert-diary-make-new-entry): + Fix docstring. * org.el (org-re-property): New parameter `allow-null' to match property with a null value. @@ -176,8 +198,8 @@ `buffer-invisibility-spec'. * org-agenda.el (org-agenda-mode): Add buffer invisibility specs. - (org-agenda-filter-hide-line, org-agenda-remove-filter): Set - the 'invisible text property to 'org-filtered. + (org-agenda-filter-hide-line, org-agenda-remove-filter): + Set the 'invisible text property to 'org-filtered. (org-agenda-show-new-time): Add the default face to avoid the foreground of the last character on the line to leak into the timestamp notification. @@ -197,8 +219,8 @@ of `outline-end-of-subtree'. (outline-end-of-subtree): Remove advice. - * org-mouse.el (org-mouse-move-tree, org-mouse-do-remotely): Use - `org-end-of-subtree' instead of `outline-end-of-subtree'. + * org-mouse.el (org-mouse-move-tree, org-mouse-do-remotely): + Use `org-end-of-subtree' instead of `outline-end-of-subtree'. * org-agenda.el (org-cmp-ts): Argument `type' is not optional. Don't quote it. @@ -206,8 +228,8 @@ * org-habit.el (org-habit-insert-consistency-graphs): Don't remove filter overlays as we don't use overlays for filters anymore. - * org-agenda.el (org-agenda-local-vars): Add - `org-agenda-top-headline-filter'. + * org-agenda.el (org-agenda-local-vars): + Add `org-agenda-top-headline-filter'. (org-agenda-filter-by-category): Fix syntax. (org-agenda-filter-show-all-top-filter): New function. (org-agenda-filter-by-top-headline) @@ -248,8 +270,8 @@ * org-table.el (org-table-eval-formula): Fix conversion of inactive timestamps to active ones. - * org.el (org-set-regexps-and-options): Allow - `org-complex-heading-regexp-format' to match [/] and [%] cookies + * org.el (org-set-regexps-and-options): + Allow `org-complex-heading-regexp-format' to match [/] and [%] cookies when they are both before and after the heading. * org-agenda.el (org-agenda-max-todos, org-agenda-max-tags) @@ -261,37 +283,37 @@ * org-agenda.el (org-agenda-finalize): Filter by top headline if `org-agenda-top-headline-filter' is set. -2014-10-02 Bernt Hansen <bernt@norang.ca> +2014-10-03 Bernt Hansen <bernt@norang.ca> * org-macs.el: Remove restriction when locating markers. -2014-10-02 Dmitry Gorbik <dgorbik@me.com> (tiny change) +2014-10-03 Dmitry Gorbik <dgorbik@me.com> (tiny change) * org.el (org-fast-tag-selection): Fix window splitting. -2014-10-02 Eric Schulte <schulte.eric@gmail.com> +2014-10-03 Eric Schulte <schulte.eric@gmail.com> * ob-screen.el (org-babel-screen-test): Use unpredictable name for temporary file. - * ob-screen.el (org-babel-screen-session-write-temp-file): Use - unpredictable temp file name, fixes bug#17416. + * ob-screen.el (org-babel-screen-session-write-temp-file): + Use unpredictable temp file name, fixes bug#17416. -2014-10-02 Ian Kelling <ian@iankelling.org> +2014-10-03 Ian Kelling <ian@iankelling.org> * ob-core.el (org-babel-insert-result): Test all list elements against listp and (eq element 'hline) instead of checking just the first. -2014-10-02 Konstantin Kliakhandler <kosta@slumpy.org> (tiny change) +2014-10-03 Konstantin Kliakhandler <kosta@slumpy.org> (tiny change) * org-agenda.el (org-agenda-redo): Reapply the filters correctly. -2014-10-02 Kyle Meyer <kyle@kyleam.com> (tiny change) +2014-10-03 Kyle Meyer <kyle@kyleam.com> (tiny change) * ox.el (org-export-show-temporary-export-buffer): Fix typo. -2014-10-02 Matt Lundin <mdl@imapmail.org> +2014-10-03 Matt Lundin <mdl@imapmail.org> * ox-publish.el (org-publish-find-title, org-publish-find-date): Make sure to call org-export-get-environment in copy of buffer if @@ -304,7 +326,7 @@ * ox-publish.el (org-publish-find-title, org-publish-find-date): Fix unnecessary invocations of org-mode with org-inhibit-startup. -2014-10-02 Nick Dokos <ndokos@gmail.com> +2014-10-03 Nick Dokos <ndokos@gmail.com> * org-table.el (org-table-clean-before-export): The regexes match spaces in addition to the special characters that might be used in @@ -314,13 +336,13 @@ * ox-ascii.el (org-ascii-superscript): Change _ to ^ in the output. -2014-10-02 Nick Dokos <ndokos@redhat.com> +2014-10-03 Nick Dokos <ndokos@redhat.com> * org-table.el (org-table-show-reference): Call `set-window-start' with the calculated values `min' and `max', not with (point-min) and (point-max). -2014-10-02 Nicolas Goaziou <n.goaziou@gmail.com> +2014-10-03 Nicolas Goaziou <n.goaziou@gmail.com> * ox-latex.el (org-latex-link): Improve test for unnumbered headlines. @@ -369,8 +391,8 @@ * org-agenda.el (org-agenda-write): Write headings in proper order. - * org-element.el (org-element-table-interpreter): Enhance - docstring. + * org-element.el (org-element-table-interpreter): + Enhance docstring. * ox-md.el (org-md-link): Allow custom link type export function. @@ -392,8 +414,8 @@ empty. Refactoring. (org-texinfo-src-block): Refactor code. Comply to predicate naming. - * ox-texinfo.el (org-texinfo--sanitize-node): Handle - " (not)allowed" case. + * ox-texinfo.el (org-texinfo--sanitize-node): + Handle " (not)allowed" case. * ox-texinfo.el (org-texinfo-headline): Remove wrong code comments. @@ -416,8 +438,8 @@ * ox-texinfo.el (org-texinfo--sanitize-node): "@", "{" and "}" characters are allowed in a node name. So are "(" and ")" unless - "(" starts the name and there is ")" somewhere in the name. Also - trim and collapse whitespace characters. Renamed from + "(" starts the name and there is ")" somewhere in the name. + Also trim and collapse whitespace characters. Renamed from `org-texinfo--sanitize-menu'. (org-texinfo--get-node): Do not sanitize node names over zealously. Ensure returned node names are unique. @@ -429,17 +451,17 @@ * ox-texinfo.el (org-texinfo--normalize-headlines): Make sure a blank line always follows nodes. - * ox-texinfo.el (org-texinfo-make-menu): Change signature. Remove - some intermediate functions. Generate the full master menu when + * ox-texinfo.el (org-texinfo-make-menu): Change signature. + Remove some intermediate functions. Generate the full master menu when asked. (org-texinfo--build-menu): Use a simpler algorithm. (org-texinfo--format-entries): Fix entries when both node and title are different. - (org-texinfo--menu-entries): Renamed from `org-texinfo--generate-menu-list'. + (org-texinfo--menu-entries): Rename from `org-texinfo--generate-menu-list'. (org-texinfo-headline): Move menu handling to next function. (org-texinfo-section): Handle menu for current parent. - (org-texinfo--menu-headlines, org-texinfo--generate-detailed): Remove - functions. + (org-texinfo--menu-headlines, org-texinfo--generate-detailed): + Remove functions. (org-texinfo--normalize-headlines): New function. * ox-texinfo.el (org-texinfo-headline): Fix @appendix command. @@ -519,8 +541,8 @@ * org-element.el (org-element-headline-parser): Add missing `:post-blank' property in docstring. - * ox-latex.el (org-latex-table-scientific-notation): Set - appropriate value. + * ox-latex.el (org-latex-table-scientific-notation): + Set appropriate value. (org-latex-listings-options): Fix docstring. * ox.el (org-export-raw-special-block-p): New function. @@ -557,8 +579,8 @@ * org.el (org-insert-heading): Fix error when inserting a headline before first headline, with point not at bol. Remove source block - check for consistency with behavior after first headline. Tiny - fix to docstring. + check for consistency with behavior after first headline. + Tiny fix to docstring. * org.el (org-scan-tags): Fix typo in docstring. @@ -591,8 +613,8 @@ empty. * ox-html.el (org-html-standalone-image-p): Ensure paragraph - contains at least a link before return a non-nil value. Clarify - docstring. + contains at least a link before return a non-nil value. + Clarify docstring. * ox.el (org-export-data): Always return a string, as specified by the docstring. @@ -606,25 +628,53 @@ org-icalendar-blocked-headline-p): Fix docstrings. (org-icalendar-clear-blank-lines): Fix docstring and regexp. - * ox-icalendar.el (org-icalendar-entry): Use - `org-icalendar-with-timestamps'. + * ox-icalendar.el (org-icalendar-entry): + Use `org-icalendar-with-timestamps'. -2014-10-02 Nicolas Richard <theonewiththeevillook@yahoo.fr> +2014-10-03 Nicolas Richard <theonewiththeevillook@yahoo.fr> * org.el (org-cycle-internal-local): Don't show a trailing character when cycling a subtree that ends with a non-newline character at the end of the buffer or the narrowed region. -2014-10-02 Sebastien Vauban <sva-news-D0wtAvR13HarG/iDocfnWg@public.gmane.org> +2014-10-03 Sebastien Vauban <sva-news-D0wtAvR13HarG/iDocfnWg@public.gmane.org> * ox-ascii.el (org-ascii--box-string): Choose more universal Unicode characters for boxquote corners. -2014-10-02 Marco Wahl <marcowahlsoft@gmail.com> (tiny change) +2014-10-03 Marco Wahl <marcowahlsoft@gmail.com> (tiny change) * org-agenda.el (org-agenda-bulk-mark) - (org-agenda-bulk-mark-regexp, org-agenda-bulk-toggle-all): Fix - org-agenda-bulk-mark-all when time-grid is shown. + (org-agenda-bulk-mark-regexp, org-agenda-bulk-toggle-all): + Fix org-agenda-bulk-mark-all when time-grid is shown. + +2014-06-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * org-compat.el (activate-mark): Set transient-mark-mode buffer-locally. + +2014-06-22 Mario Lang <mlang@delysid.org> + + * org-list.el (org-list-insert-item): The the -> the. + + * org-bibtex.el (org-bibtex-fields): The the -> the. + +2013-06-22 Dmitry Antipov <dmantipov@yandex.ru> + + * ob-core.el (org-babel-insert-result): Prefer point-min-marker + and point-max-marker. + * org-mouse.el (org-mouse-do-remotely): Prefer point-marker + to copy-marker of point. + +2014-05-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * org-compat.el (org-font-lock-ensure): New function. + * ox-odt.el (org-odt-do-format-code): + * ox-html.el (org-html-fontify-code): + * org.el (org-fontify-like-in-org-mode): + * org-src.el (org-src-font-lock-fontify-block): + * org-clock.el (org-clock-get-clocktable): Use it. + * ox-org.el (org-org-publish-to-org): Use it. Avoid using find-file + from Elisp. 2014-05-12 Eric Schulte <eric.schulte@gmx.com> @@ -643,14 +693,13 @@ `org-babel-gnuplot-table-to-data´ expects a table, so we need to construct one when Babel hands us a vector. - * ob-ref.el (org-babel-ref-parse): If - `org-babel-current-src-block-location' is a marker, it can be from + * ob-ref.el (org-babel-ref-parse): + If `org-babel-current-src-block-location' is a marker, it can be from another buffer, use marker-position instead in this case. 2014-04-22 Arun Persaud <apersaud@lbl.gov> (tiny change) - * org-src.el (org-edit-src-exit): Don't add indentation on empty - lines. + * org-src.el (org-edit-src-exit): Don't add indentation on empty lines. 2014-04-22 Bastien Guerry <bzg@gnu.org> @@ -830,8 +879,8 @@ * org-table.el (org-table-copy-down) (org-table-find-dataline, org-table-move-row) - (org-table-insert-hline, org-table-kill-row): Use - `org-move-to-column' with the IGNORE-INVISIBLE arg set to `t', so + (org-table-insert-hline, org-table-kill-row): + Use `org-move-to-column' with the IGNORE-INVISIBLE arg set to `t', so that abbreviated rows don't interfer with setting the cursor back at the correct position. @@ -854,8 +903,8 @@ * org-table.el (org-table-field-info): Throw a user error when not at a table. - * org-agenda.el (org-agenda-drag-line-forward): Call - `org-agenda-mark-clocking-task' when done. + * org-agenda.el (org-agenda-drag-line-forward): + Call `org-agenda-mark-clocking-task' when done. (org-agenda-mark-clocking-task): Small refactoring. * org-compat.el (org-set-transient-map): Alias pointing at @@ -932,8 +981,8 @@ 2014-04-22 Markus Hauck <markus1189@gmail.com> (tiny change) - * org-agenda.el (org-agenda-get-scheduled): If - `org-agenda-skip-scheduled-if-deadline-is-shown' is set to + * org-agenda.el (org-agenda-get-scheduled): + If `org-agenda-skip-scheduled-if-deadline-is-shown' is set to 'repeated-after-deadline, still show tasks without any deadline 2014-04-22 Michael Brand <michael.ch.brand@gmail.com> @@ -1096,8 +1145,8 @@ followed by multiple blank lines. * ox.el (org-export-insert-default-template): Only insert - keywords and options relatives to the selected back-end. Ignore - those relatives to its parent in the case of a derived back-end. + keywords and options relatives to the selected back-end. + Ignore those relatives to its parent in the case of a derived back-end. * ox-beamer.el: Remove unnecessary package definitions in default class. @@ -1190,8 +1239,8 @@ docstring. (org-entry-get): Minor docstring enhancement. (org-set-startup-visibility): Bugfix. - (org-shiftcontrolup, org-shiftcontroldown): When - `org-support-shift-select' is not `nil', let-bind it to nil if + (org-shiftcontrolup, org-shiftcontroldown): + When `org-support-shift-select' is not `nil', let-bind it to nil if point is on a clock log. Otherwise throw an error. * ob-lob.el (org-babel-lob-files): Fix custom type. @@ -1241,21 +1290,21 @@ * ox-html.el: Clean up "FIXME" comments. - * ox-publish.el (org-publish-resolve-external-fuzzy-link): Fix - docstring. + * ox-publish.el (org-publish-resolve-external-fuzzy-link): + Fix docstring. * ox.el (org-export-smart-quotes-regexps): Fix smart quote detection when it is followed by an open parenthesis syntax class. - * org-element.el (org-element-inline-babel-call-successor): Use - original regexp to stay up-to-date with Babel changes. + * org-element.el (org-element-inline-babel-call-successor): + Use original regexp to stay up-to-date with Babel changes. (org-element--affiliated-re): Fix affiliated keyword regexp. * ox-org.el (org-org-identity): Since back-end specific keywords are stripped from output, also remove attr_backend keywords. (org-babel-exp-process-buffer): Fix duplicate evaluation with :wrap src. - (org-babel-exp-non-block-elements): Removed function. + (org-babel-exp-non-block-elements): Remove function. 2013-01-07 Ted Wiles <thewiles@wharton.upenn.edu> (tiny change) @@ -1330,10 +1379,10 @@ (org-texinfo-drawer): Always use `org-texinfo-format-drawer-function' as it is now a function by default. - (org-texinfo-headline): Compare - `org-texinfo-format-headline-function' against 'ignore. - (org-texinfo-inlinetask): Compare - `org-texinfo-format-inlinetask-function' against 'ignore. + (org-texinfo-headline): + Compare `org-texinfo-format-headline-function' against 'ignore. + (org-texinfo-inlinetask): + Compare `org-texinfo-format-inlinetask-function' against 'ignore. * ox-odt.el (org-odt-format-drawer-function): Use a function as the default value. Update docstring. @@ -1341,8 +1390,8 @@ (org-odt-format-inlinetask-function): Fix default value. (org-odt-drawer): Always use `org-odt-format-drawer-function' as it is now a function by default. - (org-odt-format-headline--wrap): Compare - `org-odt-format-headline-function' against 'ignore. + (org-odt-format-headline--wrap): + Compare `org-odt-format-headline-function' against 'ignore. * ox-latex.el (org-latex-format-drawer-function): Use a function as the default value. Update docstring. @@ -1350,18 +1399,18 @@ (org-latex-drawer): Always use `org-latex-format-drawer-function' as it is now a function by default. - (org-latex-inlinetask): Compare - `org-latex-format-inlinetask-function' against 'ignore. + (org-latex-inlinetask): + Compare `org-latex-format-inlinetask-function' against 'ignore. * ox-html.el (org-html-format-drawer-function): Use a function as the default value. Update docstring. (org-html-format-headline-function) (org-html-format-inlinetask-function): Fix default value. (org-html--format-toc-headline) - (org-html-format-headline--wrap): Compare - `org-html-format-headline-function' against 'ignore. - (org-html-inlinetask): Compare - `org-html-format-inlinetask-function' against 'ignore. + (org-html-format-headline--wrap): + Compare `org-html-format-headline-function' against 'ignore. + (org-html-inlinetask): + Compare `org-html-format-inlinetask-function' against 'ignore. * ox-ascii.el (org-ascii-format-drawer-function): Use a function as the default value. Update docstring. @@ -1369,8 +1418,8 @@ `org-ascii-format-drawer-function' as it is now a function by default. (org-ascii-format-inlinetask-default): New function. - (org-ascii-format-inlinetask-function): Use - `org-ascii-format-inlinetask-default' as the default. + (org-ascii-format-inlinetask-function): + Use `org-ascii-format-inlinetask-default' as the default. * org.el (org-mouse-1-follows-link): Use :set to set the default value. Update custom type. @@ -1378,14 +1427,14 @@ type. (orgstruct-heading-prefix-regexp): Use an empty string as the default value. Use 'regexp as the custom type. - (orgstruct-make-binding): Tiny docstring enhancement. Assume - `orgstruct-heading-prefix-regexp' is a string. + (orgstruct-make-binding): Tiny docstring enhancement. + Assume `orgstruct-heading-prefix-regexp' is a string. - * org-agenda.el (org-agenda-search-view-max-outline-level): Set - default value to 0. Update docstring. + * org-agenda.el (org-agenda-search-view-max-outline-level): + Set default value to 0. Update docstring. (org-agenda-deadline-leaders): Fix custom type. - (org-search-view): Assume - `org-agenda-search-view-max-outline-level' is a number. + (org-search-view): + Assume `org-agenda-search-view-max-outline-level' is a number. * ob-ruby.el (org-babel-ruby-nil-to): Fix custom type. @@ -1435,8 +1484,8 @@ * ox-html.el (org-html-format-latex): Add an argument. Ensure latex header is the same as specified in the original buffer when exporting a LaTeX fragment or environment. - (org-html-latex-environment, org-html-latex-fragment): Apply - signature change. + (org-html-latex-environment, org-html-latex-fragment): + Apply signature change. * ox-publish.el (org-publish-cache-ctime-of-src): Return an error when publishing a non-existent file. @@ -1604,8 +1653,8 @@ * org.el (org-format-latex): Do not re-generate a LaTeX preview if the image already exists. - * org-agenda.el (org-agenda-search-view-max-outline-level): New - option to define the max level for the entries shown by the search + * org-agenda.el (org-agenda-search-view-max-outline-level): + New option to define the max level for the entries shown by the search view. A value of 1 means to show the top parent of the entries. * org.el (org-create-formula-image-with-dvipng): Fix bug that made @@ -1628,8 +1677,8 @@ (org-babel-get-rownames, org-table.el) (org-table-transpose-table-at-point): Replace the inadvertent use of mapcar* (from cl) by plain mapcar and direct cons manipulation. - (org-babel-params-from-properties): Use - `org-babel-current-src-block-location' for evaluating new-style + (org-babel-params-from-properties): + Use `org-babel-current-src-block-location' for evaluating new-style header-argument properties. Remove superfluous save-match-data clauses. Comment which properties get evaluated where. (org-babel-insert-header-arg, org-babel-parse-src-block-match): @@ -1645,8 +1694,8 @@ `org-re-property'. (org-re-property-keyword): Remove, functionality is subsumed by `org-re-property'. - (org-property-re): Define using `org-re-property'. Improve - definition so that this regex can be + (org-property-re): Define using `org-re-property'. + Improve definition so that this regex can be (org-entry-get, org-property-values): Adjust match number for PROPVAL. (org-entry-put): Use `org-re-property' instead of `org-re-property-keyword'. @@ -1660,13 +1709,13 @@ (define-obsolete-function-alias): Actually remove the third (and any following) argument from the argument list before calling the advised function. Extend eval-and-compile clause and add advices - for functions that have different parameter lists in XEmacs. Add - variable definitions that XEmacs lacks . + for functions that have different parameter lists in XEmacs. + Add variable definitions that XEmacs lacks . * ob-fortran.el (org-every): Declare. - * org-element.el (org-element-node-property-parser): Use - `org-property-re' and adjust match group numbers accordingly. + * org-element.el (org-element-node-property-parser): + Use `org-property-re' and adjust match group numbers accordingly. Move `looking-at' out of the let clause to not rely on the unspecified evaluation order inside the let. @@ -1686,8 +1735,8 @@ argument list that XEmacs complains about by adding parenthesis. * ob-octave.el (org-babel-octave-initiate-session): If octave-inf - can't be loaded, try octave instead before giving up. Emacs - 24.3.50 and upwards replaces octave-inf with just plain octave. + can't be loaded, try octave instead before giving up. + Emacs 24.3.50 and upwards replaces octave-inf with just plain octave. * org-id.el (org-id-update-id-locations): Autoload interactive function. @@ -1707,8 +1756,8 @@ * org-table.el (org-table-colgroup-info): Remove unused defvar for `org-table-colgroup-info'. (org-table-clean-before-export): Let-bind regular expression - strings and remove unused matching group. Use - `org-table-clean-did-remove-column' in cond statement rather than + strings and remove unused matching group. + Use `org-table-clean-did-remove-column' in cond statement rather than branching via if to avoid code duplication. Remove the code associated with the removed `org-table-colgroup-info'. (orgtbl-export): Remove unused internal function. @@ -1760,8 +1809,8 @@ * ob-perl.el (org-babel-execute:perl): Pass `result-params´ through to `org-babel-perl-evaluate´. (org-babel-variable-assignments:perl): Add "my" to variable - declaration so that it becomes compatible with "use strict;". Use - new internal formatting function `org-babel-perl--var-to-perl´. + declaration so that it becomes compatible with "use strict;". + Use new internal formatting function `org-babel-perl--var-to-perl´. (org-babel-perl--var-to-perl): New internal function, uses Perl non-interpolating quoting on the string that defines the variable to suppress spurious interpretation of it as Perl syntax. @@ -1779,8 +1828,8 @@ * ob-eval.el (org-babel-eval): Use simplified version of `org-babel--shell-command-on-region´, we are the only caller of this function. - (org-babel--shell-command-on-region): Replace - `org-babel-shell-command-on-region´ with a much more simplified + (org-babel--shell-command-on-region): + Replace `org-babel-shell-command-on-region´ with a much more simplified internal version, remove superfluous DOCSTRING and interactive clause, strip out all conditionals which were never used. Prevent deletion of temporary input file to aid debugging when the symbol @@ -1811,8 +1860,8 @@ * org-macs.el: New macro to allow the 5-argument form of load to be used where possible without breaking compatibility with XEmacs. - * org.el (org-version, org-reload): Use - `org-load-noerror-mustsuffix´ instead of adding a fifth argument + * org.el (org-version, org-reload): + Use `org-load-noerror-mustsuffix´ instead of adding a fifth argument to load directly. Guard against undefined variable load-suffixes, which doesn't exist in XEmacs. @@ -1836,8 +1885,8 @@ 2013-11-12 Alan Schmitt <alan.schmitt@polytechnique.org> - * ob-ocaml.el (org-babel-prep-session:ocaml): Use - `save-window-excursion' around the code starting the tuareg + * ob-ocaml.el (org-babel-prep-session:ocaml): + Use `save-window-excursion' around the code starting the tuareg process. (org-babel-ocaml-command): New option to specify the name of the toplevel to run. @@ -1894,8 +1943,8 @@ when inserting the new time as a text property. (org-agenda-filter-make-matcher): When filtering tags and hitting space, filter out entries with tags, only keep those without tags. - (org-agenda-drag-line-forward, org-agenda-drag-line-backward): Fix - bugs: don't drag lines without text and don't drag lines + (org-agenda-drag-line-forward, org-agenda-drag-line-backward): + Fix bugs: don't drag lines without text and don't drag lines before/after hidden lines. * ox-odt.el (org-odt-table-style-format): Use %s for inserting the @@ -1990,8 +2039,8 @@ * org-capture.el (org-capture-set-target-location): Don't throw an error when `org-time-was-given' is not bound. - * org-clock.el (org-clock-modify-effort-estimate): Clarify - docstring. + * org-clock.el (org-clock-modify-effort-estimate): + Clarify docstring. * org.el (org-set-regexps-and-options-for-tags): Return a list with tag-related variables. @@ -2013,8 +2062,8 @@ (org-get-outline-path): Remove statistical and checkboxes cookies. * org-agenda.el (org-agenda, org-search-view, org-tags-view) - (org-agenda-get-day-entries, org-agenda-set-restriction-lock): Use - (current-buffer) as the value of `org-agenda-restrict'. Fix a bug + (org-agenda-get-day-entries, org-agenda-set-restriction-lock): + Use (current-buffer) as the value of `org-agenda-restrict'. Fix a bug about narrowing to wrong region boundaries when `org-agenda-restrict' is non-nil. @@ -2023,20 +2072,20 @@ (org-insert-heading): Fix case when there the first heading starts at the beginning of the buffer. - * ob-core.el (org-babel-expand-src-block): Use - `org-called-interactively-p'. + * ob-core.el (org-babel-expand-src-block): + Use `org-called-interactively-p'. * org.el (org-agenda-prepare-buffers): Avoid duplicates in `org-tag-alist-for-agenda' correctly. (org-read-date-minibuffer-local-map): Check if we are at the - beginning of the prompt, not if we are after a whitespace. Bind - C-. to `calendar-goto-today'. + beginning of the prompt, not if we are after a whitespace. + Bind C-. to `calendar-goto-today'. * org-clock.el (org-clock-in): Don't forward by one character when setting the marker in the clock history. - * org.el (org-read-date-minibuffer-local-map): Call - `calendar-goto-today' only if there is a space before point in the + * org.el (org-read-date-minibuffer-local-map): + Call `calendar-goto-today' only if there is a space before point in the minibuffer prompt. (org-insert-heading): Reveal context when called interactively. Fix bug about wrong conversion of lines with :END: or #+end_ into @@ -2125,8 +2174,8 @@ (org-mark-subtree, org-kill-line, org-first-sibling-p) (org-up-element, org-down-element) (org-drag-element-backward, org-drag-element-forward) - (org-unindent-buffer, org-speedbar-set-agenda-restriction): Use - `user-error' instead of `error'. + (org-unindent-buffer, org-speedbar-set-agenda-restriction): + Use `user-error' instead of `error'. * ox-latex.el (latex): Don't force exporting with smart quotes. @@ -2146,8 +2195,8 @@ values. * org.el (org-shifttab): Show the correct number of empty - headlines when called with a numeric prefix argument. Enhance - docstring. + headlines when called with a numeric prefix argument. + Enhance docstring. (org-uniquify): Use `copy-sequence'. (org-adaptive-fill-function, org-fill-paragraph): Throw a useful error message when parse an element fails in the current buffer. @@ -2161,8 +2210,8 @@ (org-cycle-emulate-tab, org-file-apps) (org-set-font-lock-defaults) (org-translate-link-from-planner, org-link-search) - (org-refile-get-targets, org-read-date-get-relative): Minor - code clean-up: fix dangling parentheses. + (org-refile-get-targets, org-read-date-get-relative): + Minor code clean-up: fix dangling parentheses. * org-agenda.el (org-agenda-entry-text-mode): Also check against regexp filters. @@ -2222,8 +2271,8 @@ * org-mouse.el (org-mouse-agenda-context-menu): Fix a function's name. - * ox.el (org-export-options-alist, org-export--skip-p): Use - `:with-planning' instead of `:with-plannings', to keep in sync + * ox.el (org-export-options-alist, org-export--skip-p): + Use `:with-planning' instead of `:with-plannings', to keep in sync with the corresponding option's name. * ob-core.el (org-babel-confirm-evaluate): Fix typo in docstring. @@ -2394,8 +2443,8 @@ (org-re-timestamp): Handle closed time-stamps. (org-closed-in-range): Delete. - * org-capture.el (org-capture-import-remember-templates): Take - care of adding :jump-to-captured option if needed. + * org-capture.el (org-capture-import-remember-templates): + Take care of adding :jump-to-captured option if needed. * org.el (org-toggle-pretty-entities): Enhance messages. (org-raise-scripts): Handle scripts like "a_b^c". @@ -2478,8 +2527,8 @@ information for filtering in the agenda buffer. (org-uniquify-alist): New function. - * org-pcomplete.el (pcomplete/org-mode/file-option/tags): Handle - :grouptags. + * org-pcomplete.el (pcomplete/org-mode/file-option/tags): + Handle :grouptags. * org-faces.el (mode-line): New face for group tags. @@ -2539,8 +2588,8 @@ * ox-ascii.el (ascii): Use `org-export-define-backend' and `org-export-define-derived-backend' as defuns, not macros. - * org.el (org-set-regexps-and-options): Use - `org-table-set-constants'. + * org.el (org-set-regexps-and-options): + Use `org-table-set-constants'. * org-table.el (org-table-set-constants): New function. (orgtbl-ctrl-c-ctrl-c): Use it. @@ -2566,8 +2615,8 @@ * ox-publish.el (org-publish-org-to) (org-publish-org-sitemap, org-publish-find-title) (org-publish-find-date) - (org-publish-cache-file-needs-publishing): Set - `org-inhibit-startup' to t when visiting files for + (org-publish-cache-file-needs-publishing): + Set `org-inhibit-startup' to t when visiting files for publication. * ox-org.el (org-org-publish-to-org): Kill buffers not visited at @@ -2606,8 +2655,8 @@ (org-agenda-filter-remove-all): New command. (org-agenda-filter-show-all-re): Rename from `org-agenda-filter-show-all-regexp'. - (org-agenda-filter-by-regexp): Call - `org-agenda-filter-show-all-re'. + (org-agenda-filter-by-regexp): + Call `org-agenda-filter-show-all-re'. * org-list.el (org-insert-item): Don't ask for a definition term when insert an item in a description list. @@ -2639,11 +2688,11 @@ * ox.el (org-export--copy-to-kill-ring-p): New function. (org-export-copy-to-kill-ring): Use 'if-interactive as the default. - (org-export-to-buffer, org-export-to-file): Use - `org-export--copy-to-kill-ring-p' and fix docstrings. + (org-export-to-buffer, org-export-to-file): + Use `org-export--copy-to-kill-ring-p' and fix docstrings. - * ox-odt.el (org-odt-export-as-odf): Use - `org-export--copy-to-kill-ring-p'. + * ox-odt.el (org-odt-export-as-odf): + Use `org-export--copy-to-kill-ring-p'. * org.el (org-set-font-lock-defaults): Fontify macros. @@ -2681,8 +2730,8 @@ (org-scheduled-time-hour-regexp): New buffer local variables. (org-set-regexps-and-options): Set the new variables. - * org-agenda.el (org-agenda-custom-commands-local-options): Add - :deadline* and :scheduled* to the list of possible agenda entry + * org-agenda.el (org-agenda-custom-commands-local-options): + Add :deadline* and :scheduled* to the list of possible agenda entry types. (org-agenda): Implement a new agenda type agenda* with :scheduled* and :deadline* replacing :scheduled and :deadline respectively in @@ -2693,15 +2742,15 @@ (org-agenda-list): New parameter `with-hour'. Use :scheduled* and :deadline*. (org-agenda-get-day-entries): Handle :scheduled* and :deadline*. - (org-agenda-get-deadlines, org-agenda-get-scheduled): New - parameter `with-hour'. Use `org-deadline-time-hour-regexp' or + (org-agenda-get-deadlines, org-agenda-get-scheduled): + New parameter `with-hour'. Use `org-deadline-time-hour-regexp' or `org-scheduled-time-hour-regexp' as the search string if needed. (org-agenda-to-appt): Use :scheduled* and :deadline* by default, as other scheduled and deadline items don't have a time spec and cannot be turned into appointments. Trim bracket links and use only the description as the appointment text. - (org-agenda-get-restriction-and-command): Add - default description for the agenda* view. + (org-agenda-get-restriction-and-command): + Add default description for the agenda* view. (org-agenda-run-series): Handle agenda* views. * org-faces.el (org-agenda-filter-tags) @@ -2710,13 +2759,13 @@ (org-agenda-filter-category): Docstring fix. (org-agenda-filter-category): New face. - * org-agenda.el (org-agenda-local-vars): Add - `org-agenda-re-filter-overlays' and `org-agenda-regexp-filter'. + * org-agenda.el (org-agenda-local-vars): + Add `org-agenda-re-filter-overlays' and `org-agenda-regexp-filter'. (org-agenda-mode-map): Use "|" for `org-agenda-filtered-by-regexp'. (org-agenda-re-filter-overlays): New variable. - (org-agenda-mark-filtered-text): Use - `org-agenda-re-filter-overlays'. + (org-agenda-mark-filtered-text): + Use `org-agenda-re-filter-overlays'. (org-agenda-finalize, org-agenda-redo): Allow regexp filtering. (org-agenda-filter-by-category): Set `org-agenda-category-filter' here instead of within `org-agenda-apply-filter'. @@ -2726,8 +2775,8 @@ (org-agenda-filter-make-matcher): Make matcher for regexp filters. (org-agenda-filter-apply): Don't set `org-agenda-tag-filter' and `org-agenda-category-filter'. Maybe apply regexp filter. - (org-agenda-filter-hide-line): Add docstring. Hide - regexp-filtered lines. + (org-agenda-filter-hide-line): Add docstring. + Hide regexp-filtered lines. (org-agenda-filter-show-all-tag, org-agenda-filter-show-all-cat): Add docstring. (org-agenda-filter-show-all-regexp): New function. @@ -2736,8 +2785,8 @@ (org-agenda-regexp-filter-preset): New variable. (org-agenda-prepare): Use the new variable. - * ox-odt.el (org-odt-code, org-odt-verbatim): Use - `org-odt--encode-plain-text'. + * ox-odt.el (org-odt-code, org-odt-verbatim): + Use `org-odt--encode-plain-text'. * ox-html.el (org-html-link): Minor code clean-up. @@ -2812,8 +2861,8 @@ a universal prefix arg will only convert the first line. This is more consistent with `org-toggle-item'. (orgstruct-setup): Add `org-ctrl-c-minus' and `org-ctrl-c-star'. - (customize-package-emacs-version-alist): Update - `customize-package-emacs-version-alist'. + (customize-package-emacs-version-alist): + Update `customize-package-emacs-version-alist'. * ox-texinfo.el (org-export-texinfo) (org-texinfo-filename, org-texinfo-classes) @@ -2908,8 +2957,8 @@ docstring. * ox-latex.el: - (org-latex-table-scientific-notation, org-latex-verse-block): Fix - typos in docstrings. + (org-latex-table-scientific-notation, org-latex-verse-block): + Fix typos in docstrings. * ox-html.el (org-html-text-markup-alist) (org-html-pretty-output, org-html-link-org-files-as-html) @@ -2925,8 +2974,8 @@ (org-html-format-list-item, org-html-format-latex) (org-html-encode-plain-text) (org-html-table-first-row-data-cells) - (org-html-table--table.el-table, org-html-final-function): Fix - or add docstring. + (org-html-table--table.el-table, org-html-final-function): + Fix or add docstring. * org.el (org-insert-heading): If the current item has a checkbox, insert the new item with a checkbox. @@ -2965,8 +3014,8 @@ known as HTML_STYLE_EXTRA. (org-html-head): Enhance docstring. (org-html-head-extra): Reintroduce. Was `org-html-style-extra'. - (org-html--build-head): Rename from `org-html--build-head'. Add - information from `org-html-head-extra'. + (org-html--build-head): Rename from `org-html--build-head'. + Add information from `org-html-head-extra'. (org-html-template): Use `org-html--build-head'. * ox-html.el (org-html-display-buffer-mode): Delete. @@ -2989,8 +3038,8 @@ (org-insert-heading-respect-content): New optional argument arg, passed to `org-insert-heading'. - * org.el (org-mode): Remove syntax entries. Use - `org-backward-element' and `org-forward-element' for + * org.el (org-mode): Remove syntax entries. + Use `org-backward-element' and `org-forward-element' for `beginning-of-defun-function' and `end-of-defun-function': this allows using C-M-a and C-M-e before the first headline. @@ -3002,8 +3051,8 @@ publishing projects. * ox-html.el (org-html-style-default): Update docstring. - (org-html-infojs-install-script, org-html--build-style): Update - property names. + (org-html-infojs-install-script, org-html--build-style): + Update property names. (org-html-head-include-scripts) (org-html-head-include-default-style, org-html-head): Respectively rename from `org-html-style-include-scripts', @@ -3019,8 +3068,8 @@ * ob-tangle.el (org-babel-tangle): Remove unused attempt of prompting the user of the tangle file name since :tangle is always set. Don't prompt for a tangle file name when called with two - universal prefix arg outside of a src block. Use - `org-babel-tangle-single-block'. + universal prefix arg outside of a src block. + Use `org-babel-tangle-single-block'. (org-babel-tangle-single-block): New function. (org-babel-tangle-collect-blocks): Use the new function. @@ -3092,8 +3141,8 @@ universal prefix arguments, set the warning time or the delay relatively to the current timestamp, not to today's date. - * org-agenda.el (org-agenda-filter-apply): Deactive - `org-agenda-entry-text-mode' when filtering. + * org-agenda.el (org-agenda-filter-apply): + Deactive `org-agenda-entry-text-mode' when filtering. (org-agenda-entry-text-mode): Don't allow in filtered views. Don't show the maximum number of lines when turning off. @@ -3195,8 +3244,8 @@ * org-macs.el (org-unmodified): Update comment. Don't define `with-silent-modifications' for emacsen that don't have it. - * org-compat.el (org-with-silent-modifications): New - compatibility macro. + * org-compat.el (org-with-silent-modifications): + New compatibility macro. * org.el (org-refresh-category-properties) (org-refresh-properties, org-entry-blocked-p) @@ -3256,8 +3305,8 @@ * ox-publish.el (org-publish-sitemap-date-format): Small docstring enhancement. - * ox-latex.el (org-latex-format-headline-default-function): New - option. + * ox-latex.el (org-latex-format-headline-default-function): + New option. (org-latex-format-headline-function): Use the new option as the default value. (org-latex-toc-command): Don't add vertical space after the table @@ -3314,8 +3363,8 @@ (org-html-htmlized-org-css-url) (org-html-htmlize-region-for-paste): Rename from org-export-htmlize-*. - (org-html-htmlize-generate-css, org-html-fontify-code): Use - the correct names. + (org-html-htmlize-generate-css, org-html-fontify-code): + Use the correct names. * org-compat.el (org-file-equal-p): New compatibility function. @@ -3326,8 +3375,8 @@ (org-clock-in, org-clock-out): Set and delete `org-clock-current-task'. Minor code clean-up. - * org-clock.el (org-clock-in, org-clock-in-last): Tell - `org-current-time' to always return a past time. + * org-clock.el (org-clock-in, org-clock-in-last): + Tell `org-current-time' to always return a past time. * org.el (org-current-time): New argument `past' to force returning a past time when rounding. @@ -3356,8 +3405,8 @@ `org-emphasis-alist' word constituents. (org-mode-transpose-word-syntax-table): Rename from `org-syntax-table'. - (org-transpose-words): Use - `org-mode-transpose-word-syntax-table'. + (org-transpose-words): + Use `org-mode-transpose-word-syntax-table'. * ox.el (org-export--dispatch-ui) (org-export--dispatch-action): Use integers for control chars. @@ -3393,8 +3442,8 @@ (org-edit-src-exit): Inconditionally kill the src/example editing buffer. - * org-pcomplete.el (pcomplete/org-mode/file-option): Require - 'org-element. This fixes a bug about unbound variable + * org-pcomplete.el (pcomplete/org-mode/file-option): + Require 'org-element. This fixes a bug about unbound variable `org-element-affiliated-keywords' when trying to complete a keyword before 'org-element was required. @@ -3419,8 +3468,8 @@ * org.el (org-syntax-table, org-transpose-words): Delete. (org-mode): Syntactically Define {} and <> as parentheses. - (org-drag-line-forward, org-drag-line-backward): New - functions. + (org-drag-line-forward, org-drag-line-backward): + New functions. (org-shiftmetaup, org-shiftmetadown): Fall back on the new functions instead of throwing an error. (org-make-org-heading-search-string): Don't use statistic or [x/y] @@ -3431,8 +3480,8 @@ * org.el (org-emphasis-alist, org-protecting-blocks): * org-src.el (org-edit-src-find-region-and-lang): * org-list.el (org-list-forbidden-blocks): - * org-footnote.el (org-footnote-forbidden-blocks): Remove - references to the deleted DocBook exporter. + * org-footnote.el (org-footnote-forbidden-blocks): + Remove references to the deleted DocBook exporter. * org.el (org-end-of-line): Don't throw an error outside elements. @@ -3684,8 +3733,8 @@ (org-transpose-words): New command, simply wrapping the new syntax table around `transpose-words'. (org-mode-map): Bind `org-transpose-words' to `M-t'. - (org-store-link): Use keyword at point as the search string. Use - `delq nil' instead of `delete nil'. + (org-store-link): Use keyword at point as the search string. + Use `delq nil' instead of `delete nil'. (org-make-org-heading-search-string): Rewrite using org-element.el. Not an interactive function anymore. @@ -3728,8 +3777,8 @@ these list HTML tags: <ul> <dl> and <ol>. * org-clock.el (org-clock-timestamps-up) - (org-clock-timestamps-down, org-clock-timestamps-change): Add - an optional argument N to change timestamps by several units. + (org-clock-timestamps-down, org-clock-timestamps-change): + Add an optional argument N to change timestamps by several units. * org.el (org-shiftcontrolup, org-shiftcontroldown): Ditto. @@ -3740,8 +3789,8 @@ * org.el (org-block-entry-blocking): New variable. (org-todo): Use it. Also use `user-error' when a TODO state change is blocked. - (org-block-todo-from-children-or-siblings-or-parent): Display - `org-block-entry-blocking' in the user-error message. + (org-block-todo-from-children-or-siblings-or-parent): + Display `org-block-entry-blocking' in the user-error message. * org.el (org-get-cursor-date): New optional argument WITH-TIME to add the time of the day. @@ -3808,8 +3857,8 @@ (org-use-last-clock-out-time-as-effective-time): New option. (org-current-effective-time): Use the new option. - * org-clock.el (org-clock-get-last-clock-out-time): New - function. + * org-clock.el (org-clock-get-last-clock-out-time): + New function. * org.el (org-toggle-inline-images): Only send a message when called interactively. @@ -3837,8 +3886,8 @@ (org-agenda-get-blocks, org-agenda-change-all-lines): Add a new text property 'level, a string with as many whitespaces as the level of the item. - (org-agenda-format-item, org-compile-prefix-format): Handle - the new `%l' specifier. + (org-agenda-format-item, org-compile-prefix-format): + Handle the new `%l' specifier. * org-colview.el (org-columns-next-allowed-value): Add the CLOCKSUM property to the list of properties that can be @@ -3896,15 +3945,15 @@ * org-agenda.el (org-agenda-custom-commands-local-options): (org-agenda-span, org-agenda-ndays-to-span) (org-agenda-span-to-ndays, org-agenda-list, org-agenda-later) - (org-agenda-change-time-span, org-agenda-compute-starting-span): Add - support for fortnight view. + (org-agenda-change-time-span, org-agenda-compute-starting-span): + Add support for fortnight view. (org-agenda-menu): Add fortnight view command. (org-agenda-fortnight-view): New command. * org-timer.el (org-clock-sound): Silence compiler. - * org.el (org-beginning-of-line, org-end-of-line): Bind - deactivate-mark to avoid that this command deactivates it. + * org.el (org-beginning-of-line, org-end-of-line): + Bind deactivate-mark to avoid that this command deactivates it. (org-make-tags-matcher): Do not interpret / in property value as starter of TODO match. (org-overview): Preserve point. @@ -3928,11 +3977,11 @@ * org.el (org-unlogged-message): New function. (org-cycle, org-cycle-internal-global, org-cycle-internal-local) - (org-global-cycle, org-display-outline-path): Use - `org-unlogged-message'. + (org-global-cycle, org-display-outline-path): + Use `org-unlogged-message'. - * org-pcomplete.el (org-make-org-heading-search-string): Fix - function declaration. + * org-pcomplete.el (org-make-org-heading-search-string): + Fix function declaration. (pcomplete/org-mode/searchhead): Remove incorrect second arguments to `org-make-org-heading-search-string'. @@ -3951,8 +4000,8 @@ (org-display-outline-path): Do not log outline path in Message buffer. (org-agenda-ignore-drawer-properties): New option. - (org-agenda-prepare-buffers): Honour - `org-agenda-ignore-drawer-properties'. + (org-agenda-prepare-buffers): + Honour `org-agenda-ignore-drawer-properties'. * org-clock.el (org-clock-goto): Recenter to thrd line @@ -3963,8 +4012,8 @@ (org-set-regexps-and-options-for-tags): Use `org-bookmark-names-plist'. (org-refile): Use `org-bookmark-names-plist'. - * org-capture.el (org-capture-bookmark-last-stored-position): Use - `org-bookmark-names-plist'. + * org-capture.el (org-capture-bookmark-last-stored-position): + Use `org-bookmark-names-plist'. * org.el (org-insert-heading): Rewritten from scratch. (org-N-empty-lines-before-current): New function @@ -3984,8 +4033,8 @@ * org-ctags.el (org-ctags-path-to-ctags): Avoid usine `case'. - * org.el (org-beginning-of-line, org-end-of-line): Set - disable-point-adjustment when the command ends next to invisible + * org.el (org-beginning-of-line, org-end-of-line): + Set disable-point-adjustment when the command ends next to invisible text. * ob-lob.el (org-babel-lob-files): Fix custom type. @@ -4058,8 +4107,8 @@ 2013-11-12 Christian Moe <mail@christianmoe.com> - * ox-odt.el (org-odt-line-break, org-odt-plain-text): Remove - newline after line-break tag. + * ox-odt.el (org-odt-line-break, org-odt-plain-text): + Remove newline after line-break tag. 2013-11-12 Christophe Junke <christophe.junke@inria.fr> (tiny change) @@ -4082,16 +4131,16 @@ property. (org-heading-components): Use `org-heading-regexp' in orgstruct-mode. - (orgstruct-heading-prefix-regexp, orgstruct-setup-hook): New - options. + (orgstruct-heading-prefix-regexp, orgstruct-setup-hook): + New options. (orgstruct-initialized): New variable. (org-get-local-variables): Honour state property. (org-run-like-in-org-mode): Use `let' instead of `progv'. Do not override variables with non-default values. (org-forward-heading-same-level): Do not skip to headlines on another level. Handle negative prefix argument correctly. - (org-backward-heading-same-level): Use - `org-forward-heading-same-level'. + (org-backward-heading-same-level): + Use `org-forward-heading-same-level'. 2013-11-12 Craig Tanis <craig-tanis@utc.edu> (tiny change) @@ -4106,8 +4155,8 @@ * ox-html.el (org-html-doctype-alist): New variable holding an alist of (X)HTML doctypes - (org-html-xhtml-p, org-html-html5-p, org-html-close-tag): New - function. + (org-html-xhtml-p, org-html-html5-p, org-html-close-tag): + New function. (org-html-html5-fancy): New export option, determining whether or not to use HTML5-specific elements. (org-html-html5-elements): New variable, new HTML5 elements. @@ -4121,8 +4170,8 @@ (org-html-format-list-item, org-html-line-break, org-html-table) (org-html-verse-block): Changes to allow flavored export. - * ox-latex.el (org-latex--org-table, org-latex-table-row): Allow - use of the "tabu" and "longtabu" table environments. New table + * ox-latex.el (org-latex--org-table, org-latex-table-row): + Allow use of the "tabu" and "longtabu" table environments. New table attribute :spread handles the width specification syntax of "tabu" and "longtabu" table environments. @@ -4168,8 +4217,8 @@ * ob-sh.el (org-babel-sh-evaluate): * ob-shen.el (org-babel-execute:shen): * ob-sql.el (org-babel-execute:sql): - * ob-sqlite.el (org-babel-execute:sqlite): Use - `org-babel-result-cond'. + * ob-sqlite.el (org-babel-execute:sqlite): + Use `org-babel-result-cond'. * ob.el (org-babel-common-header-args-w-values): Add a new "none" header argument. @@ -4205,8 +4254,8 @@ :padnewlines to "yes". Either way lets just remove this which shouldn't have any functional effect. - * ob-haskell.el (org-babel-default-header-args:haskell): Set - :padlines to "no" by default. + * ob-haskell.el (org-babel-default-header-args:haskell): + Set :padlines to "no" by default. * ob-exp.el (org-babel-exp-non-block-elements): Ignore inline source block on #+ prefixed lines. @@ -4223,8 +4272,8 @@ * ob-sh.el (org-babel-sh-var-to-string): Fix bug in ob-sh when dealing with list variables. - * ob-core.el (org-babel-demarcate-block): Include - `org-src-lang-modes' in block demarcation options. + * ob-core.el (org-babel-demarcate-block): + Include `org-src-lang-modes' in block demarcation options. * ob-C.el: Don't modify `org-babel-load-languages' from ob-* files. @@ -4293,7 +4342,7 @@ * ob-gnuplot.el (org-babel-header-args:gnuplot): Term is a gnuplot header argument. - * ob-tangle.el (org-babel-tangle): Fixed bug in tangle-file. + * ob-tangle.el (org-babel-tangle): Fix bug in tangle-file. Collect tangle modes, and only apply them to the file after all tangling has completed, including the post-tangle-hook. @@ -4303,8 +4352,8 @@ * ob-core.el (org-babel-current-src-block-location): (org-babel-execute-src-block): * ob-exp.el (org-babel-exp-results): - * ob-lob.el (org-babel-lob-execute): Rename - `org-babel-current-exec-src-block-head' to + * ob-lob.el (org-babel-lob-execute): + Rename `org-babel-current-exec-src-block-head' to `org-babel-current-src-block-location'. * ob-core.el (org-babel-common-header-args-w-values): Adding the @@ -4328,8 +4377,8 @@ `org-babel-current-exec-src-block-head' variable when executing inline or lob style code. - * ob-core.el (org-babel-execute-src-block): The - `org-babel-current-exec-src-block-head' variable should point to + * ob-core.el (org-babel-execute-src-block): + The `org-babel-current-exec-src-block-head' variable should point to the outermost code block. * org.el (org-some): An org-mode version of the cl some function. @@ -4340,8 +4389,8 @@ * org.el (org-every): An Org-mode version of the cl every function. - * ob-tangle.el (org-babel-tangle-jump-to-org): Use - `org-src-switch-to-buffer' to jump from src to org. Use the + * ob-tangle.el (org-babel-tangle-jump-to-org): + Use `org-src-switch-to-buffer' to jump from src to org. Use the existing `org-edit-src' functionality to jump back to the correct point in the code block in the original Org-mode buffer. @@ -4386,14 +4435,14 @@ * ob-js.el (org-babel-execute:js): Use `org-babel-result-cond' in JavaScript code blocks. - * ob-scheme.el (org-babel-execute:scheme): Use - `org-babel-result-cond' in scheme code blocks. + * ob-scheme.el (org-babel-execute:scheme): + Use `org-babel-result-cond' in scheme code blocks. - * ob-ocaml.el (org-babel-execute:ocaml): Use - `org-babel-result-cond' in OCaml code blocks. + * ob-ocaml.el (org-babel-execute:ocaml): + Use `org-babel-result-cond' in OCaml code blocks. - * ob-haskell.el (org-babel-execute:haskell): Use - `org-babel-result-cond' in Haskell code blocks. + * ob-haskell.el (org-babel-execute:haskell): + Use `org-babel-result-cond' in Haskell code blocks. * ob-core.el (org-babel-result-cond): The "raw", "org" and "drawer" :results header argument values preclude table processing @@ -4419,7 +4468,7 @@ (org-babel-insert-result): Cycle tables for :results org and :results wrap. - * ob-python.el (org-babel-python-initiate-session-by-key): Fixed a + * ob-python.el (org-babel-python-initiate-session-by-key): Fix a bug pointed out by Gary Oberbrunner. (org-babel-python-initiate-session-by-key): Add "-i" to the python command on windows sessions. Actually setting new session names. @@ -4446,7 +4495,7 @@ (org-babel-confirm-evaluate): Fix whitespaces. (org-babel-execute-src-block): A cond makes it more clear that we definitely do not execute without user confirmation. - (org-babel-call-process-region-original): Fixed line over 80 chars + (org-babel-call-process-region-original): Fix line over 80 chars long. * ob-tangle.el (org-babel-tangle-collect-blocks): Update comment @@ -4491,8 +4540,8 @@ * ox-html.el (org-html-latex-environment) (org-html-latex-fragment): Fix imagemagick support. - * org.el (org-create-formula-image-with-imagemagick): Generate - correct size formula image. + * org.el (org-create-formula-image-with-imagemagick): + Generate correct size formula image. (org-format-latex-header): Change pagestyle command position. * ox-latex.el (org-latex--caption/label-string): Allow to build a @@ -4523,8 +4572,8 @@ * org.el (org-reftex-citation): Fix contrib package name in the docstring. - (org-preview-latex-fragment, org-display-inline-images): Detect - whether a graphic display is available before inlining images to + (org-preview-latex-fragment, org-display-inline-images): + Detect whether a graphic display is available before inlining images to prevent an error. (org-startup-with-latex-preview): New option. (org-startup-options): New startup keywords for the new option. @@ -4532,8 +4581,8 @@ (org-reverse-string): Add `org-reverse-string' to reverse a string. - * org-id.el (org-id-new, org-id-decode): Replace - `org-id-reverse-string' by `org-reverse-string'. + * org-id.el (org-id-new, org-id-decode): + Replace `org-id-reverse-string' by `org-reverse-string'. * ob-core.el (org-babel-trim): Replace `org-babel-reverse-string' by `org-reverse-string' and declare it. @@ -4740,13 +4789,13 @@ * ox-md.el: Remove comments at the beginning of the file since the library is documented in Org manual. - * org-element.el (org-element--list-struct): Use - `org-match-string-no-properties'. Fix block parsing in lists. + * org-element.el (org-element--list-struct): + Use `org-match-string-no-properties'. Fix block parsing in lists. * ox-publish.el (org-publish-all): Fix compilation problem. - * org-element.el (org-element-timestamp-interpreter): Correctly - interpret timestamps with delays. + * org-element.el (org-element-timestamp-interpreter): + Correctly interpret timestamps with delays. (org-element-timestamp-parser) (org-element-timestamp-interpreter): Parse warning delays. @@ -4775,19 +4824,19 @@ Fix infloop when called on a blank line at the end of the buffer after a headline. - * org.el (org-forward-paragraph, org-backward-paragraph): New - functions. + * org.el (org-forward-paragraph, org-backward-paragraph): + New functions. * org.el (org-meta-return): Allow M-RET to insert items within drawers. Rewrite function. - * org-element.el (org-element-footnote-definition-parser): Fix - value for :contents-begin when first line of footnote definition + * org-element.el (org-element-footnote-definition-parser): + Fix value for :contents-begin when first line of footnote definition is empty besides the label. (org-element-at-point): Return correct element when point is on a blank line just below a headline. - (org-element-paragraph-parser): Use - `org-match-string-no-properties'. Small fixes to paragraph + (org-element-paragraph-parser): + Use `org-match-string-no-properties'. Small fixes to paragraph parsing. * org.el (org-adaptive-fill-function): Do not handle @@ -4832,8 +4881,8 @@ * ox-publish.el (project-plist): Remove variable. - * ox.el (org-export-to-buffer, org-export-to-file): Fix - docstrings. + * ox.el (org-export-to-buffer, org-export-to-file): + Fix docstrings. * ox-org.el (org-export-as-org): Add missing BODY-ONLY argument, which is always nil in this back-end. @@ -4913,8 +4962,8 @@ (org-export--dispatch-action): Maintain compatibility with Emacs 23. - * org.el (org-adaptive-fill-function, org-fill-paragraph): Add - support for `adaptive-fill-regexp' in paragraphs and comments. + * org.el (org-adaptive-fill-function, org-fill-paragraph): + Add support for `adaptive-fill-regexp' in paragraphs and comments. (org-indent-line): Fix indentation after a list. * ox.el (org-export--get-inbuffer-options): Multiple options can @@ -4942,8 +4991,8 @@ * ox-latex.el (org-latex-template): Fix missing newlines in header. - * ox.el (org-export-insert-default-template): Fix - "wrong-type-argument" error in template insertion. + * ox.el (org-export-insert-default-template): + Fix "wrong-type-argument" error in template insertion. * org.el (org-fill-paragraph): Use empty commented lines as separators when filling comments. This mimics default behavior @@ -4965,8 +5014,8 @@ * ox-latex.el (org-latex-listings): Update docstring. - * org-pcomplete.el (pcomplete/org-mode/file-option/options): Apply - changes to export back-end definiton. + * org-pcomplete.el (pcomplete/org-mode/file-option/options): + Apply changes to export back-end definiton. * org.el (org-get-export-keywords): Apply changes to export back-end definiton. @@ -4980,12 +5029,12 @@ (org-odt-format-headline--wrap): Use `org-export-with-backend' instead of `org-export-with-translations'. - * ox.el (org-export--registered-backends): Renamed from + * ox.el (org-export--registered-backends): Rename from `org-export-registered-backends'. - (org-export-invisible-backends): Removed variable. + (org-export-invisible-backends): Remove variable. (org-export-get-backend, org-export-get-all-transcoders - org-export-get-all-options, org-export-get-all-filters): New - functions. It replaces `org-export-backend-translate-table'. + org-export-get-all-options, org-export-get-all-filters): + New functions. It replaces `org-export-backend-translate-table'. (org-export-barf-if-invalid-backend, org-export-derived-backend-p, org-export-define-backend, org-export-define-derived-backend): Rewrite functions using new representation. @@ -4995,8 +5044,8 @@ org-export--get-inbuffer-options, org-export--get-global-options, org-export-to-buffer org-export-to-file, org-export-string-as org-export-replace-region-by): Update docstring. - (org-export-data-with-translations): Remove function. Use - `org-export-data-with-backend' with a temporary back-end instead. + (org-export-data-with-translations): Remove function. + Use `org-export-data-with-backend' with a temporary back-end instead. (org-export-data-with-backend, org-export-as): Reflect new definition for back-ends. (org-export--dispatch-action, org-export--dispatch-ui): Reflect new @@ -5037,8 +5086,8 @@ * ox-html.el (org-html-link): Small refactoring. - * org-element.el (org-element--current-element): Fix - org-meta-return error at the end of buffer. + * org-element.el (org-element--current-element): + Fix org-meta-return error at the end of buffer. * ox-odt.el (org-odt-category-map-alist): Fix internationalization of "Table" and "Listing". @@ -5119,8 +5168,8 @@ (org-latex-long-listings): Remove variable. * org-element.el (org-element--list-struct): New function. - (org-element-plain-list-parser, org-element--current-element): Use - new function. + (org-element-plain-list-parser, org-element--current-element): + Use new function. * ox-man.el (org-man-compile): * ox-texinfo.el (org-texinfo-compile): Use appropriate argument. @@ -5136,8 +5185,8 @@ * ox-md.el (md): Delegate underscore transcoding to HTML back-end. - * org-element.el (org-element--remove-indentation): Small - optimization. + * org-element.el (org-element--remove-indentation): + Small optimization. (org-element--remove-indentation): New function. (org-element-example-block-parser, org-element-src-block-parser): Use new function. @@ -5226,8 +5275,8 @@ `org-list-allow-alphabetical' when changed after org.el has been loaded. - * org-element.el (org-element-fixed-width-interpreter): Fix - interpretation of fixed-width elements with a nil or empty string + * org-element.el (org-element-fixed-width-interpreter): + Fix interpretation of fixed-width elements with a nil or empty string value. * ox-html.el (org-html-link): Don't skip the link description when @@ -5241,8 +5290,8 @@ * ox-icalendar.el (icalendar): Ignore footnotes. (org-icalendar--combine-files): Small refactoring. - * ox.el (org-export--skip-p, org-export--interpret-p): When - `org-export-with-footnotes' is nil, ignore completely footnotes + * ox.el (org-export--skip-p, org-export--interpret-p): + When `org-export-with-footnotes' is nil, ignore completely footnotes references and definitions instead of exporting them verbatim. * ox-beamer.el (org-beamer--frame-level): Small refactoring. @@ -5304,11 +5353,11 @@ * ox-html.el (html): Rename :html-table-tag property into :org-table-attributes. (org-html-table-default-attributes): New variable. - (org-html-table-tag): Removed variable. + (org-html-table-tag): Remove variable. (org-html--make-attribute-string): New function. (org-html-link--inline-image, org-html-table): Use new function. - (org-html-splice-attributes, org-export-splice-style): Remove - functions. + (org-html-splice-attributes, org-export-splice-style): + Remove functions. (org-html-inline-image-rules): Remove out of context part of the docstring. @@ -5357,8 +5406,8 @@ (org-export-with-sub-superscripts, org-export-with-toc) (org-export-with-tables, org-export-with-tags) (org-export-with-tasks, org-export-time-stamp-file) - (org-export-with-timestamps, org-export-with-todo-keywords): Fix - docstrings. + (org-export-with-timestamps, org-export-with-todo-keywords): + Fix docstrings. * ox-html.el (org-html-postamble-format): Slightly change default value so "Generated by" string doesn't get duplicated. @@ -5379,8 +5428,8 @@ (org-export--dispatch-ui, org-export--dispatch-action): Access to the function through the dispatcher. - * ox-icalendar.el (org-icalendar-convert-timestamp): Update - docstring. + * ox-icalendar.el (org-icalendar-convert-timestamp): + Update docstring. (org-icalendar-dtstamp): New function. (org-icalendar--vevent, org-icalendar--vtodo): Use new function. @@ -5425,7 +5474,7 @@ (org-macro-initialize-templates): Apply signature change from function above. - * ox.el (org-export--list-bound-variables): Renamed from + * ox.el (org-export--list-bound-variables): Rename from `org-export--install-letbind-maybe'. Though, only return list of bound variables instead of installing them as buffer-local variables. @@ -5486,8 +5535,8 @@ * ox-man.el (org-man-table--org-table): Use new attribute syntax. Small refactoring. - * ox-odt.el (org-odt-link--inline-image, org-odt-table-cell): Use - new attribute syntax. + * ox-odt.el (org-odt-link--inline-image, org-odt-table-cell): + Use new attribute syntax. * ox.el (org-export-async-start): Remove code evaluation queries from asynchronous export. @@ -5522,8 +5571,8 @@ * ox-latex.el (org-latex-inline-image-rules) (org-latex-default-table-environment) (org-latex-default-table-mode, org-latex-tables-booktabs) - (org-latex-table-scientific-notation, org-latex-known-errors): Add - :version and :package-version. + (org-latex-table-scientific-notation, org-latex-known-errors): + Add :version and :package-version. * ox-md.el (org-md-headline-style): Add :version and :package-version. @@ -5534,8 +5583,8 @@ * ox.el (org-export-with-drawers, org-export-with-latex) (org-export-with-inlinetasks, org-export-with-planning) (org-export-with-smart-quotes, org-export-with-statistics-cookies) - (org-export-allow-bind-keywords, org-export-async-init-file): Add - :version and :package-version. + (org-export-allow-bind-keywords, org-export-async-init-file): + Add :version and :package-version. * ox-icalendar.el (org-icalendar-export-to-ics): Change back-end name from `e-ascii' to `ascii'. @@ -5564,13 +5613,13 @@ * org.el (org-fill-paragraph): Small refactoring to `org-fill-paragraph'. Do not look for table cells in a paragraph. - * org-element.el (org-element-object-restrictions): Simplify - restrictions within secondary strings and objects. + * org-element.el (org-element-object-restrictions): + Simplify restrictions within secondary strings and objects. * org-list.el (org-list-send-list): Do not rely on `org-list-parse-list'. - (org-list-to-latex, org-list-to-html, org-list-to-texinfo): Use - appropriate export back-end instead of using + (org-list-to-latex, org-list-to-html, org-list-to-texinfo): + Use appropriate export back-end instead of using `org-list-to-generic'. * ox-html.el (org-html-inner-template): Remove contents div and @@ -5612,9 +5661,9 @@ (org-icalendar-export-current-agenda): Integrate previous functions. - * ox-latex.el (org-latex-format-headline-default-function): Use - declarative shape to nest makup for TODO keywords. Previous - syntax generated errors during export. + * ox-latex.el (org-latex-format-headline-default-function): + Use declarative shape to nest makup for TODO keywords. + Previous syntax generated errors during export. * ox.el (org-export-async-start): Ignore `org-mode-hook' and `kill-emacs-hook'. The first one has been run in the original @@ -5628,14 +5677,14 @@ computing minimal headline level. * org.el (org-do-latex-and-related): Fix infloop when user - provides a wrong value for `org-highlight-latex-and-related'. In - this case, `org-latex-and-related-regexp' is the empty string and + provides a wrong value for `org-highlight-latex-and-related'. + In this case, `org-latex-and-related-regexp' is the empty string and generates an infloop since matching it doesn't move point. - * org-element.el (org-element-headline-parser): Rename - :optional-title into :alt-title. + * org-element.el (org-element-headline-parser): + Rename :optional-title into :alt-title. - * ox.el (org-export-get-alt-title): Renamed from + * ox.el (org-export-get-alt-title): Rename from `org-export-get-optional-title'. * ox-ascii.el (org-ascii--build-title): @@ -5655,8 +5704,8 @@ * ox-latex.el (org-latex-compile): Add an optional argument for latex snippet previewing. - * org.el (org-create-formula-image-with-imagemagick): Use - `org-latex-compile' instead of rewriting it. + * org.el (org-create-formula-image-with-imagemagick): + Use `org-latex-compile' instead of rewriting it. * ox-html.el (org-html-fontify-code): Do not use [^\000] in regexps that may match large strings. @@ -5675,8 +5724,8 @@ (org-element-plain-link-successor): New function. * org.el (org-match-substring-regexp) - (org-match-substring-with-braces-regexp): Update regexp. A - sub/superscript cannot start anymore at the beginning of the line + (org-match-substring-with-braces-regexp): Update regexp. + A sub/superscript cannot start anymore at the beginning of the line or after a space. * org-element.el (org-element--get-next-object-candidates): @@ -5704,13 +5753,13 @@ * ox-html.el (org-html--format-toc-headline): Fix function name. (org-html-toc, org-html--toc-text): Change to docstring. - (org-html-list-of-listings, org-html-list-of-tables): New - functions. + (org-html-list-of-listings, org-html-list-of-tables): + New functions. (org-html-keyword): Use new functions. (org-html-src-block): Add an ID attribute when a name is given. - * org-element.el (org-element-footnote-definition-parser): Require - 2 blank lines to separate footnote definition. + * org-element.el (org-element-footnote-definition-parser): + Require 2 blank lines to separate footnote definition. * org-footnote.el (org-footnote-at-definition-p): Require 2 blank lines to separate footnote definition. @@ -5719,8 +5768,8 @@ (org-export-stack-refresh): Refactor. (org-export-stack-remove, org-export-stack-view): Apply renaming. (org-export-stack-mode-map): Use tabulated list map as a basis. - (org-export-stack--generate, org-export-stack--num-predicate): New - function. + (org-export-stack--generate, org-export-stack--num-predicate): + New function. (org-export-get-optional-title): Return regular title when no optional title is found. @@ -5733,17 +5782,17 @@ * ox-latex.el (org-latex-headline): Apply change to `org-export-get-optional-title'. - * ox-ascii.el (org-ascii--build-title): Add an argument. Use - optional title when building a toc line. + * ox-ascii.el (org-ascii--build-title): Add an argument. + Use optional title when building a toc line. (org-ascii--build-toc): Call `org-ascii--build-title' with appropriate arguments. * ox-latex.el (org-latex-headline): Use optional title for table of contents. - * ox-html.el (org-html--toc-text): Renamed from + * ox-html.el (org-html--toc-text): Rename from `org-html-toc-text'. Add docstring. - (org-html--format-toc-headline): Renamed from + (org-html--format-toc-headline): Rename from `org-html-format-toc-headline'. Add docstring. Use optional title if possible. (org-html-toc): Add docstring. @@ -5754,18 +5803,18 @@ * ox.el (org-export-get-optional-title): New function. - * ox-latex.el (org-latex-format-headline-default-function): Make - the variable a function. + * ox-latex.el (org-latex-format-headline-default-function): + Make the variable a function. - * ox-publish.el (org-publish-resolve-external-fuzzy-link): No - error when resolving external fuzzy links outside publishing. + * ox-publish.el (org-publish-resolve-external-fuzzy-link): + No error when resolving external fuzzy links outside publishing. Though search option for these links will not be resolved. * ox-latex.el (org-latex-guess-inputenc): Set inputenc option according to `org-export-coding-system'. - * ox.el (org-export--generate-copy-script): Clone - `buffer-file-coding-system' when creating a buffer copy. + * ox.el (org-export--generate-copy-script): + Clone `buffer-file-coding-system' when creating a buffer copy. * ox-html.el (org-html-link): Resolve external links with search options like [[file.org::#custom-id]] or @@ -5786,8 +5835,8 @@ * ox-latex.el (org-latex-property-drawer): Remove function. - * ox-ascii.el (org-ascii-filter-paragraph-spacing): Remove - reference to now renamed `e-ascii' back-end. + * ox-ascii.el (org-ascii-filter-paragraph-spacing): + Remove reference to now renamed `e-ascii' back-end. * ox-beamer.el (org-beamer-template): Allow to span documentclass options accross multiple lines in template. @@ -5859,13 +5908,13 @@ * org-element.el (org-element-map): Allow to map over any list. Do not restrict mapping to object types. - * org-faces.el (org-latex-and-related): Renamed from + * org-faces.el (org-latex-and-related): Rename from `org-latex-and-export-specials', which wasn't appropriate anymore. * org.el (org-highlight-latex-and-related) (org-latex-and-related-regexp): New variables. - (org-compute-latex-and-related-regexp, org-do-latex-and-related): New - function, revived from a previous commit. + (org-compute-latex-and-related-regexp, org-do-latex-and-related): + New function, revived from a previous commit. (org-set-regexps-and-options, org-set-font-lock-defaults): Use new functions. (org-set-regexps-and-options): Remove reference to LATEX_CLASS and @@ -5905,9 +5954,9 @@ * org-element.el (org-element-link-parser): Do not remove newlines characters in paths anymore, since this is not required. - * ox.el (org-export--dispatch-ui): Renamed from + * ox.el (org-export--dispatch-ui): Rename from `org-export-dispatch-ui'. Handle scrolling. - (org-export--dispatch-action): Renamed from + (org-export--dispatch-action): Rename from `org-export-dispatch-action'. Implement scrolling. (org-export-dispatch): Apply renaming. @@ -5930,16 +5979,16 @@ * ox.el (org-export-stack-mode): Fix docstring. - * org-pcomplete.el (pcomplete/org-mode/file-option): Allow - completion for ATTR_ prefixed keywords. + * org-pcomplete.el (pcomplete/org-mode/file-option): + Allow completion for ATTR_ prefixed keywords. * org.el (org-options-keywords): Add missing colons. - * org-macs.el (org-default-options): Removed function. + * org-macs.el (org-default-options): Remove function. * org-pcomplete.el (org-command-at-point): Fix bug with some file options. - (pcomplete/org-mode/file-option/x): Removed macro. + (pcomplete/org-mode/file-option/x): Remove macro. (pcomplete/org-mode/file-option): Refactor code. (pcomplete/org-mode/file-option/author) (pcomplete/org-mode/file-option/date) @@ -5962,8 +6011,8 @@ * ox-ascii.el (org-ascii-inner-template): New function. (org-ascii-template): Use new function. - (org-ascii-export-as-ascii, org-ascii-export-to-ascii): Update - docstring. + (org-ascii-export-as-ascii, org-ascii-export-to-ascii): + Update docstring. * org-element.el (org-element-link-parser): Take into consideration links filled and indented. @@ -5997,7 +6046,7 @@ * org-element.el (org-element-nested-p): Do not inline function. * ox.el (org-export-copy-buffer, org-export-with-buffer-copy) - (org-export--generate-copy-script): Moved earlier in the file. + (org-export--generate-copy-script): Move earlier in the file. * ox-texinfo.el (org-texinfo-link): Do not transform path part of internal links. @@ -6045,10 +6094,10 @@ required in the external process. * org.el (org-format-latex-header-extra, org-export-have-math): - Removed variables. - (org-latex-default-packages-alist): Renamed from + Remove variables. + (org-latex-default-packages-alist): Rename from `org-export-latex-default-packages-alist'. - (org-latex-packages-alist): Renamed from + (org-latex-packages-alist): Rename from `org-export-latex-packages-alist'. (org-try-cdlatex-tab, org-cdlatex-underscore-caret, org-cdlatex-math-modify): Reorder in file. @@ -6059,10 +6108,10 @@ * org-entities.el (org-entities-user): Update docstring. - * ox-latex.el (org-latex-classes, org-latex-listings): Update - docstring. - (org-latex-guess-inputenc): Renamed from `org-latex--guess-inputenc'. - (org-latex-guess-babel-language): Renamed from + * ox-latex.el (org-latex-classes, org-latex-listings): + Update docstring. + (org-latex-guess-inputenc): Rename from `org-latex--guess-inputenc'. + (org-latex-guess-babel-language): Rename from `org-latex--guess-babel-language'. (org-latex-template): Apply renaming. @@ -6074,8 +6123,8 @@ copying it. * org-macs.el (org-if-unprotected, org-if-unprotected-1) - (org-if-unprotected-at): Removed macros. - (org-re-search-forward-unprotected): Removed function. + (org-if-unprotected-at): Remove macros. + (org-re-search-forward-unprotected): Remove function. * org.el (org-format-latex): * org-list.el (org-list-struct): @@ -6083,7 +6132,7 @@ * org-capture.el (org-capture-fill-template): Remove reference to `org-protected'. - * ob-exp.el (org-babel-exp-process-buffer): Renamed from + * ob-exp.el (org-babel-exp-process-buffer): Rename from `org-export-blocks-preprocess'. * ox.el (org-export-execute-babel-code): Apply previous renaming. @@ -6093,11 +6142,11 @@ framework. (pcomplete/org-mode/file-option/options): Rewrite using new export framework. Only complete up to the colon. - (pcomplete/org-mode/file-option/x): Removed macro. + (pcomplete/org-mode/file-option/x): Remove macro. (pcomplete/org-mode/file-option/title) (pcomplete/org-mode/file-option/author) (pcomplete/org-mode/file-option/email) - (pcomplete/org-mode/file-option/date): Removed functions. + (pcomplete/org-mode/file-option/date): Remove functions. (pcomplete/org-mode/file-option/infojs_opt): New function. * org-clock.el (org-clocktable-defaults) @@ -6109,8 +6158,8 @@ function. * org-inlinetask.el (org-inlinetask-export) - (org-inlinetask-export-templates): Removed variables. - (org-inlinetask-export-handler): Removed function. + (org-inlinetask-export-templates): Remove variables. + (org-inlinetask-export-handler): Remove function. * org-plot.el: Remove dependency on `org-exp' library. @@ -6141,8 +6190,8 @@ * org-agenda.el (org-agenda-menu, org-agenda-write): Use new iCalendar export back-end. - * org-table.el (org-table-export, orgtbl-export): Remove - dependency on `org-exp' library. + * org-table.el (org-table-export, orgtbl-export): + Remove dependency on `org-exp' library. (org-table-clean-before-export): New function. (org-table-colgroup-info): New variable. (orgtbl-to-html): Use to new HTML export back-end. @@ -6196,19 +6245,19 @@ Elements. * org-element.el (org-element-at-point): When point is before any - element, in the first blank lines of the buffer, return nil. When - point is within blank lines just after a headline, return that + element, in the first blank lines of the buffer, return nil. + When point is within blank lines just after a headline, return that headline. (org-element-context): Return nil when point is within the blank at the beginning of the buffer. * org.el (org-edit-special): Fix regression. (org-timestamp-has-time-p, org-timestamp-format) - (org-timestamp-split-range, org-timestamp-translate): New - functions. + (org-timestamp-split-range, org-timestamp-translate): + New functions. - * org-element.el (org-element-timestamp-interpreter): Interpret - timestamps ranges with repeaters. + * org-element.el (org-element-timestamp-interpreter): + Interpret timestamps ranges with repeaters. * org.el (org-edit-special): Rewrite `org-edit-special' using Org Elements tools. Behavior should be unchanged. @@ -6235,12 +6284,12 @@ * org.el (org-all-targets): Fix radio targets detection when object is directly followed by a non-whitespace character. - * ob.el (org-babel-use-quick-and-dirty-noweb-expansion): Renamed - from `org-babel-use-quick-and-dirty-noweb-expansion'. + * ob.el (org-babel-use-quick-and-dirty-noweb-expansion): + Rename from `org-babel-use-quick-and-dirty-noweb-expansion'. (org-babel-expand-noweb-references): Use new variable name. - * org-element.el (org-element-timestamp-interpreter): Fix - timestamp interpreter when raw value isn't available. + * org-element.el (org-element-timestamp-interpreter): + Fix timestamp interpreter when raw value isn't available. * ob-exp.el (org-babel-exp-non-block-elements): Make sure to parse inline babel call or inline src block instead of the following @@ -6306,8 +6355,8 @@ (org-element-horizontal-rule-parser, org-element-keyword-parser) (org-element-latex-environment-parser) (org-element-paragraph-parser, org-element-src-block-parser) - (org-element-table-parser, org-element-verse-block-parser): Add - `:post-affiliated' property to elements. + (org-element-table-parser, org-element-verse-block-parser): + Add `:post-affiliated' property to elements. (org-element-inlinetask-parser): Remove affilated keywords. * org.el (org-adaptive-fill-function): Use new property. @@ -6329,8 +6378,8 @@ (org-element--current-element): Tiny refactoring. * ob.el (org-babel-where-is-src-block-result): Insert new results - keyword in current narrowed part of buffer, if necessary. Small - refactoring. + keyword in current narrowed part of buffer, if necessary. + Small refactoring. (org-babel-insert-result): Do not widen buffer when new results have to be inserted. Therefore, results inserted after the last block of a narrowed buffer still belong to the narrowed part of the buffer. @@ -6344,8 +6393,8 @@ (org-element-diary-sexp-parser) (org-element-diary-sexp-interpreter): New functions. (org-element-horizontal-rule-parser) - (org-element-keyword-parser, org-element--current-element): Small - refactoring. + (org-element-keyword-parser, org-element--current-element): + Small refactoring. (org-element-property): Access to text properties when argument is a string. (org-element-put-property): Correctly set property when target is @@ -6368,8 +6417,8 @@ * org.el (org-all-targets): Make sure the regexp really matched a radio target. - (org-macro-expand, org-macro-replace-all): Change signature. The - function now accepts an alist of templates so it doesn't have to + (org-macro-expand, org-macro-replace-all): Change signature. + The function now accepts an alist of templates so it doesn't have to rely only on `org-macro-templates'. (org-macro-initialize-templates): {{{date}}} is not anymore an alias for {{{time}}}. During export, it will provide the value @@ -6434,15 +6483,15 @@ * org-exp-blocks.el: Delete. * ob-exp.el (org-export-blocks-preprocess): - * ob-ditaa.el (org-ditaa-jar-path): Moved from + * ob-ditaa.el (org-ditaa-jar-path): Move from "org-export-blocks.el". * ob-exp.el (org-babel-exp-src-block): Remove unused argument. (org-babel-exp-non-block-elements): Rewrite function using Org Element. - * org-exp-blocks.el (org-export-blocks-preprocess): Rewrite - function using Org Element. + * org-exp-blocks.el (org-export-blocks-preprocess): + Rewrite function using Org Element. * org-element.el (org-element-recursive-objects) (org-element-object-restrictions): Remove `macro' from recursive @@ -6511,8 +6560,8 @@ same style. Make all anchors font-size %100. Remove margin from the content section. (org-html-container-element): Fix docstring. - (org-html-postamble-format, org-html-preamble-format): Update - docstrings. + (org-html-postamble-format, org-html-preamble-format): + Update docstrings. (org-html-template): Use `org-html--build-pre/postamble'. (org-html--build-pre/postamble): New function, combining the pre/postamble generator. Merge lists of formatters from the @@ -6528,9 +6577,9 @@ (org-html-divs): Change to alist of three entries each containing a key ('preamble, 'content, 'postamble), an HTML element type and an id to allow setting container elements. - (org-html--build-preamble, org-html--build-postamble): Modified to + (org-html--build-preamble, org-html--build-postamble): Modify to use `org-html-divs'. - (org-html-template): Modified to use doctype and container-element + (org-html-template): Modify to use doctype and container-element settings. (org-export-define-backend): Add css url option. (org-export-htmlized-org-css-url): Modify docstring and options. @@ -6550,8 +6599,8 @@ * ob-tangle.el (org-babel-tangle-collect-blocks): Change argument name collid `org-babel-map-src-blocks' variable 'lang'. - * org-protocol.el (org-protocol-convert-query-to-plist): New - function. + * org-protocol.el (org-protocol-convert-query-to-plist): + New function. (org-protocol-do-capture): Use new function. (org-protocol-data-separator): Change default separator. @@ -6656,7 +6705,7 @@ (org-mew-open-by-message-id, org-mew-search, org-mew-capture) (org-mew-capture-guess-selection-keys): New functions. -2013-11-12 Trevor Murphy <trevor.m.murphy@gmail.com> (tiny change) +2013-11-12 Trevor Murphy <trevor.m.murphy@gmail.com> * org.el (org-get-compact-tod): Always pad minutes to two places. @@ -6667,12 +6716,12 @@ 2013-11-12 Vitalie Spinu <spinuvit@gmail.com> - * ob-tangle.el (org-babel-find-file-noselect-refresh): Call - `find-file-noselect' with 'nowarn argument to surpress + * ob-tangle.el (org-babel-find-file-noselect-refresh): + Call `find-file-noselect' with 'nowarn argument to surpress `yes-or-no-p' reversion message. - * ob-core.el (org-babel-where-is-src-block-head): Return - `point-marker' instead of `point'. + * ob-core.el (org-babel-where-is-src-block-head): + Return `point-marker' instead of `point'. 2013-11-12 Yann Hodique <yann.hodique@gmail.com> @@ -6708,8 +6757,8 @@ if result is not a string and not nil. If the result is nil, treat it as if it was the empty string. - * org-clock.el (org-clock-notify-once-if-expired): Honor - `org-clock-sound'. + * org-clock.el (org-clock-notify-once-if-expired): + Honor `org-clock-sound'. 2013-11-12 Rasmus Pank <rasmus.pank@gmail.com> @@ -6731,23 +6780,23 @@ * ob-C.el: Added C++ to `org-babel-load-languages' automatically after loading C. - * org-src.el (org-src-lang-modes): Added association between + * org-src.el (org-src-lang-modes): Add association between language C++ and `c++-mode'. - * ox.el (org-export-smart-quotes-alist): Added ("da" "no" "nb" + * ox.el (org-export-smart-quotes-alist): Add ("da" "no" "nb" "nn" "sv"). - (org-export-dictionary): Added some entries ("da" "no" "nb" "nn" + (org-export-dictionary): Add some entries ("da" "no" "nb" "nn" "sv"). (org-export-default-language): Mention other variables affected by language. - * ox-latex.el (org-latex-babel-language-alist): Added 'nb', 'nn', + * ox-latex.el (org-latex-babel-language-alist): Add 'nb', 'nn', and 'no' for Norwegian. Removed 'no-no'. (org-latex-pdf-process): let `latexmk' be a preconfigured choice and change the wording of the docstring. (org-latex-guess-babel-language): Replace AUTO with language if AUTO is the option of the LaTeX package Babel. - (org-latex-classes): Updated documentation with respect + (org-latex-classes): Update documentation with respect to `org-latex-guess-babel-language'. 2013-11-12 Дядов Васил Стоянов <vdyadov@elvees.com> (tiny change) @@ -10324,7 +10373,7 @@ * org-clock.el (org-clock-idle-time): Org-mode assumed that x11idle was an available command, and returned an idle time of 0 if it was not - (never idle): Added checks so that org-idle-time will come from + (never idle): Add checks so that org-idle-time will come from emacs' own current-idle-time if x11idle cannot be found or if it cannot retrieve the idle time from X11 @@ -13584,7 +13633,7 @@ * ob.el (org-babel-params-from-properties): Now splits multiple var arguments behind a single ":var". - (org-babel-balanced-split): Separated balanced splitting of + (org-babel-balanced-split): Separate balanced splitting of strings out into a new function. (org-babel-parse-multiple-vars): Splits multiple var arguments behind a single ":var". @@ -19343,8 +19392,8 @@ 2011-07-28 Bastien Guerry <bzg@gnu.org> - * org-agenda.el (org-agenda-repeating-timestamp-show-all): Allow - to use a list of TODO keywords as the value of this variable. + * org-agenda.el (org-agenda-repeating-timestamp-show-all): + Allow to use a list of TODO keywords as the value of this variable. The agenda will show repeating stamps for entries matching these TODO keywords. (org-agenda-get-timestamps, org-agenda-get-deadlines) @@ -21375,7 +21424,7 @@ 2010-11-11 Eric Schulte <schulte.eric@gmail.com> - * ob-exp.el (org-babel-exp-results): Replaced old function call. + * ob-exp.el (org-babel-exp-results): Replace old function call. 2010-11-11 Eric Schulte <schulte.eric@gmail.com> @@ -21568,7 +21617,7 @@ 2010-11-11 Noorul Islam <noorul@noorul.com> - * org-latex.el (org-export-latex-links): Replaced hard coded + * org-latex.el (org-export-latex-links): Replace hard coded hyperref format with custom variable `org-export-latex-hyperref-format'. diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index 846d435e9a4..fd144629838 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -2040,8 +2040,8 @@ code ---- the results are extracted in the syntax of the source t info hash indent))) (results-switches (cdr (assoc :results_switches (nth 2 info)))) - (visible-beg (copy-marker (point-min))) - (visible-end (copy-marker (point-max))) + (visible-beg (point-min-marker)) + (visible-end (point-max-marker)) ;; When results exist outside of the current visible ;; region of the buffer, be sure to widen buffer to ;; update them. diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el index 115607d6076..2637623abba 100644 --- a/lisp/org/org-archive.el +++ b/lisp/org/org-archive.el @@ -231,8 +231,7 @@ this heading." (error "No file associated to buffer")))) (olpath (mapconcat 'identity (org-get-outline-path) "/")) (time (format-time-string - (substring (cdr org-time-stamp-formats) 1 -1) - (current-time))) + (substring (cdr org-time-stamp-formats) 1 -1))) category todo priority ltags itags atags ;; end of variables that will be used for saving context location afile heading buffer level newfile-p infile-p visiting @@ -441,8 +440,7 @@ sibling does not exist, it will be created at the end of the subtree." (org-set-property "ARCHIVE_TIME" (format-time-string - (substring (cdr org-time-stamp-formats) 1 -1) - (current-time))) + (substring (cdr org-time-stamp-formats) 1 -1))) (outline-up-heading 1 t) (hide-subtree) (org-cycle-show-empty-lines 'folded) diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index b4f44035fba..d21d270b835 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -1046,9 +1046,9 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling (lambda (clock) (format "Dangling clock started %d mins ago" - (floor - (/ (- (org-float-time (current-time)) - (org-float-time (cdr clock))) 60)))))) + (floor (- (org-float-time) + (org-float-time (cdr clock))) + 60))))) (or last-valid (cdr clock))))))))))) @@ -1368,7 +1368,7 @@ decides which time to use." (current-time)) ((equal cmt "today") (setq org--msg-extra "showing today's task time.") - (let* ((dt (decode-time (current-time)))) + (let* ((dt (decode-time))) (setq dt (append (list 0 0 0) (nthcdr 3 dt))) (if org-extend-today-until (setf (nth 2 dt) org-extend-today-until)) @@ -1927,7 +1927,7 @@ fontified, and then returned." (org-mode) (org-create-dblock props) (org-update-dblock) - (font-lock-fontify-buffer) + (org-font-lock-ensure) (forward-line 2) (buffer-substring (point) (progn (re-search-forward "^[ \t]*#\\+END" nil t) @@ -2029,7 +2029,7 @@ If MSTART is non-nil, use this number to specify the starting day of a month (1 is the first day of the month). If you can combine both, the month starting day will have priority." (if (integerp key) (setq key (intern (number-to-string key)))) - (let* ((tm (decode-time (or time (current-time)))) + (let* ((tm (decode-time time)) (s 0) (m (nth 1 tm)) (h (nth 2 tm)) (d (nth 3 tm)) (month (nth 4 tm)) (y (nth 5 tm)) (dow (nth 6 tm)) @@ -2670,10 +2670,8 @@ TIME: The sum of all time spend in this tree, in minutes. This time (when (and te (listp te)) (setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te)))) ;; Now the times are strings we can parse. - (if ts (setq ts (org-float-time - (seconds-to-time (org-matcher-time ts))))) - (if te (setq te (org-float-time - (seconds-to-time (org-matcher-time te))))) + (if ts (setq ts (org-matcher-time ts))) + (if te (setq te (org-matcher-time te))) (save-excursion (org-clock-sum ts te (unless (null matcher) @@ -2813,8 +2811,8 @@ The details of what will be saved are regulated by the variable (delete-region (point-min) (point-max)) ;;Store clock (insert (format ";; org-persist.el - %s at %s\n" - system-name (format-time-string - (cdr org-time-stamp-formats)))) + (system-name) (format-time-string + (cdr org-time-stamp-formats)))) (if (and (memq org-clock-persist '(t clock)) (setq b (org-clocking-buffer)) (setq b (or (buffer-base-buffer b) b)) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index 831ea945a4e..9c92903314a 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -295,7 +295,7 @@ Works on both Emacs and XEmacs." (setq mark-active t) (when (and (boundp 'transient-mark-mode) (not transient-mark-mode)) - (setq transient-mark-mode 'lambda)) + (set (make-local-variable 'transient-mark-mode) 'lambda)) (when (boundp 'zmacs-regions) (setq zmacs-regions t))))) @@ -411,12 +411,8 @@ Pass BUFFER to the XEmacs version of `move-to-column'." (when focus-follows-mouse (set-mouse-position frame (1- (frame-width frame)) 0))))) -(defun org-float-time (&optional time) - "Convert time value TIME to a floating point number. -TIME defaults to the current time." - (if (featurep 'xemacs) - (time-to-seconds (or time (current-time))) - (float-time time))) +(defalias 'org-float-time + (if (featurep 'xemacs) 'time-to-seconds 'float-time)) ;; `user-error' is only available from 24.2.50 on (unless (fboundp 'user-error) @@ -478,6 +474,11 @@ LIMIT." (looking-at (concat "\\(?:" regexp "\\)\\'"))))) (not (null pos))))) +(defalias 'org-font-lock-ensure + (if (fboundp 'org-font-lock-ensure) + #'font-lock-ensure + (lambda (_beg _end) (font-lock-fontify-buffer)))) + (defun org-floor* (x &optional y) "Return a list of the floor of X and the fractional part of X. With two arguments, return floor and remainder of their quotient." diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index 54a56cfb416..160099ff055 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -1008,7 +1008,7 @@ This means, between the beginning of line and the point." (let ((endmarker (with-current-buffer buffer (org-end-of-subtree nil t) (unless (eobp) (forward-char 1)) - (copy-marker (point))))) + (point-marker)))) (org-with-remote-undo buffer (with-current-buffer buffer (widen) @@ -1018,7 +1018,7 @@ This means, between the beginning of line and the point." (and (outline-next-heading) (org-flag-heading nil))) ; show the next heading (org-back-to-heading) - (setq marker (copy-marker (point))) + (setq marker (point-marker)) (goto-char (max (point-at-bol) (- (point-at-eol) anticol))) (funcall command) (message "_cmd: %S" org-mouse-cmd) diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 62dcd5f8f91..5c2ceaf341b 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -918,7 +918,7 @@ fontification of code blocks see `org-src-fontify-block' and (delete-region (point-min) (point-max)) (insert string " ") ;; so there's a final property change (unless (eq major-mode lang-mode) (funcall lang-mode)) - (font-lock-fontify-buffer) + (org-font-lock-ensure) (setq pos (point-min)) (while (setq next (next-single-property-change pos 'face)) (put-text-property diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 133882b3843..d84c51bbbc3 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -2351,7 +2351,7 @@ For all numbers larger than LIMIT, shift them by DELTA." (string-match "^[a-zA-Z][_a-zA-Z0-9]*$" field)) (push (cons field v) org-table-local-parameters) (push (list field line col) org-table-named-field-locations)))) - ;; Analyse the line types + ;; Analyze the line types. (goto-char beg) (setq org-table-current-begin-line (org-current-line) org-table-current-begin-pos (point) @@ -3183,9 +3183,9 @@ with the prefix ARG." (save-excursion ;; Insert a temporary formula at right after the table (goto-char (org-table-TBLFM-begin)) - (setq s (set-marker (make-marker) (point))) + (setq s (point-marker)) (insert (concat formula "\n")) - (setq e (set-marker (make-marker) (point))) + (setq e (point-marker)) ;; Recalculate the table (beginning-of-line 0) ; move to the inserted line (skip-chars-backward " \r\n\t") diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el index 2d131d541d7..55717ab7b03 100644 --- a/lisp/org/org-timer.el +++ b/lisp/org/org-timer.el @@ -195,8 +195,8 @@ it in the buffer." (defun org-timer-seconds () (if org-timer-timer-is-countdown (- (org-float-time org-timer-start-time) - (org-float-time (current-time))) - (- (org-float-time (or org-timer-pause-time (current-time))) + (org-float-time)) + (- (org-float-time org-timer-pause-time) (org-float-time org-timer-start-time)))) ;;;###autoload diff --git a/lisp/org/org.el b/lisp/org/org.el index ae4c3904573..3e032d46646 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -6371,7 +6371,7 @@ needs to be inserted at a specific position in the font-lock sequence.") (insert s) (let ((org-odd-levels-only odd-levels)) (org-mode) - (font-lock-fontify-buffer) + (org-font-lock-ensure) (buffer-string)))) (defvar org-m nil) @@ -7571,7 +7571,7 @@ headline or the item and create a new headline/item with the text in the current line after point \(see `org-M-RET-may-split-line' on how to modify this behavior). -With one universal prefirx argument, set the user option +With one universal prefix argument, set the user option `org-insert-heading-respect-content' to t for the duration of the command. This modifies the behavior described above in this ways: on list items and at the beginning of normal lines, force @@ -16490,7 +16490,7 @@ user." (defun org-read-date-analyze (ans org-def org-defdecode) "Analyze the combined answer of the date prompt." ;; FIXME: cleanup and comment - (let ((nowdecode (decode-time (current-time))) + (let ((nowdecode (decode-time)) delta deltan deltaw deltadef year month day hour minute second wday pm h2 m2 tl wday1 iso-year iso-weekday iso-week iso-year iso-date futurep kill-year) @@ -16648,7 +16648,7 @@ user." (deltan (setq futurep nil) (unless deltadef - (let ((now (decode-time (current-time)))) + (let ((now (decode-time))) (setq day (nth 3 now) month (nth 4 now) year (nth 5 now)))) (cond ((member deltaw '("d" "")) (setq day (+ day deltan))) ((equal deltaw "w") (setq day (+ day (* 7 deltan)))) @@ -19148,7 +19148,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\M-f" 'org-next-block) (org-defkey org-mode-map "\C-c\M-b" 'org-previous-block) (org-defkey org-mode-map "\C-c$" 'org-archive-subtree) -(org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree) +(org-defkey org-mode-map "\C-c\C-x\C-s" 'org-archive-subtree) (org-defkey org-mode-map "\C-c\C-x\C-a" 'org-archive-subtree-default) (org-defkey org-mode-map "\C-c\C-xd" 'org-insert-drawer) (org-defkey org-mode-map "\C-c\C-xa" 'org-toggle-archive-tag) @@ -20348,7 +20348,7 @@ This command does many different things, depending on context: (item ;; At an item: a double C-u set checkbox to "[-]" ;; unconditionally, whereas a single one will toggle its - ;; presence. Without an universal argument, if the item + ;; presence. Without a universal argument, if the item ;; has a checkbox, toggle it. Otherwise repair the list. (let* ((box (org-element-property :checkbox context)) (struct (org-element-property :structure context)) @@ -20943,7 +20943,7 @@ on context. See the individual commands for more information." ("Archive" ["Archive (default method)" org-archive-subtree-default (org-in-subtree-not-table-p)] "--" - ["Move Subtree to Archive file" org-advertized-archive-subtree (org-in-subtree-not-table-p)] + ["Move Subtree to Archive file" org-archive-subtree (org-in-subtree-not-table-p)] ["Toggle ARCHIVE tag" org-toggle-archive-tag (org-in-subtree-not-table-p)] ["Move subtree to Archive sibling" org-archive-to-archive-sibling (org-in-subtree-not-table-p)] ) @@ -22062,8 +22062,9 @@ the agenda) or the current time of the day." (when (and tp (string-match "\\([0-9][0-9]\\):\\([0-9][0-9]\\)" tp)) (setq hod (string-to-number (match-string 1 tp)) mod (string-to-number (match-string 2 tp)))) - (or tp (setq hod (nth 2 (decode-time (current-time))) - mod (nth 1 (decode-time (current-time)))))) + (or tp (let ((now (decode-time))) + (setq hod (nth 2 now) + mod (nth 1 now))))) (cond ((eq major-mode 'calendar-mode) (setq date (calendar-cursor-to-date) diff --git a/lisp/org/ox-ascii.el b/lisp/org/ox-ascii.el index 61a47448781..65b6f7528dd 100644 --- a/lisp/org/ox-ascii.el +++ b/lisp/org/ox-ascii.el @@ -185,7 +185,7 @@ original Org buffer at the same place." :package-version '(Org . "8.0") :type '(choice (const :tag "Replicate original spacing" nil) - (cons :tag "Set an uniform spacing" + (cons :tag "Set a uniform spacing" (integer :tag "Number of blank lines before contents") (integer :tag "Number of blank lines after contents")))) diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el index 78da031142d..36984b5cc37 100644 --- a/lisp/org/ox-html.el +++ b/lisp/org/ox-html.el @@ -1630,8 +1630,7 @@ used in the preamble or postamble." (?c . ,(plist-get info :creator)) (?C . ,(let ((file (plist-get info :input-file))) (format-time-string org-html-metadata-timestamp-format - (if file (nth 5 (file-attributes file)) - (current-time))))) + (if file (nth 5 (file-attributes file)))))) (?v . ,(or org-html-validation-link "")))) (defun org-html--build-pre/postamble (type info) @@ -1856,7 +1855,7 @@ is the language used for CODE, as a string, or nil." (funcall lang-mode) (insert code) ;; Fontify buffer. - (font-lock-fontify-buffer) + (org-font-lock-ensure) ;; Remove formatting on newline characters. (save-excursion (let ((beg (point-min)) diff --git a/lisp/org/ox-icalendar.el b/lisp/org/ox-icalendar.el index c32b1c9cb35..a77eaedb9a0 100644 --- a/lisp/org/ox-icalendar.el +++ b/lisp/org/ox-icalendar.el @@ -678,7 +678,7 @@ Return VTODO component as a string." (org-element-property :scheduled entry)) ;; If we can't use a scheduled time for some ;; reason, start task now. - (let ((now (decode-time (current-time)))) + (let ((now (decode-time))) (list 'timestamp (list :type 'active :minute-start (nth 1 now) diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el index 54fc42e2df7..29bc87875a1 100644 --- a/lisp/org/ox-odt.el +++ b/lisp/org/ox-odt.el @@ -3139,7 +3139,7 @@ and prefix with \"OrgSrc\". For example, (with-temp-buffer (insert code) (funcall lang-mode) - (font-lock-fontify-buffer) + (org-font-lock-ensure) (buffer-string)))) (fontifier (if use-htmlfontify-p 'org-odt-htmlfontify-string 'org-odt--encode-plain-text)) diff --git a/lisp/org/ox-org.el b/lisp/org/ox-org.el index 76485051703..5904ca2cc72 100644 --- a/lisp/org/ox-org.el +++ b/lisp/org/ox-org.el @@ -251,12 +251,13 @@ Return output file name." (html-ext (concat "." (or (plist-get plist :html-extension) org-html-extension "html"))) (visitingp (find-buffer-visiting filename)) - (work-buffer (or visitingp (find-file filename))) + (work-buffer (or visitingp (find-file-noselect filename))) newbuf) - (font-lock-fontify-buffer) - (show-all) - (org-show-block-all) - (setq newbuf (htmlize-buffer)) + (with-current-buffer work-buffer + (org-font-lock-ensure) + (show-all) + (org-show-block-all) + (setq newbuf (htmlize-buffer))) (with-current-buffer newbuf (when org-org-htmlized-css-url (goto-char (point-min)) @@ -265,10 +266,12 @@ Return output file name." (replace-match (format "<link rel=\"stylesheet\" type=\"text/css\" href=\"%s\">" - org-org-htmlized-css-url) t t))) + org-org-htmlized-css-url) + t t))) (write-file (concat pub-dir (file-name-nondirectory filename) html-ext))) (kill-buffer newbuf) (unless visitingp (kill-buffer work-buffer))) + ;; FIXME: Why? Which buffer is this supposed to apply to? (set-buffer-modified-p nil))) diff --git a/lisp/outline.el b/lisp/outline.el index e3e4991c11c..11d71fb1226 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -645,25 +645,25 @@ the match data is set appropriately." (defun outline-move-subtree-down (&optional arg) "Move the current subtree down past ARG headlines of the same level." (interactive "p") - (let ((movfunc (if (> arg 0) 'outline-get-next-sibling - 'outline-get-last-sibling)) - (ins-point (make-marker)) - (cnt (abs arg)) - ;; Make sure we can move forward to find the end of the - ;; subtree and the insertion point. - (maybe-forward-char (lambda () - (if (eq (char-after) ?\n) (forward-char 1) - (if (and (eobp) (not (bolp))) (insert "\n"))))) - beg end folded) - ;; Select the tree. - (outline-back-to-heading) - (setq beg (point)) - (save-match-data - (save-excursion (outline-end-of-heading) - (setq folded (outline-invisible-p))) - (outline-end-of-subtree)) - (funcall maybe-forward-char) - (setq end (point)) + (outline-back-to-heading) + (let* ((movfunc (if (> arg 0) 'outline-get-next-sibling + 'outline-get-last-sibling)) + ;; Find the end of the subtree to be moved as well as the point to + ;; move it to, adding a newline if necessary, to ensure these points + ;; are at bol on the line below the subtree. + (end-point-func (lambda () + (outline-end-of-subtree) + (if (eq (char-after) ?\n) (forward-char 1) + (if (and (eobp) (not (bolp))) (insert "\n"))) + (point))) + (beg (point)) + (folded (save-match-data + (outline-end-of-heading) + (outline-invisible-p))) + (end (save-match-data + (funcall end-point-func))) + (ins-point (make-marker)) + (cnt (abs arg))) ;; Find insertion point, with error handling. (goto-char beg) (while (> cnt 0) @@ -673,8 +673,7 @@ the match data is set appropriately." (setq cnt (1- cnt))) (if (> arg 0) ;; Moving forward - still need to move over subtree. - (progn (outline-end-of-subtree) - (funcall maybe-forward-char))) + (funcall end-point-func)) (move-marker ins-point (point)) (insert (delete-and-extract-region beg end)) (goto-char ins-point) diff --git a/lisp/paren.el b/lisp/paren.el index 0342213a029..30314c2f9c8 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -43,8 +43,7 @@ Valid styles are `parenthesis' (meaning show the matching paren), `expression' (meaning show the entire expression enclosed by the paren) and `mixed' (meaning show the matching paren if it is visible, and the expression otherwise)." - :type '(choice (const parenthesis) (const expression) (const mixed)) - :group 'paren-showing) + :type '(choice (const parenthesis) (const expression) (const mixed))) (defcustom show-paren-delay 0.125 "Time in seconds to delay before showing a matching paren. @@ -57,28 +56,39 @@ active, you must toggle the mode off and on again for this to take effect." (set sym val) (show-paren-mode -1) (set sym val) - (show-paren-mode 1))) - :group 'paren-showing) + (show-paren-mode 1)))) (defcustom show-paren-priority 1000 "Priority of paren highlighting overlays." - :type 'integer - :group 'paren-showing + :type 'integer :version "21.1") (defcustom show-paren-ring-bell-on-mismatch nil "If non-nil, beep if mismatched paren is detected." :type 'boolean - :group 'paren-showing :version "20.3") +(defcustom show-paren-when-point-inside-paren nil + "If non-nil, show parens when point is just inside one. +This will only be done when point isn't also just outside a paren." + :type 'boolean + :version "25.1") + +(defcustom show-paren-when-point-in-periphery nil + "If non-nil, show parens when point is in the line's periphery. +The periphery is at the beginning or end of a line or in any +whitespace there." + :type 'boolean + :version "25.1") + (define-obsolete-face-alias 'show-paren-match-face 'show-paren-match "22.1") (define-obsolete-face-alias 'show-paren-mismatch-face 'show-paren-mismatch "22.1") -(defvar show-paren-highlight-openparen t - "Non-nil turns on openparen highlighting when matching forward.") +(defcustom show-paren-highlight-openparen t + "Non-nil turns on openparen highlighting when matching forward." + :type 'boolean) (defvar show-paren--idle-timer nil) (defvar show-paren--overlay @@ -112,76 +122,113 @@ matching parenthesis is highlighted in `show-paren-style' after (delete-overlay show-paren--overlay) (delete-overlay show-paren--overlay-1))) +(defun show-paren--unescaped-p (pos) + "Determine whether the paren after POS is unescaped." + (save-excursion + (goto-char pos) + (= (logand (skip-syntax-backward "/\\") 1) 0))) + +(defun show-paren--categorize-paren (pos) + "Determine whether the character after POS has paren syntax, +and if so, return a cons (DIR . OUTSIDE), where DIR is 1 for an +open paren, -1 for a close paren, and OUTSIDE is the buffer +position of the outside of the paren. If the character isn't a +paren, or it is an escaped paren, return nil." + (cond + ((and (eq (syntax-class (syntax-after pos)) 4) + (show-paren--unescaped-p pos)) + (cons 1 pos)) + ((and (eq (syntax-class (syntax-after pos)) 5) + (show-paren--unescaped-p pos)) + (cons -1 (1+ pos))))) + +(defun show-paren--locate-near-paren () + "Locate an unescaped paren \"near\" point to show. +If one is found, return the cons (DIR . OUTSIDE), where DIR is 1 +for an open paren, -1 for a close paren, and OUTSIDE is the buffer +position of the outside of the paren. Otherwise return nil." + (let* ((ind-pos (save-excursion (back-to-indentation) (point))) + (eol-pos + (save-excursion + (end-of-line) (skip-chars-backward " \t" ind-pos) (point))) + (before (show-paren--categorize-paren (1- (point)))) + (after (show-paren--categorize-paren (point)))) + (cond + ;; Point is immediately outside a paren. + ((eq (car before) -1) before) + ((eq (car after) 1) after) + ;; Point is immediately inside a paren. + ((and show-paren-when-point-inside-paren before)) + ((and show-paren-when-point-inside-paren after)) + ;; Point is in the whitespace before the code. + ((and show-paren-when-point-in-periphery + (<= (point) ind-pos)) + (or (show-paren--categorize-paren ind-pos) + (show-paren--categorize-paren (1- eol-pos)))) + ;; Point is in the whitespace after the code. + ((and show-paren-when-point-in-periphery + (>= (point) eol-pos)) + (show-paren--categorize-paren (1- eol-pos)))))) + (defvar show-paren-data-function #'show-paren--default - "Function to find the opener/closer at point and its match. + "Function to find the opener/closer \"near\" point and its match. The function is called with no argument and should return either nil -if there's no opener/closer at point, or a list of the form +if there's no opener/closer near point, or a list of the form \(HERE-BEG HERE-END THERE-BEG THERE-END MISMATCH) -Where HERE-BEG..HERE-END is expected to be around point.") +Where HERE-BEG..HERE-END is expected to be near point.") (defun show-paren--default () - (let* ((oldpos (point)) - (dir (cond ((eq (syntax-class (syntax-after (1- (point)))) 5) -1) - ((eq (syntax-class (syntax-after (point))) 4) 1))) - (unescaped - (when dir - ;; Verify an even number of quoting characters precede the paren. - ;; Follow the same logic as in `blink-matching-open'. - (= (if (= dir -1) 1 0) - (logand 1 (- (point) - (save-excursion - (if (= dir -1) (forward-char -1)) - (skip-syntax-backward "/\\") - (point))))))) - (here-beg (if (eq dir 1) (point) (1- (point)))) - (here-end (if (eq dir 1) (1+ (point)) (point))) - pos mismatch) + (let* ((temp (show-paren--locate-near-paren)) + (dir (car temp)) + (outside (cdr temp)) + pos mismatch here-beg here-end) ;; ;; Find the other end of the sexp. - (when unescaped - (save-excursion - (save-restriction - ;; Determine the range within which to look for a match. - (when blink-matching-paren-distance - (narrow-to-region - (max (point-min) (- (point) blink-matching-paren-distance)) - (min (point-max) (+ (point) blink-matching-paren-distance)))) - ;; Scan across one sexp within that range. - ;; Errors or nil mean there is a mismatch. - (condition-case () - (setq pos (scan-sexps (point) dir)) - (error (setq pos t mismatch t))) - ;; Move back the other way and verify we get back to the - ;; starting point. If not, these two parens don't really match. - ;; Maybe the one at point is escaped and doesn't really count, - ;; or one is inside a comment. - (when (integerp pos) - (unless (condition-case () - (eq (point) (scan-sexps pos (- dir))) - (error nil)) - (setq pos nil))) - ;; If found a "matching" paren, see if it is the right - ;; kind of paren to match the one we started at. - (if (not (integerp pos)) - (if mismatch (list here-beg here-end nil nil t)) - (let ((beg (min pos oldpos)) (end (max pos oldpos))) - (unless (eq (syntax-class (syntax-after beg)) 8) - (setq mismatch - (not (or (eq (char-before end) - ;; This can give nil. - (cdr (syntax-after beg))) - (eq (char-after beg) - ;; This can give nil. - (cdr (syntax-after (1- end)))) - ;; The cdr might hold a new paren-class - ;; info rather than a matching-char info, - ;; in which case the two CDRs should match. - (eq (cdr (syntax-after (1- end))) - (cdr (syntax-after beg))))))) - (list here-beg here-end - (if (= dir 1) (1- pos) pos) - (if (= dir 1) pos (1+ pos)) - mismatch)))))))) + (when dir + (setq here-beg (if (eq dir 1) outside (1- outside)) + here-end (if (eq dir 1) (1+ outside) outside)) + (save-restriction + ;; Determine the range within which to look for a match. + (when blink-matching-paren-distance + (narrow-to-region + (max (point-min) (- (point) blink-matching-paren-distance)) + (min (point-max) (+ (point) blink-matching-paren-distance)))) + ;; Scan across one sexp within that range. + ;; Errors or nil mean there is a mismatch. + (condition-case () + (setq pos (scan-sexps outside dir)) + (error (setq pos t mismatch t))) + ;; Move back the other way and verify we get back to the + ;; starting point. If not, these two parens don't really match. + ;; Maybe the one at point is escaped and doesn't really count, + ;; or one is inside a comment. + (when (integerp pos) + (unless (condition-case () + (eq outside (scan-sexps pos (- dir))) + (error nil)) + (setq pos nil))) + ;; If found a "matching" paren, see if it is the right + ;; kind of paren to match the one we started at. + (if (not (integerp pos)) + (if mismatch (list here-beg here-end nil nil t)) + (let ((beg (min pos outside)) (end (max pos outside))) + (unless (eq (syntax-class (syntax-after beg)) 8) + (setq mismatch + (not (or (eq (char-before end) + ;; This can give nil. + (cdr (syntax-after beg))) + (eq (char-after beg) + ;; This can give nil. + (cdr (syntax-after (1- end)))) + ;; The cdr might hold a new paren-class + ;; info rather than a matching-char info, + ;; in which case the two CDRs should match. + (eq (cdr (syntax-after (1- end))) + (cdr (syntax-after beg))))))) + (list here-beg here-end + (if (= dir 1) (1- pos) pos) + (if (= dir 1) pos (1+ pos)) + mismatch))))))) ;; Find the place to show, if there is one, ;; and show it until input arrives. @@ -215,7 +262,8 @@ Where HERE-BEG..HERE-END is expected to be around point.") ;; Otherwise, turn off any such highlighting. (if (or (not here-beg) (and (not show-paren-highlight-openparen) - (> here-end (point)) + (> here-end (point)) + (<= here-beg (point)) (integerp there-beg))) (delete-overlay show-paren--overlay-1) (move-overlay show-paren--overlay-1 @@ -234,7 +282,7 @@ Where HERE-BEG..HERE-END is expected to be around point.") (1- there-end) (1+ there-beg)))) (not (pos-visible-in-window-p closest))))) (move-overlay show-paren--overlay - (point) + (if (< there-beg here-beg) here-end here-beg) (if (< there-beg here-beg) there-beg there-end) (current-buffer)) (move-overlay show-paren--overlay diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el index 12136b8bee8..ada2a041766 100644 --- a/lisp/pcmpl-gnu.el +++ b/lisp/pcmpl-gnu.el @@ -323,8 +323,8 @@ (let ((file (pcomplete-arg 1))) (completion-table-dynamic (lambda (_string) - (pcmpl-gnu-with-file-buffer file - (mapcar #'tar-header-name tar-parse-info))))) + (pcmpl-gnu-with-file-buffer + file (mapcar #'tar-header-name tar-parse-info))))) (pcomplete-entries)) nil 'identity)))) diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index 107609eb125..2c4031056af 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -1005,20 +1005,17 @@ Set `bubbles--col-offset' and `bubbles--row-offset'." (set-buffer-modified-p nil) (erase-buffer) (insert " ") - (add-text-properties - (point-min) (point) (list 'intangible t 'display - (cons 'space - (list :height bubbles--row-offset)))) + (put-text-property (point-min) (point) + 'display + (cons 'space (list :height bubbles--row-offset))) (insert "\n") (let ((max-char (length (bubbles--colors)))) (dotimes (i (bubbles--grid-height)) (let ((p (point))) (insert " ") - (add-text-properties - p (point) (list 'intangible t - 'display (cons 'space - (list :width - bubbles--col-offset))))) + (put-text-property p (point) + 'display + (cons 'space (list :width bubbles--col-offset)))) (dotimes (j (bubbles--grid-width)) (let* ((index (random max-char)) (char (nth index bubbles-chars))) @@ -1026,10 +1023,9 @@ Set `bubbles--col-offset' and `bubbles--row-offset'." (add-text-properties (1- (point)) (point) (list 'index index)))) (insert "\n")) (insert "\n ") - (add-text-properties - (1- (point)) (point) (list 'intangible t 'display - (cons 'space - (list :width bubbles--col-offset))))) + (put-text-property (1- (point)) (point) + 'display + (cons 'space (list :width bubbles--col-offset)))) (put-text-property (point-min) (point-max) 'pointer 'arrow)) (bubbles-mode) (bubbles--reset-score) @@ -1179,10 +1175,9 @@ Use optional parameter POS instead of point if given." (delete-region (point) (point-max)) (insert (format "Selected: %4d\n" bubbles--neighborhood-score)) (insert " ") - (add-text-properties (1- (point)) (point) - (list 'intangible t 'display - (cons 'space - (list :width bubbles--col-offset)))) + (put-text-property (1- (point)) (point) + 'display + (cons 'space (list :width bubbles--col-offset))) (insert (format "Score: %4d" bubbles--score)) (put-text-property pos (point) 'status t)))) @@ -1200,10 +1195,9 @@ Use optional parameter POS instead of point if given." (goto-char (point-max)) (let* ((inhibit-read-only t)) (insert "\n ") - (add-text-properties (1- (point)) (point) - (list 'intangible t 'display - (cons 'space - (list :width bubbles--col-offset)))) + (put-text-property (1- (point)) (point) + 'display + (cons 'space (list :width bubbles--col-offset))) (insert "Game Over!")) ;; save score (gamegrid-add-score (format "bubbles-%s-%d-%d-%d-scores" diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index 7f554dd01fa..2f4536c0820 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -100,7 +100,8 @@ (defun dun-describe-room (room) (if (and (not (member (abs room) dun-light-rooms)) - (not (member obj-lamp dun-inventory))) + (not (member obj-lamp dun-inventory)) + (not (member obj-lamp (nth dun-current-room dun-room-objects)))) (dun-mprincl "It is pitch dark. You are likely to be eaten by a grue.") (dun-mprincl (cadr (nth (abs room) dun-rooms))) (if (and (and (or (member room dun-visited) @@ -615,7 +616,8 @@ just try dropping it.") (defun dun-move (dir) (if (and (not (member dun-current-room dun-light-rooms)) - (not (member obj-lamp dun-inventory))) + (not (member obj-lamp dun-inventory)) + (not (member obj-lamp (nth dun-current-room dun-room-objects)))) (progn (dun-mprinc "You trip over a grue and fall into a pit and break every bone in your @@ -896,7 +898,7 @@ to swim.") (defun dun-help (args) (dun-mprincl -"Welcome to dunnet (2.01), by Ron Schnell (ronnie@driver-aces.com). +"Welcome to dunnet (2.02), by Ron Schnell (ronnie@driver-aces.com - @RonnieSchnell). Here is some useful information (read carefully because there are one or more clues in here): - If you have a key that can open a door, you do not need to explicitly @@ -1385,8 +1387,8 @@ for a moment, then straighten yourself up. (setq dungeon-mode 'dungeon) (setq dun-unix-verbs '((ls . dun-ls) (ftp . dun-ftp) (echo . dun-echo) (exit . dun-uexit) (cd . dun-cd) (pwd . dun-pwd) - (rlogin . dun-rlogin) (uncompress . dun-uncompress) - (cat . dun-cat))) + (rlogin . dun-rlogin) (ssh . dun-rlogin) + (uncompress . dun-uncompress) (cat . dun-cat))) (setq dun-dos-verbs '((dir . dun-dos-dir) (type . dun-dos-type) (exit . dun-dos-exit) (command . dun-dos-spawn) @@ -2537,25 +2539,31 @@ treasures for points?" "4" "four") (dun-mprincl "Incorrect."))) (let (varname epoint afterq i value) - (setq varname (substring line 0 esign)) - (if (not (setq epoint (string-match ")" line))) - (if (string= (substring line (1+ esign) (+ esign 2)) - "\"") - (progn - (setq afterq (substring line (+ esign 2))) - (setq epoint (+ - (string-match "\"" afterq) - (+ esign 3)))) - - (if (not (setq epoint (string-match " " line))) - (setq epoint (length line)))) - (setq epoint (1+ epoint)) - (while (and - (not (= epoint (length line))) - (setq i (string-match ")" (substring line epoint)))) - (setq epoint (+ epoint i 1)))) - (setq value (substring line (1+ esign) epoint)) - (dun-eval varname value)))) + (setq varname (replace-regexp-in-string " " "" (substring line 0 esign))) + + (if (or (= (length varname) 0) (< (- (length line) esign) 2)) + (progn + (dun-mprinc line) + (dun-mprincl " : not found.")) + + (if (not (setq epoint (string-match ")" line))) + (if (string= (substring line (1+ esign) (+ esign 2)) + "\"") + (progn + (setq afterq (substring line (+ esign 2))) + (setq epoint (+ + (string-match "\"" afterq) + (+ esign 3)))) + + (if (not (setq epoint (string-match " " line))) + (setq epoint (length line)))) + (setq epoint (1+ epoint)) + (while (and + (not (= epoint (length line))) + (setq i (string-match ")" (substring line epoint)))) + (setq epoint (+ epoint i 1)))) + (setq value (substring line (1+ esign) epoint)) + (dun-eval varname value))))) (defun dun-eval (varname value) (let (eval-error) @@ -2739,16 +2747,20 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..") (if dun-batch-mode (dun-mprincl "Login failed.") (dun-mprincl "\nLogin failed.")) - (if dun-batch-mode - (dun-mprincl - "Guest login okay, user access restrictions apply.") - (dun-mprincl - "\nGuest login okay, user access restrictions apply.")) - (dun-ftp-commands) - (setq newlist + (if (= (length ident) 0) + (if dun-batch-mode + (dun-mprincl "Password is required.") + (dun-mprincl "\nPassword is required.")) + (if dun-batch-mode + (dun-mprincl + "Guest login okay, user access restrictions apply.") + (dun-mprincl + "\nGuest login okay, user access restrictions apply.")) + (dun-ftp-commands) + (setq newlist '("What password did you use during anonymous ftp to gamma?")) - (setq newlist (append newlist (list ident))) - (rplaca (nthcdr 1 dun-endgame-questions) newlist))))))))) + (setq newlist (append newlist (list ident))) + (rplaca (nthcdr 1 dun-endgame-questions) newlist)))))))))) (defun dun-ftp-commands () (setq dun-exitf nil) diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index 1e265a635a0..b4c3c594731 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -486,13 +486,13 @@ FILE is created there." (not (zerop (logand (file-modes (expand-file-name "update-game-score" exec-directory)) - #o4000))))) + #o6000))))) (cond ((file-name-absolute-p file) (gamegrid-add-score-insecure file score)) ((and gamegrid-shared-game-dir (file-exists-p (expand-file-name file shared-game-score-directory))) - ;; Use the setuid "update-game-score" program to update a - ;; system-wide score file. + ;; Use the setuid (or setgid) "update-game-score" program + ;; to update a system-wide score file. (gamegrid-add-score-with-update-game-score-1 file (expand-file-name file shared-game-score-directory) score)) ;; Else: Add the score to a score file in the user's home diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el index 9eb16a2266a..ef55015a999 100644 --- a/lisp/play/gametree.el +++ b/lisp/play/gametree.el @@ -590,31 +590,30 @@ shogi, etc.) players, it is a slightly modified version of Outline mode. (add-hook 'write-contents-hooks 'gametree-save-and-hack-layout)) ;;;; Goodies for mousing users -(and (fboundp 'track-mouse) - (defun gametree-mouse-break-line-here (event) - (interactive "e") - (mouse-set-point event) - (gametree-break-line-here)) - (defun gametree-mouse-show-children-and-entry (event) - (interactive "e") - (mouse-set-point event) - (gametree-show-children-and-entry)) - (defun gametree-mouse-show-subtree (event) - (interactive "e") - (mouse-set-point event) - (show-subtree)) - (defun gametree-mouse-hide-subtree (event) - (interactive "e") - (mouse-set-point event) - (hide-subtree)) - (define-key gametree-mode-map [M-down-mouse-2 M-mouse-2] - 'gametree-mouse-break-line-here) - (define-key gametree-mode-map [S-down-mouse-1 S-mouse-1] - 'gametree-mouse-show-children-and-entry) - (define-key gametree-mode-map [S-down-mouse-2 S-mouse-2] - 'gametree-mouse-show-subtree) - (define-key gametree-mode-map [S-down-mouse-3 S-mouse-3] - 'gametree-mouse-hide-subtree)) +(defun gametree-mouse-break-line-here (event) + (interactive "e") + (mouse-set-point event) + (gametree-break-line-here)) +(defun gametree-mouse-show-children-and-entry (event) + (interactive "e") + (mouse-set-point event) + (gametree-show-children-and-entry)) +(defun gametree-mouse-show-subtree (event) + (interactive "e") + (mouse-set-point event) + (show-subtree)) +(defun gametree-mouse-hide-subtree (event) + (interactive "e") + (mouse-set-point event) + (hide-subtree)) +(define-key gametree-mode-map [M-down-mouse-2 M-mouse-2] + 'gametree-mouse-break-line-here) +(define-key gametree-mode-map [S-down-mouse-1 S-mouse-1] + 'gametree-mouse-show-children-and-entry) +(define-key gametree-mode-map [S-down-mouse-2 S-mouse-2] + 'gametree-mouse-show-subtree) +(define-key gametree-mode-map [S-down-mouse-3 S-mouse-3] + 'gametree-mouse-hide-subtree) (provide 'gametree) diff --git a/lisp/play/landmark.el b/lisp/play/landmark.el index 79e82005bed..2a64cdfe899 100644 --- a/lisp/play/landmark.el +++ b/lisp/play/landmark.el @@ -1,10 +1,11 @@ -;;; landmark.el --- neural-network robot that learns landmarks +;;; landmark.el --- Neural-network robot that learns landmarks -*- lexical-binding:t -*- ;; Copyright (C) 1996-1997, 2000-2015 Free Software Foundation, Inc. ;; Author: Terrence Brannon (was: <brannon@rana.usc.edu>) ;; Created: December 16, 1996 - first release to usenet ;; Keywords: games, neural network, adaptive search, chemotaxis +;; Version: 1.0 ;; This file is part of GNU Emacs. @@ -225,9 +226,6 @@ 'landmark-font-lock-face-X))) "Font lock rules for Landmark.") -(put 'landmark-mode 'front-sticky - (put 'landmark-mode 'rear-nonsticky '(intangible))) -(put 'landmark-mode 'intangible 1) ;; This one is for when they set view-read-only to t: Landmark cannot ;; allow View Mode to be activated in its buffer. (define-derived-mode landmark-mode special-mode "Lm" @@ -244,7 +242,8 @@ Entry to this mode calls the value of `landmark-mode-hook' if that value is non-nil. One interesting value is `turn-on-font-lock'." (landmark-display-statistics) (setq-local font-lock-defaults '(landmark-font-lock-keywords t)) - (setq buffer-read-only t)) + (setq buffer-read-only t) + (add-hook 'post-command-hook #'landmark--intangible nil t)) ;;;_ + THE SCORE TABLE. @@ -679,8 +678,8 @@ along the DX, DY direction, considering that DVAL has been added on SQUARE." (landmark-prompt-for-other-game)) (t (message "Let me think...") - (let (square score) - (setq square (landmark-strongest-square)) + (let ((square (landmark-strongest-square)) + score) (cond ((null square) (landmark-terminate-game 'nobody-won)) (t @@ -722,8 +721,7 @@ along the DX, DY direction, considering that DVAL has been added on SQUARE." (min (max (/ (+ (- (cdr click) landmark-y-offset 1) - (let ((inhibit-point-motion-hooks t)) - (count-lines 1 (window-start))) + (count-lines (point-min) (window-start)) landmark-square-height (% landmark-square-height 2) (/ landmark-square-height 2)) @@ -749,8 +747,8 @@ If the game is finished, this command requests for another game." ((not landmark-game-in-progress) (landmark-prompt-for-other-game)) (t - (let (square score) - (setq square (landmark-point-square)) + (let ((square (landmark-point-square)) + score) (cond ((null square) (error "Your point is not on a square. Retry!")) ((not (zerop (aref landmark-board square))) @@ -844,16 +842,15 @@ If the game is finished, this command requests for another game." (defun landmark-point-y () "Return the board row where point is." - (let ((inhibit-point-motion-hooks t)) - (1+ (/ (- (count-lines 1 (point)) landmark-y-offset (if (bolp) 0 1)) - landmark-square-height)))) + (1+ (/ (- (count-lines (point-min) (point)) + landmark-y-offset (if (bolp) 0 1)) + landmark-square-height))) (defun landmark-point-square () "Return the index of the square point is on." - (let ((inhibit-point-motion-hooks t)) (landmark-xy-to-index (1+ (/ (- (current-column) landmark-x-offset) landmark-square-width)) - (landmark-point-y)))) + (landmark-point-y))) (defun landmark-goto-square (index) "Move point to square number INDEX." @@ -861,23 +858,21 @@ If the game is finished, this command requests for another game." (defun landmark-goto-xy (x y) "Move point to square at X, Y coords." - (let ((inhibit-point-motion-hooks t)) (goto-char (point-min)) - (forward-line (+ landmark-y-offset (* landmark-square-height (1- y))))) + (forward-line (+ landmark-y-offset (* landmark-square-height (1- y)))) (move-to-column (+ landmark-x-offset (* landmark-square-width (1- x))))) (defun landmark-plot-square (square value) "Draw 'X', 'O' or '.' on SQUARE depending on VALUE, leave point there." (or (= value 1) (landmark-goto-square square)) - (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t)) - (insert-and-inherit (cond ((= value 1) ?.) - ((= value 2) ?N) - ((= value 3) ?S) - ((= value 4) ?E) - ((= value 5) ?W) - ((= value 6) ?^))) + (let ((inhibit-read-only t)) + (insert (cond ((= value 1) ?.) + ((= value 2) ?N) + ((= value 3) ?S) + ((= value 4) ?E) + ((= value 5) ?W) + ((= value 6) ?^))) (and (zerop value) (add-text-properties (1- (point)) (point) @@ -892,8 +887,7 @@ mouse-1: get robot moving, mouse-2: play on this square"))) "Display an N by M Landmark board." (buffer-disable-undo (current-buffer)) (let ((inhibit-read-only t) - (point 1) opoint - (intangible t) + (point (point-min)) opoint (i m) j x) ;; Try to minimize number of chars (because of text properties) (setq tab-width @@ -902,7 +896,7 @@ mouse-1: get robot moving, mouse-2: play on this square"))) (max (/ (+ (% landmark-x-offset landmark-square-width) landmark-square-width 1) 2) 2))) (erase-buffer) - (newline landmark-y-offset) + (insert-char ?\n landmark-y-offset) (while (progn (setq j n x (- landmark-x-offset landmark-square-width)) @@ -910,9 +904,7 @@ mouse-1: get robot moving, mouse-2: play on this square"))) (insert-char ?\t (/ (- (setq x (+ x landmark-square-width)) (current-column)) tab-width)) - (insert-char ? (- x (current-column))) - (if (setq intangible (not intangible)) - (put-text-property point (point) 'intangible 2)) + (insert-char ?\s (- x (current-column))) (and (zerop j) (= i (- m 2)) (progn @@ -929,14 +921,7 @@ mouse-1: get robot moving, mouse-2: play on this square"))) (if (= i (1- m)) (setq opoint point)) (insert-char ?\n landmark-square-height)) - (or (eq (char-after 1) ?.) - (put-text-property 1 2 'point-entered - (lambda (_x _y) (if (bobp) (forward-char))))) - (or intangible - (put-text-property point (point) 'intangible 2)) - (put-text-property point (point) 'point-entered - (lambda (_x _y) (if (eobp) (backward-char)))) - (put-text-property (point-min) (point) 'category 'landmark-mode)) + (insert-char ?\n)) (landmark-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board (sit-for 0)) ; Display NOW @@ -998,8 +983,7 @@ mouse-1: get robot moving, mouse-2: play on this square"))) "Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction." (save-excursion ; Not moving point from last square (let ((depl (landmark-xy-to-index dx dy)) - (inhibit-read-only t) - (inhibit-point-motion-hooks t)) + (inhibit-read-only t)) ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1 (while (/= square1 square2) (landmark-goto-square square1) @@ -1018,20 +1002,40 @@ mouse-1: get robot moving, mouse-2: play on this square"))) (setq landmark-n (1+ landmark-n)) (forward-line 1) (indent-to column) - (insert-and-inherit ?|)))) + (insert ?|)))) ((= dx -1) ; 1st Diagonal (indent-to (prog1 (- (current-column) (/ landmark-square-width 2)) (forward-line (/ landmark-square-height 2)))) - (insert-and-inherit ?/)) + (insert ?/)) (t ; 2nd Diagonal (indent-to (prog1 (+ (current-column) (/ landmark-square-width 2)) (forward-line (/ landmark-square-height 2)))) - (insert-and-inherit ?\\)))))) + (insert ?\\)))))) (sit-for 0)) ; Display NOW ;;;_ + CURSOR MOTION. +(defvar-local landmark--last-pos 0) + +(defconst landmark--intangible-chars "- \t\n|/\\\\") + +(defun landmark--intangible () + (when (or (eobp) + (save-excursion + (not (zerop (skip-chars-forward landmark--intangible-chars))))) + (if (<= landmark--last-pos (point)) ;Moving forward. + (progn + (skip-chars-forward landmark--intangible-chars) + (when (eobp) + (skip-chars-backward landmark--intangible-chars) + (forward-char -1))) + (skip-chars-backward landmark--intangible-chars) + (if (bobp) + (skip-chars-forward landmark--intangible-chars) + (forward-char -1)))) + (setq landmark--last-pos (point))) + ;; previous-line and next-line don't work right with intangible newlines (defun landmark-move-down () "Move point down one row on the Landmark board." @@ -1138,7 +1142,7 @@ because it is overwritten by \"One moment please\"." (defun landmark-print-distance () - (insert (format "tree: %S \n" (calc-distance-of-robot-from 'landmark-tree))) + (insert (format "tree: %S \n" (landmark-calc-distance-of-robot-from 'landmark-tree))) (mapc 'landmark-print-distance-int landmark-directions)) @@ -1303,9 +1307,9 @@ After this limit is reached, landmark-random-move is called to push him out of i ;;;_ - landmark-plot-internal (sym) (defun landmark-plot-internal (sym) (landmark-plot-square (landmark-xy-to-index - (get sym 'x) - (get sym 'y)) - (get sym 'sym))) + (get sym 'x) + (get sym 'y)) + (get sym 'sym))) ;;;_ - landmark-plot-landmarks () (defun landmark-plot-landmarks () (setq landmark-cx (/ landmark-board-width 2)) @@ -1336,26 +1340,24 @@ After this limit is reached, landmark-random-move is called to push him out of i ;;;_ + Distance-calculation functions -;;;_ - square (a) -(defun square (a) - (* a a)) ;;;_ - distance (x x0 y y0) -(defun distance (x x0 y y0) - (sqrt (+ (square (- x x0)) (square (- y y0))))) +(defun landmark--distance (x x0 y y0) + (let ((dx (- x x0)) (dy (- y y0))) + (sqrt (+ (* dx dx) (* dy dy))))) -;;;_ - calc-distance-of-robot-from (direction) -(defun calc-distance-of-robot-from (direction) +;;;_ - landmark-calc-distance-of-robot-from (direction) +(defun landmark-calc-distance-of-robot-from (direction) (put direction 'distance - (distance (get direction 'x) - (landmark-index-to-x (landmark-point-square)) - (get direction 'y) - (landmark-index-to-y (landmark-point-square))))) + (landmark--distance (get direction 'x) + (landmark-index-to-x (landmark-point-square)) + (get direction 'y) + (landmark-index-to-y (landmark-point-square))))) -;;;_ - calc-smell-internal (sym) -(defun calc-smell-internal (sym) +;;;_ - landmark-calc-smell-internal (sym) +(defun landmark-calc-smell-internal (sym) (let ((r (get sym 'r)) - (d (calc-distance-of-robot-from sym))) + (d (landmark-calc-distance-of-robot-from sym))) (if (> (* 0.5 (- 1 (/ d r))) 0) (* 0.5 (- 1 (/ d r))) 0))) @@ -1402,12 +1404,12 @@ After this limit is reached, landmark-random-move is called to push him out of i (defun landmark-calc-current-smells () (mapc (lambda (direction) - (put direction 'smell (calc-smell-internal direction))) + (put direction 'smell (landmark-calc-smell-internal direction))) landmark-directions)) (defun landmark-calc-payoff () (put 'z 't-1 (get 'z 't)) - (put 'z 't (calc-smell-internal 'landmark-tree)) + (put 'z 't (landmark-calc-smell-internal 'landmark-tree)) (if (= (- (get 'z 't) (get 'z 't-1)) 0.0) (cl-incf landmark-no-payoff) (setf landmark-no-payoff 0))) @@ -1448,8 +1450,9 @@ After this limit is reached, landmark-random-move is called to push him out of i (message "e-w normalization")))) (mapc (lambda (pair) - (if (> (get (car pair) 'y_t) 0) - (funcall (car (cdr pair))))) + (when (> (get (car pair) 'y_t) 0) + (funcall (car (cdr pair))) + (landmark--intangible))) '( (landmark-n landmark-move-up) (landmark-s landmark-move-down) @@ -1471,7 +1474,7 @@ After this limit is reached, landmark-random-move is called to push him out of i (defun landmark-amble-robot () (interactive) - (while (> (calc-distance-of-robot-from 'landmark-tree) 0) + (while (> (landmark-calc-distance-of-robot-from 'landmark-tree) 0) (landmark-store-old-y_t) (landmark-calc-current-smells) @@ -1505,8 +1508,7 @@ If the game is finished, this command requests for another game." ((not landmark-game-in-progress) (landmark-prompt-for-other-game)) (t - (let (square) - (setq square (landmark-point-square)) + (let ((square (landmark-point-square))) (cond ((null square) (error "Your point is not on a square. Retry!")) ((not (zerop (aref landmark-board square))) @@ -1517,7 +1519,7 @@ If the game is finished, this command requests for another game." (landmark-store-old-y_t) (landmark-calc-current-smells) - (put 'z 't (calc-smell-internal 'landmark-tree)) + (put 'z 't (landmark-calc-smell-internal 'landmark-tree)) (landmark-random-move) @@ -1590,7 +1592,9 @@ If the game is finished, this command requests for another game." ;; distance on scent. (defun landmark-set-landmark-signal-strengths () - (setq landmark-tree-r (* (sqrt (+ (square landmark-cx) (square landmark-cy))) 1.5)) + (setq landmark-tree-r (* (sqrt (+ (* landmark-cx landmark-cx) + (* landmark-cy landmark-cy))) + 1.5)) (mapc (lambda (direction) (put direction 'r (* landmark-cx 1.1))) landmark-ew) @@ -1609,7 +1613,7 @@ If the game is finished, this command requests for another game." "Run 100 Landmark games, each time saving the weights from the previous game." (interactive) (landmark 1) - (dotimes (scratch-var 100) + (dotimes (_ 100) (landmark 2))) ;;;###autoload diff --git a/lisp/play/morse.el b/lisp/play/morse.el index 0f9c9bf3110..5352341ce73 100644 --- a/lisp/play/morse.el +++ b/lisp/play/morse.el @@ -146,7 +146,7 @@ "NATO phonetic alphabet. See ''International Code of Signals'' (INTERCO), United States Edition, 1969 Edition (Revised 2003) available from National -Geospatial-Intelligence Agency at http://www.nga.mil/") +Geospatial-Intelligence Agency at URL `http://www.nga.mil/'") ;;;###autoload (defun morse-region (beg end) diff --git a/lisp/printing.el b/lisp/printing.el index f9168cad4ba..86d569a6ac6 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -1038,20 +1038,27 @@ Please send all bug fixes and enhancements to ;; To avoid compilation gripes -(or (fboundp 'subst-char-in-string) ; hacked from subr.el - (defun subst-char-in-string (fromchar tochar string &optional inplace) - "Replace FROMCHAR with TOCHAR in STRING each time it occurs. +;; Emacs has this since at least 21.1. +(when (featurep 'xemacs) + (or (fboundp 'subst-char-in-string) ; hacked from subr.el + (defun subst-char-in-string (fromchar tochar string &optional inplace) + "Replace FROMCHAR with TOCHAR in STRING each time it occurs. Unless optional argument INPLACE is non-nil, return a new string." - (let ((i (length string)) - (newstr (if inplace string (copy-sequence string)))) - (while (> (setq i (1- i)) 0) - (if (eq (aref newstr i) fromchar) - (aset newstr i tochar))) - newstr))) - - -(or (fboundp 'make-temp-file) ; hacked from subr.el - (defun make-temp-file (prefix &optional dir-flag suffix) + (let ((i (length string)) + (newstr (if inplace string (copy-sequence string)))) + (while (> (setq i (1- i)) 0) + (if (eq (aref newstr i) fromchar) + (aset newstr i tochar))) + newstr)))) + + +;; Emacs has this since at least 21.1, but the SUFFIX argument +;; (which this file uses) only since 22.1. So the fboundp test +;; wasn't even correct/adequate. Whatever, no-one is using +;; this file on older Emacs version, so it's irrelevant. +(when (featurep 'xemacs) + (or (fboundp 'make-temp-file) ; hacked from subr.el + (defun make-temp-file (prefix &optional dir-flag suffix) "Create a temporary file. The returned file name (created by appending some random characters at the end of PREFIX, and expanding against `temporary-file-directory' if necessary), @@ -1086,7 +1093,7 @@ If SUFFIX is non-nil, add that at the end of the file name." nil) file) ;; Reset the umask. - (set-default-file-modes umask))))) + (set-default-file-modes umask)))))) (eval-when-compile @@ -3164,12 +3171,9 @@ See `pr-ps-printer-alist'.") (defmacro pr-save-file-modes (&rest body) - "Set temporally file modes to `pr-file-modes'." - `(let ((pr--default-file-modes (default-file-modes))) ; save default - (set-default-file-modes pr-file-modes) - ,@body - (set-default-file-modes pr--default-file-modes))) ; restore default - + "Execute BODY with file permissions temporarily set to `pr-file-modes'." + (declare (obsolete with-file-modes "25.1")) + `(with-file-modes pr-file-modes ,@body)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Keys & Menus @@ -3192,9 +3196,10 @@ See `pr-ps-printer-alist'.") (defalias 'pr-get-symbol - (if (fboundp 'easy-menu-intern) ; hacked from easymenu.el - 'easy-menu-intern - (lambda (s) (if (stringp s) (intern s) s)))) + (if (featurep 'emacs) 'easy-menu-intern ; since 22.1 + (if (fboundp 'easy-menu-intern) ; hacked from easymenu.el + 'easy-menu-intern + (lambda (s) (if (stringp s) (intern s) s))))) (defconst pr-menu-spec @@ -4364,12 +4369,12 @@ Noninteractively, the argument FILENAME is treated as follows: if it is nil, send the image to the printer. If FILENAME is a string, save the PostScript image in a file with that name." (interactive (list (ps-print-preprint current-prefix-arg))) - (pr-save-file-modes - (let ((ps-lpr-command (pr-command pr-ps-command)) - (ps-lpr-switches pr-ps-switches) - (ps-printer-name-option pr-ps-printer-switch) - (ps-printer-name pr-ps-printer)) - (ps-despool filename)))) + (with-file-modes pr-file-modes + (let ((ps-lpr-command (pr-command pr-ps-command)) + (ps-lpr-switches pr-ps-switches) + (ps-printer-name-option pr-ps-printer-switch) + (ps-printer-name pr-ps-printer)) + (ps-despool filename)))) ;;;###autoload @@ -5632,12 +5637,12 @@ If menu binding was not done, calls `pr-menu-bind'." (goto-char (point-max)) (insert (format "%s %S\n" cmd args))) ;; *Printing Command Output* == show any return message from command - (pr-save-file-modes - (setq status - (condition-case data - (apply 'call-process cmd nil buffer nil args) - ((quit error) - (error-message-string data))))) + (with-file-modes pr-file-modes + (setq status + (condition-case data + (apply 'call-process cmd nil buffer nil args) + ((quit error) + (error-message-string data))))) ;; *Printing Command Output* == show exit status (with-current-buffer buffer (goto-char (point-max)) @@ -5882,42 +5887,42 @@ If menu binding was not done, calls `pr-menu-bind'." (defun pr-text2ps (kind n-up filename &optional from to) - (pr-save-file-modes - (let ((ps-n-up-printing n-up) - (ps-spool-config (and (eq ps-spool-config 'setpagedevice) - 'setpagedevice))) - (pr-delete-file-if-exists filename) - (cond (pr-faces-p - (cond (pr-spool-p - ;; pr-faces-p and pr-spool-p - ;; here FILENAME arg is ignored - (cond ((eq kind 'buffer) - (ps-spool-buffer-with-faces)) - ((eq kind 'region) - (ps-spool-region-with-faces (or from (point)) - (or to (mark)))) - )) - ;; pr-faces-p and not pr-spool-p - ((eq kind 'buffer) - (ps-print-buffer-with-faces filename)) - ((eq kind 'region) - (ps-print-region-with-faces (or from (point)) - (or to (mark)) filename)) - )) - (pr-spool-p - ;; not pr-faces-p and pr-spool-p - ;; here FILENAME arg is ignored - (cond ((eq kind 'buffer) - (ps-spool-buffer)) - ((eq kind 'region) - (ps-spool-region (or from (point)) (or to (mark)))) - )) - ;; not pr-faces-p and not pr-spool-p - ((eq kind 'buffer) - (ps-print-buffer filename)) - ((eq kind 'region) - (ps-print-region (or from (point)) (or to (mark)) filename)) - )))) + (with-file-modes pr-file-modes + (let ((ps-n-up-printing n-up) + (ps-spool-config (and (eq ps-spool-config 'setpagedevice) + 'setpagedevice))) + (pr-delete-file-if-exists filename) + (cond (pr-faces-p + (cond (pr-spool-p + ;; pr-faces-p and pr-spool-p + ;; here FILENAME arg is ignored + (cond ((eq kind 'buffer) + (ps-spool-buffer-with-faces)) + ((eq kind 'region) + (ps-spool-region-with-faces (or from (point)) + (or to (mark)))) + )) + ;; pr-faces-p and not pr-spool-p + ((eq kind 'buffer) + (ps-print-buffer-with-faces filename)) + ((eq kind 'region) + (ps-print-region-with-faces (or from (point)) + (or to (mark)) filename)) + )) + (pr-spool-p + ;; not pr-faces-p and pr-spool-p + ;; here FILENAME arg is ignored + (cond ((eq kind 'buffer) + (ps-spool-buffer)) + ((eq kind 'region) + (ps-spool-region (or from (point)) (or to (mark)))) + )) + ;; not pr-faces-p and not pr-spool-p + ((eq kind 'buffer) + (ps-print-buffer filename)) + ((eq kind 'region) + (ps-print-region (or from (point)) (or to (mark)) filename)) + )))) (defun pr-command (command) @@ -6543,8 +6548,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (defun pr-i-directory () - (or (and (file-directory-p pr-i-directory) - (file-readable-p pr-i-directory)) + (or (file-accessible-directory-p pr-i-directory) (error "Please specify be a readable directory"))) @@ -6552,8 +6556,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (and pr-buffer-verbose (message "You can use M-TAB or ESC TAB for file completion")) (let ((dir (widget-value widget))) - (and (file-directory-p dir) - (file-readable-p dir) + (and (file-accessible-directory-p dir) (setq pr-i-directory dir)))) diff --git a/lisp/proced.el b/lisp/proced.el index 29310d6dd69..69355ab044a 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -49,8 +49,6 @@ ;;; Code: -(require 'time-date) ; for `with-decoded-time-value' - (defgroup proced nil "Proced mode." :group 'processes @@ -1186,17 +1184,8 @@ Return nil otherwise." (defun proced-time-lessp (t1 t2) "Return t if time value T1 is less than time value T2. Return `equal' if T1 equals T2. Return nil otherwise." - (with-decoded-time-value ((high1 low1 micro1 pico1 type1 t1) - (high2 low2 micro2 pico2 type2 t2)) - (cond ((< high1 high2)) - ((< high2 high1) nil) - ((< low1 low2)) - ((< low2 low1) nil) - ((< micro1 micro2)) - ((< micro2 micro1) nil) - ((< pico1 pico2)) - ((< pico2 pico1) nil) - (t 'equal)))) + (or (time-less-p t1 t2) + (if (not (time-less-p t2 t1)) 'equal))) ;;; Sorting diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index ee81b3ce3e6..8afb92f2c90 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -31,11 +31,6 @@ ;; independent from the GNU Ada compiler GNAT, distributed by Ada ;; Core Technologies. All the other files rely heavily on features ;; provided only by GNAT. -;; -;; Note: this mode will not work with Emacs 19. If you are on a VMS -;; system, where the latest version of Emacs is 19.28, you will need -;; another file, called ada-vms.el, that provides some required -;; functions. ;;; Usage: ;; Emacs should enter Ada mode automatically when you load an Ada file. diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index 0d1fe9df6b4..6b611e6f99b 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el @@ -651,12 +651,6 @@ Call `ada-require-project-file' first to ensure a project exists." (find-file (car (cdr pos))) (goto-char (car pos))))) -(defun ada-convert-file-name (name) - "Convert from NAME to a name that can be used by the compilation commands. -This is overridden on VMS to convert from VMS filenames to Unix filenames." - name) -;; FIXME: use convert-standard-filename instead - (defun ada-set-default-project-file (file) "Set FILE as the current project file." (interactive "fProject file:") @@ -1465,7 +1459,7 @@ by replacing the file extension with `.ali'." (get-file-buffer ali-file-name)) (kill-buffer (get-file-buffer ali-file-name))) - (let* ((name (ada-convert-file-name file)) + (let* ((name (convert-standard-filename file)) (body-name (or (ada-get-body-name name) name))) ;; Always recompile the body when we can. We thus temporarily switch to a diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index 485f6e66a1a..4db310d4ee3 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -1229,6 +1229,18 @@ Works with: Any syntactic symbol." (back-to-indentation) (vector (current-column)))) +(defun c-lineup-respect-col-0 (langelem) + "If the current line starts at column 0, return [0]. Otherwise return nil. + +This can be used for comments (in conjunction with, say, +`c-lineup-comment'), to keep comments already at column 0 +anchored there, but reindent other comments." + (save-excursion + (back-to-indentation) + (if (eq (current-column) 0) + [0] + nil))) + (defun c-snug-do-while (syntax pos) "Dynamically calculate brace hanginess for do-while statements. @@ -1333,4 +1345,8 @@ For other semicolon contexts, no determination is made." (cc-provide 'cc-align) +;;; Local Variables: +;;; indent-tabs-mode: t +;;; tab-width: 8 +;;; End: ;;; cc-align.el ends here diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index d9fc1c043a7..1ef80c801ee 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el @@ -61,7 +61,6 @@ (cc-bytecomp-defun c-backward-token-1) (cc-bytecomp-defun c-beginning-of-statement-1) (cc-bytecomp-defun c-backward-sws) -(cc-bytecomp-defun c-forward-sws) (defvar awk-mode-syntax-table (let ((st (make-syntax-table))) @@ -1147,4 +1146,8 @@ comment at the start of cc-engine.el for more info." (cc-provide 'cc-awk) ; Changed from 'awk-mode, ACM 2002/5/21 +;;; Local Variables: +;;; indent-tabs-mode: t +;;; tab-width: 8 +;;; End: ;;; awk-mode.el ends here diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el index e02a3cf89cc..b63eeb4c7a6 100644 --- a/lisp/progmodes/cc-bytecomp.el +++ b/lisp/progmodes/cc-bytecomp.el @@ -65,8 +65,7 @@ ;; elsewhere in the load path. ;; ;; To suppress byte compiler warnings, use the macros -;; `cc-bytecomp-defun', `cc-bytecomp-defvar', -;; `cc-bytecomp-obsolete-fun', and `cc-bytecomp-obsolete-var'. +;; `cc-bytecomp-defun' and `cc-bytecomp-defvar'. ;; ;; This file is not used at all after the package has been byte ;; compiled. It is however necessary when running uncompiled. @@ -78,19 +77,72 @@ (defvar cc-bytecomp-original-functions nil) (defvar cc-bytecomp-original-properties nil) (defvar cc-bytecomp-loaded-files nil) + +(setq cc-bytecomp-unbound-variables nil) +(setq cc-bytecomp-original-functions nil) +(setq cc-bytecomp-original-properties nil) +(setq cc-bytecomp-loaded-files nil) + (defvar cc-bytecomp-environment-set nil) (defmacro cc-bytecomp-debug-msg (&rest args) ;;`(message ,@args) ) +(defun cc-bytecomp-compiling-or-loading () + ;; Determine whether byte-compilation or loading is currently active, + ;; returning 'compiling, 'loading or nil. + ;; If both are active, the "innermost" activity counts. Note that + ;; compilation can trigger loading (various `require' type forms) + ;; and loading can trigger compilation (the package manager does + ;; this). We walk the lisp stack if necessary. + (cond + ((and load-in-progress + (boundp 'byte-compile-dest-file) + (stringp byte-compile-dest-file)) + (let ((n 0) elt) + (while (and + (setq elt (backtrace-frame n)) + (not (and (car elt) + (memq (cadr elt) + '(load require + byte-compile-file byte-recompile-directory + batch-byte-compile))))) + (setq n (1+ n))) + (cond + ((memq (cadr elt) '(load require)) + 'loading) + ((memq (cadr elt) '(byte-compile-file + byte-recompile-directory + batch-byte-compile)) + 'compiling) + (t ; Can't happen. + (message "cc-bytecomp-compiling-or-loading: System flags spuriously set") + nil)))) + (load-in-progress + ;; Being loaded. + 'loading) + ((and (boundp 'byte-compile-dest-file) + (stringp byte-compile-dest-file)) + ;; Being compiled. + 'compiling) + (t + ;; Being evaluated interactively. + nil))) + +(defsubst cc-bytecomp-is-compiling () + "Return non-nil if eval'ed during compilation." + (eq (cc-bytecomp-compiling-or-loading) 'compiling)) + +(defsubst cc-bytecomp-is-loading () + "Return non-nil if eval'ed during loading. +Nil will be returned if we're in a compilation triggered by the loading." + (eq (cc-bytecomp-compiling-or-loading) 'loading)) + (defun cc-bytecomp-setup-environment () ;; Eval'ed during compilation to setup variables, functions etc ;; declared with `cc-bytecomp-defvar' et al. - (if (not load-in-progress) - ;; Look at `load-in-progress' to tell whether we're called - ;; directly in the file being compiled or just from some file - ;; being loaded during compilation. + (if (not (cc-bytecomp-is-loading)) (let (p) (if cc-bytecomp-environment-set (error "Byte compilation environment already set - \ @@ -138,7 +190,7 @@ perhaps a `cc-bytecomp-restore-environment' is forgotten somewhere")) (defun cc-bytecomp-restore-environment () ;; Eval'ed during compilation to restore variables, functions etc ;; declared with `cc-bytecomp-defvar' et al. - (if (not load-in-progress) + (if (not (cc-bytecomp-is-loading)) (let (p) (setq p cc-bytecomp-unbound-variables) (while p @@ -282,8 +334,7 @@ use within `eval-when-compile'." `(eval-when-compile (if (and (fboundp 'cc-bytecomp-is-compiling) (cc-bytecomp-is-compiling)) - (if (or (not load-in-progress) - (not (featurep ,cc-part))) + (if (not (featurep ,cc-part)) (cc-bytecomp-load (symbol-name ,cc-part))) (require ,cc-part)))) @@ -296,12 +347,6 @@ afterwards. Don't use within `eval-when-compile'." (require ,feature) (eval-when-compile (cc-bytecomp-setup-environment)))) -(defun cc-bytecomp-is-compiling () - "Return non-nil if eval'ed during compilation. Don't use outside -`eval-when-compile'." - (and (boundp 'byte-compile-dest-file) - (stringp byte-compile-dest-file))) - (defmacro cc-bytecomp-defvar (var) "Binds the symbol as a variable during compilation of the file, to silence the byte compiler. Don't use within `eval-when-compile'." @@ -315,8 +360,7 @@ to silence the byte compiler. Don't use within `eval-when-compile'." "cc-bytecomp-defvar: Saving %s (as unbound)" ',var) (setq cc-bytecomp-unbound-variables (cons ',var cc-bytecomp-unbound-variables)))) - (if (and (cc-bytecomp-is-compiling) - (not load-in-progress)) + (if (cc-bytecomp-is-compiling) (progn (defvar ,var) (set ',var (intern (concat "cc-bytecomp-ignore-var:" @@ -344,8 +388,7 @@ at compile time, e.g. for macros and inline functions." (setq cc-bytecomp-original-functions (cons (list ',fun nil 'unbound) cc-bytecomp-original-functions)))) - (if (and (cc-bytecomp-is-compiling) - (not load-in-progress)) + (if (cc-bytecomp-is-compiling) (progn (fset ',fun (intern (concat "cc-bytecomp-ignore-fun:" (symbol-name ',fun)))) @@ -370,33 +413,6 @@ the file. Don't use outside `eval-when-compile'." "cc-bytecomp-put: Bound property %s for %s to %s" ,propname ,symbol ,value))) -(defmacro cc-bytecomp-obsolete-var (symbol) - "Suppress warnings that the given symbol is an obsolete variable. -Don't use within `eval-when-compile'." - `(eval-when-compile - (if (get ',symbol 'byte-obsolete-variable) - (cc-bytecomp-put ',symbol 'byte-obsolete-variable nil) - ;; This avoids a superfluous compiler warning - ;; about calling `get' for effect. - t))) - -(defun cc-bytecomp-ignore-obsolete (form) - ;; Wraps a call to `byte-compile-obsolete' that suppresses the warning. - (let ((byte-compile-warnings byte-compile-warnings)) - (byte-compile-disable-warning 'obsolete) - (byte-compile-obsolete form))) - -(defmacro cc-bytecomp-obsolete-fun (symbol) - "Suppress warnings that the given symbol is an obsolete function. -Don't use within `eval-when-compile'." - `(eval-when-compile - (if (eq (get ',symbol 'byte-compile) 'byte-compile-obsolete) - (cc-bytecomp-put ',symbol 'byte-compile - 'cc-bytecomp-ignore-obsolete) - ;; This avoids a superfluous compiler warning - ;; about calling `get' for effect. - t))) - (defmacro cc-bytecomp-boundp (symbol) "Return non-nil if the given symbol is bound as a variable outside the compilation. This is the same as using `boundp' but additionally @@ -423,4 +439,8 @@ exclude any functions that have been bound during compilation with (provide 'cc-bytecomp) +;;; Local Variables: +;;; indent-tabs-mode: t +;;; tab-width: 8 +;;; End: ;;; cc-bytecomp.el ends here diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index c2aa03167b0..68075f356ab 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -258,9 +258,11 @@ With universal argument, inserts the analysis as a comment on that line." "a" "") (if c-hungry-delete-key "h" "") (if (and - ;; subword might not be loaded. - (boundp 'subword-mode) - (symbol-value 'subword-mode)) + ;; (cc-)subword might not be loaded. + (boundp 'c-subword-mode) + (symbol-value 'c-subword-mode)) + ;; FIXME: subword-mode already comes with its + ;; own lighter! "w" ""))) ;; FIXME: Derived modes might want to use something else @@ -1090,7 +1092,7 @@ numeric argument is supplied, or the point is inside a literal." (interactive "*P") (let ((c-echo-syntactic-information-p nil) - final-pos close-paren-inserted found-delim case-fold-search) + final-pos found-delim case-fold-search) (self-insert-command (prefix-numeric-value arg)) (setq final-pos (point)) @@ -1155,11 +1157,12 @@ numeric argument is supplied, or the point is inside a literal." (when (and (eq (char-before) ?>) (not executing-kbd-macro) blink-paren-function) - ;; Note: Most paren blink functions, such as the standard - ;; `blink-matching-open', currently doesn't handle paren chars - ;; marked with text properties very well. Maybe we should avoid - ;; this call for the time being? - (funcall blink-paren-function))))) + ;; Currently (2014-10-19), the syntax-table text properties on < and > + ;; are only applied in code called during Emacs redisplay. We thus + ;; explicitly cause a redisplay so that these properties have been + ;; applied when `blink-paren-function' gets called. + (sit-for 0) + (funcall blink-paren-function))))) (defun c-electric-paren (arg) "Insert a parenthesis. @@ -1303,20 +1306,43 @@ keyword on the line, the keyword is not inserted inside a literal, and (declare-function subword-forward "subword" (&optional arg)) (declare-function subword-backward "subword" (&optional arg)) +(cond + ((and (fboundp 'subword-mode) (not (fboundp 'c-subword-mode))) + ;; Recent Emacsen come with their own subword support. Use that. + (define-obsolete-function-alias 'c-subword-mode 'subword-mode "24.3") + (define-obsolete-variable-alias 'c-subword-mode 'subword-mode "24.3")) + (t + ;; Autoload directive for emacsen that doesn't have an older CC Mode + ;; version in the dist. + (autoload 'c-subword-mode "cc-subword" + "Mode enabling subword movement and editing keys." t))) + ;; "nomenclature" functions + c-scope-operator. (defun c-forward-into-nomenclature (&optional arg) "Compatibility alias for `c-forward-subword'." (interactive "p") - (require 'subword) - (subword-forward arg)) -(make-obsolete 'c-forward-into-nomenclature 'subword-forward "23.2") + (if (fboundp 'subword-mode) + (progn + (require 'subword) + (subword-forward arg)) + (require 'cc-subword) + (c-forward-subword arg))) +(make-obsolete 'c-forward-into-nomenclature + (if (fboundp 'subword-mode) 'subword-forward 'c-forward-subword) + "23.2") (defun c-backward-into-nomenclature (&optional arg) "Compatibility alias for `c-backward-subword'." (interactive "p") - (require 'subword) - (subword-backward arg)) -(make-obsolete 'c-backward-into-nomenclature 'subword-backward "23.2") + (if (fboundp 'subword-mode) + (progn + (require 'subword) + (subword-backward arg)) + (require 'cc-subword) + (c-backward-subword arg))) +(make-obsolete + 'c-backward-into-nomenclature + (if (fboundp 'subword-mode) 'subword-backward 'c-backward-subword) "23.2") (defun c-scope-operator () "Insert a double colon scope operator at point. @@ -1416,12 +1442,15 @@ No indentation or other \"electric\" behavior is performed." (car (c-beginning-of-decl-1 ;; NOTE: If we're in a K&R region, this might be the start ;; of a parameter declaration, not the actual function. + ;; It might also leave us at a label or "label" like + ;; "private:". (and least-enclosing ; LIMIT for c-b-of-decl-1 (c-safe-position least-enclosing paren-state))))) ;; Has the declaration we've gone back to got braces? - (setq brace-decl-p - (save-excursion + (or (eq decl-result 'label) + (setq brace-decl-p + (save-excursion (and (c-syntactic-re-search-forward "[;{]" nil t t) (or (eq (char-before) ?\{) (and c-recognize-knr-p @@ -1429,10 +1458,11 @@ No indentation or other \"electric\" behavior is performed." ;; ';' in a K&R argdecl. In ;; that case the declaration ;; should contain a block. - (c-in-knr-argdecl)))))) + (c-in-knr-argdecl))))))) (cond - ((= (point) kluge-start) ; might be BOB or unbalanced parens. + ((or (eq decl-result 'label) ; e.g. "private:" or invalid syntax. + (= (point) kluge-start)) ; might be BOB or unbalanced parens. 'outwith-function) ((eq decl-result 'same) (if brace-decl-p @@ -1580,7 +1610,7 @@ defun." (or (not (eq this-command 'c-beginning-of-defun)) (eq last-command 'c-beginning-of-defun) - (and transient-mark-mode mark-active) + (c-region-is-active-p) (push-mark)) (c-save-buffer-state @@ -1704,7 +1734,7 @@ the open-parenthesis that starts a defun; see `beginning-of-defun'." (or (not (eq this-command 'c-end-of-defun)) (eq last-command 'c-end-of-defun) - (and transient-mark-mode mark-active) + (c-region-is-active-p) (push-mark)) (c-save-buffer-state @@ -1808,7 +1838,7 @@ with a brace block." (looking-at c-symbol-key)) (match-string-no-properties 0)) - ((looking-at "DEFUN\\_>") + ((looking-at "DEFUN\\s-*(") ;"DEFUN\\_>") think of XEmacs! ;; DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, ...) ==> Ffile_name_directory ;; DEFUN(POSIX::STREAM-LOCK, stream lockp &key BLOCK SHARED START LENGTH) ==> POSIX::STREAM-LOCK (down-list 1) @@ -2001,7 +2031,7 @@ function does not require the declaration to contain a brace block." (eq last-command 'c-mark-function))) (push-mark-p (and (eq this-command 'c-mark-function) (not extend-region-p) - (not (and transient-mark-mode mark-active))))) + (not (c-region-is-active-p))))) (if push-mark-p (push-mark (point))) (if extend-region-p (progn @@ -3338,7 +3368,7 @@ Otherwise, with a prefix argument, rigidly reindent the expression starting on the current line. Otherwise reindent just the current line." (interactive - (list current-prefix-arg (use-region-p))) + (list current-prefix-arg (c-region-is-active-p))) (if region (c-indent-region (region-beginning) (region-end)) (c-indent-command arg))) @@ -4727,4 +4757,8 @@ normally bound to C-o. See `c-context-line-break' for the details." (cc-provide 'cc-cmds) +;;; Local Variables: +;;; indent-tabs-mode: t +;;; tab-width: 8 +;;; End: ;;; cc-cmds.el ends here diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 9eaa4f83ad4..d0beab1d485 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -64,15 +64,14 @@ (not (fboundp 'push))) (cc-load "cc-fix"))) -; (eval-after-load "font-lock" ; 2006-07-09. font-lock is now preloaded -; ' -(if (and (featurep 'xemacs) ; There is now (2005/12) code in GNU Emacs CVS - ; to make the call to f-l-c-k throw an error. - (not (featurep 'cc-fix)) ; only load the file once. - (let (font-lock-keywords) - (font-lock-compile-keywords '("\\<\\>")) - font-lock-keywords)) ; did the previous call foul this up? - (load "cc-fix")) ;) +(when (featurep 'xemacs) ; There is now (2005/12) code in GNU Emacs CVS + ; to make the call to f-l-c-k throw an error. + (eval-after-load "font-lock" + '(if (and (not (featurep 'cc-fix)) ; only load the file once. + (let (font-lock-keywords) + (font-lock-compile-keywords '("\\<\\>")) + font-lock-keywords)) ; did the previous call foul this up? + (load "cc-fix")))) ;; The above takes care of the delayed loading, but this is necessary ;; to ensure correct byte compilation. @@ -86,10 +85,15 @@ font-lock-keywords))) (cc-load "cc-fix"))) +;; XEmacs 21.4 doesn't have `delete-dups'. +(eval-and-compile + (if (and (not (fboundp 'delete-dups)) + (not (featurep 'cc-fix))) + (cc-load "cc-fix"))) ;;; Variables also used at compile time. -(defconst c-version "5.32.5" +(defconst c-version "5.33" "CC Mode version number.") (defconst c-version-sym (intern c-version)) @@ -331,16 +335,42 @@ to it is returned. This function does not modify the point or the mark." (t (error "Unknown buffer position requested: %s" position)))) (point)))) +(eval-and-compile + ;; Constant to decide at compilation time whether to use category + ;; properties. Currently (2010-03) they're available only on GNU Emacs. + (defconst c-use-category + (with-temp-buffer + (let ((parse-sexp-lookup-properties t) + (lookup-syntax-properties t)) + (set-syntax-table (make-syntax-table)) + (insert "<()>") + (put-text-property (point-min) (1+ (point-min)) + 'category 'c-<-as-paren-syntax) + (put-text-property (+ 3 (point-min)) (+ 4 (point-min)) + 'category 'c->-as-paren-syntax) + (goto-char (point-min)) + (forward-sexp) + (= (point) (+ 4 (point-min))))))) + +(defvar c-use-extents) + +(defmacro c-next-single-property-change (position prop &optional object limit) + ;; See the doc string for either of the defuns expanded to. + (if (and c-use-extents + (fboundp 'next-single-char-property-change)) + ;; XEmacs >= 2005-01-25 + `(next-single-char-property-change ,position ,prop ,object ,limit) + ;; Emacs and earlier XEmacs + `(next-single-property-change ,position ,prop ,object ,limit))) + (defmacro c-region-is-active-p () ;; Return t when the region is active. The determination of region ;; activeness is different in both Emacs and XEmacs. - ;; FIXME? Emacs has region-active-p since 23.1, so maybe this test - ;; should be updated. - (if (cc-bytecomp-boundp 'mark-active) - ;; Emacs. - 'mark-active - ;; XEmacs. - '(region-active-p))) + (if (cc-bytecomp-fboundp 'region-active-p) + ;; XEmacs. + '(region-active-p) + ;; Old Emacs. + 'mark-active)) (defmacro c-set-region-active (activate) ;; Activate the region if ACTIVE is non-nil, deactivate it @@ -827,6 +857,8 @@ be after it." (defmacro c-with-syntax-table (table &rest code) ;; Temporarily switches to the specified syntax table in a failsafe ;; way to execute code. + ;; Maintainers' note: If TABLE is `c++-template-syntax-table', DON'T call + ;; any forms inside this that call `c-parse-state'. !!!! `(let ((c-with-syntax-table-orig-table (syntax-table))) (unwind-protect (progn @@ -915,6 +947,12 @@ MODE is either a mode symbol or a list of mode symbols." (cc-bytecomp-fboundp 'delete-extent) (cc-bytecomp-fboundp 'map-extents)))) +(defconst c-<-as-paren-syntax '(4 . ?>)) +(put 'c-<-as-paren-syntax 'syntax-table c-<-as-paren-syntax) + +(defconst c->-as-paren-syntax '(5 . ?<)) +(put 'c->-as-paren-syntax 'syntax-table c->-as-paren-syntax) + ;; `c-put-char-property' is complex enough in XEmacs and Emacs < 21 to ;; make it a function. (defalias 'c-put-char-property-fun @@ -1048,8 +1086,8 @@ nil; point is then left undefined." (while (and (< place ,(or limit '(point-max))) - (not (equal (get-text-property place ,property) ,value))) - (setq place (next-single-property-change + (not (equal (c-get-char-property place ,property) ,value))) + (setq place (c-next-single-property-change place ,property nil ,(or limit '(point-max))))) (when (< place ,(or limit '(point-max))) (goto-char place) @@ -1067,10 +1105,15 @@ point is then left undefined." (while (and (> place ,(or limit '(point-min))) - (not (equal (get-text-property (1- place) ,property) ,value))) - (setq place (previous-single-property-change + (not (equal (c-get-char-property (1- place) ,property) ,value))) + (setq place (,(if (and c-use-extents + (fboundp 'previous-single-char-property-change)) + ;; XEmacs > 2005-01-25. + 'previous-single-char-property-change + ;; Emacs and earlier XEmacs. + 'previous-single-property-change) place ,property nil ,(or limit '(point-min))))) - (when (> place ,(or limit '(point-max))) + (when (> place ,(or limit '(point-min))) (goto-char place) (search-backward-regexp ".") ; to set the match-data. (point)))) @@ -1087,9 +1130,9 @@ been put there by c-put-char-property. POINT remains unchanged." (and (< place to) (not (equal (get-text-property place property) value))) - (setq place (next-single-property-change place property nil to))) + (setq place (c-next-single-property-change place property nil to))) (< place to)) - (setq end-place (next-single-property-change place property nil to)) + (setq end-place (c-next-single-property-change place property nil to)) (remove-text-properties place end-place (cons property nil)) ;; Do we have to do anything with stickiness here? (setq place end-place)))) @@ -1106,7 +1149,7 @@ been put there by c-put-char-property. POINT remains unchanged." (if (equal (extent-property ext -property-) val) (delete-extent ext))) nil ,from ,to ,value nil -property-)) - ;; Gnu Emacs + ;; GNU Emacs `(c-clear-char-property-with-value-function ,from ,to ,property ,value))) ;; Macros to put overlays (Emacs) or extents (XEmacs) on buffer text. @@ -1190,42 +1233,43 @@ been put there by c-put-char-property. POINT remains unchanged." (if (< (point) start) (goto-char (point-max))))) -(defconst c-<-as-paren-syntax '(4 . ?>)) -(put 'c-<-as-paren-syntax 'syntax-table c-<-as-paren-syntax) - -(defsubst c-mark-<-as-paren (pos) +(defmacro c-mark-<-as-paren (pos) ;; Mark the "<" character at POS as a template opener using the - ;; `syntax-table' property via the `category' property. + ;; `syntax-table' property either directly (XEmacs) or via a `category' + ;; property (GNU Emacs). ;; ;; This function does a hidden buffer change. Note that we use ;; indirection through the `category' text property. This allows us to ;; toggle the property in all template brackets simultaneously and ;; cheaply. We use this, for instance, in `c-parse-state'. - (c-put-char-property pos 'category 'c-<-as-paren-syntax)) + (if c-use-category + `(c-put-char-property ,pos 'category 'c-<-as-paren-syntax) + `(c-put-char-property ,pos 'syntax-table c-<-as-paren-syntax))) -(defconst c->-as-paren-syntax '(5 . ?<)) -(put 'c->-as-paren-syntax 'syntax-table c->-as-paren-syntax) -(defsubst c-mark->-as-paren (pos) +(defmacro c-mark->-as-paren (pos) ;; Mark the ">" character at POS as an sexp list closer using the - ;; syntax-table property. + ;; `syntax-table' property either directly (XEmacs) or via a `category' + ;; property (GNU Emacs). ;; ;; This function does a hidden buffer change. Note that we use ;; indirection through the `category' text property. This allows us to ;; toggle the property in all template brackets simultaneously and ;; cheaply. We use this, for instance, in `c-parse-state'. - (c-put-char-property pos 'category 'c->-as-paren-syntax)) - -(defsubst c-unmark-<->-as-paren (pos) - ;; Unmark the "<" or "<" character at POS as an sexp list opener using - ;; the syntax-table property indirectly through the `category' text - ;; property. + (if c-use-category + `(c-put-char-property ,pos 'category 'c->-as-paren-syntax) + `(c-put-char-property ,pos 'syntax-table c->-as-paren-syntax))) + +(defmacro c-unmark-<->-as-paren (pos) + ;; Unmark the "<" or "<" character at POS as an sexp list opener using the + ;; `syntax-table' property either directly or indirectly through a + ;; `category' text property. ;; - ;; This function does a hidden buffer change. Note that we use + ;; This function does a hidden buffer change. Note that we try to use ;; indirection through the `category' text property. This allows us to ;; toggle the property in all template brackets simultaneously and ;; cheaply. We use this, for instance, in `c-parse-state'. - (c-clear-char-property pos 'category)) + `(c-clear-char-property ,pos ,(if c-use-category ''category ''syntax-table))) (defsubst c-suppress-<->-as-parens () ;; Suppress the syntactic effect of all marked < and > as parens. Note @@ -1306,6 +1350,124 @@ been put there by c-put-char-property. POINT remains unchanged." (widen) (c-set-cpp-delimiters ,beg ,end))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The following macros are to be used only in `c-parse-state' and its +;; subroutines. Their main purpose is to simplify the handling of C++/Java +;; template delimiters and CPP macros. In GNU Emacs, this is done slickly by +;; the judicious use of 'category properties. These don't exist in XEmacs. +;; +;; Note: in the following macros, there is no special handling for parentheses +;; inside CPP constructs. That is because CPPs are always syntactically +;; balanced, thanks to `c-neutralize-CPP-line' in cc-mode.el. +(defmacro c-sc-scan-lists-no-category+1+1 (from) + ;; Do a (scan-lists FROM 1 1). Any finishing position which either (i) is + ;; determined by and angle bracket; or (ii) is inside a macro whose start + ;; isn't POINT-MACRO-START doesn't count as a finishing position. + `(let ((here (point)) + (pos (scan-lists ,from 1 1))) + (while (eq (char-before pos) ?>) + (setq pos (scan-lists pos 1 1))) + pos)) + +(defmacro c-sc-scan-lists-no-category+1-1 (from) + ;; Do a (scan-lists FROM 1 -1). Any finishing position which either (i) is + ;; determined by an angle bracket; or (ii) is inside a macro whose start + ;; isn't POINT-MACRO-START doesn't count as a finishing position. + `(let ((here (point)) + (pos (scan-lists ,from 1 -1))) + (while (eq (char-before pos) ?<) + (setq pos (scan-lists pos 1 1)) + (setq pos (scan-lists pos 1 -1))) + pos)) + +(defmacro c-sc-scan-lists-no-category-1+1 (from) + ;; Do a (scan-lists FROM -1 1). Any finishing position which either (i) is + ;; determined by and angle bracket; or (ii) is inside a macro whose start + ;; isn't POINT-MACRO-START doesn't count as a finishing position. + `(let ((here (point)) + (pos (scan-lists ,from -1 1))) + (while (eq (char-after pos) ?<) + (setq pos (scan-lists pos -1 1))) + pos)) + +(defmacro c-sc-scan-lists-no-category-1-1 (from) + ;; Do a (scan-lists FROM -1 -1). Any finishing position which either (i) is + ;; determined by and angle bracket; or (ii) is inside a macro whose start + ;; isn't POINT-MACRO-START doesn't count as a finishing position. + `(let ((here (point)) + (pos (scan-lists ,from -1 -1))) + (while (eq (char-after pos) ?>) + (setq pos (scan-lists pos -1 1)) + (setq pos (scan-lists pos -1 -1))) + pos)) + +(defmacro c-sc-scan-lists (from count depth) + (if c-use-category + `(scan-lists ,from ,count ,depth) + (cond + ((and (eq count 1) (eq depth 1)) + `(c-sc-scan-lists-no-category+1+1 ,from)) + ((and (eq count 1) (eq depth -1)) + `(c-sc-scan-lists-no-category+1-1 ,from)) + ((and (eq count -1) (eq depth 1)) + `(c-sc-scan-lists-no-category-1+1 ,from)) + ((and (eq count -1) (eq depth -1)) + `(c-sc-scan-lists-no-category-1-1 ,from)) + (t (error "Invalid parameter(s) to c-sc-scan-lists"))))) + + +(defun c-sc-parse-partial-sexp-no-category (from to targetdepth stopbefore + oldstate) + ;; Do a parse-partial-sexp using the supplied arguments, disregarding + ;; template/generic delimiters < > and disregarding macros other than the + ;; one at POINT-MACRO-START. + ;; + ;; NOTE that STOPBEFORE must be nil. TARGETDEPTH should be one less than + ;; the depth in OLDSTATE. This function is thus a SPECIAL PURPOSE variation + ;; on parse-partial-sexp, designed for calling from + ;; `c-remove-stale-state-cache'. + ;; + ;; Any finishing position which is determined by an angle bracket delimiter + ;; doesn't count as a finishing position. + ;; + ;; Note there is no special handling of CPP constructs here, since these are + ;; always syntactically balanced (thanks to `c-neutralize-CPP-line'). + (let ((state + (parse-partial-sexp from to targetdepth stopbefore oldstate))) + (while + (and (< (point) to) + ;; We must have hit targetdepth. + (or (eq (char-before) ?<) + (eq (char-before) ?>))) + (setcar state + (if (memq (char-before) '(?> ?\) ?\} ?\])) + (1+ (car state)) + (1- (car state)))) + (setq state + (parse-partial-sexp (point) to targetdepth stopbefore oldstate))) + state)) + +(defmacro c-sc-parse-partial-sexp (from to &optional targetdepth stopbefore + oldstate) + (if c-use-category + `(parse-partial-sexp ,from ,to ,targetdepth ,stopbefore ,oldstate) + `(c-sc-parse-partial-sexp-no-category ,from ,to ,targetdepth ,stopbefore + ,oldstate))) + + +(defvar c-emacs-features) + +(defmacro c-looking-at-non-alphnumspace () + "Are we looking at a character which isn't alphanumeric or space?" + (if (memq 'gen-comment-delim c-emacs-features) + `(looking-at +"\\([;#]\\|\\'\\|\\s(\\|\\s)\\|\\s\"\\|\\s\\\\|\\s$\\|\\s<\\|\\s>\\|\\s!\\)") + `(or (looking-at +"\\([;#]\\|\\'\\|\\s(\\|\\s)\\|\\s\"\\|\\s\\\\|\\s$\\|\\s<\\|\\s>\\)" + (let ((prop (c-get-char-property (point) 'syntax-table))) + (eq prop '(14))))))) ; '(14) is generic comment delimiter. + + (defsubst c-intersect-lists (list alist) ;; return the element of ALIST that matches the first element found ;; in LIST. Uses assq. @@ -1421,8 +1583,8 @@ Notably, null elements in LIST are ignored." (defun c-make-keywords-re (adorn list &optional mode) "Make a regexp that matches all the strings the list. -Duplicates and nil elements in the list are removed. The resulting -regexp may contain zero or more submatch expressions. +Duplicates and nil elements in the list are removed. The +resulting regexp may contain zero or more submatch expressions. If ADORN is t there will be at least one submatch and the first surrounds the matched alternative, and the regexp will also not match @@ -1440,11 +1602,7 @@ The optional MODE specifies the language to get `c-nonsymbol-key' from when it's needed. The default is the current language taken from `c-buffer-is-cc-mode'." - (let (unique) - (dolist (elt list) - (unless (member elt unique) - (push elt unique))) - (setq list (delete nil unique))) + (setq list (delete nil (delete-dups list))) (if list (let (re) @@ -1558,6 +1716,8 @@ non-nil, a caret is prepended to invert the set." (cc-bytecomp-defvar open-paren-in-column-0-is-defun-start) +(defvar lookup-syntax-properties) ;XEmacs. + (defconst c-emacs-features (let (list) @@ -1609,6 +1769,9 @@ non-nil, a caret is prepended to invert the set." (not (end-of-defun)))) (setq list (cons 'argumentative-bod-function list)))) + ;; Record whether the `category' text property works. + (if c-use-category (setq list (cons 'category-properties list))) + (let ((buf (generate-new-buffer " test")) parse-sexp-lookup-properties parse-sexp-ignore-comments @@ -1638,13 +1801,13 @@ non-nil, a caret is prepended to invert the set." "support for the `syntax-table' text property " "is required."))) - ;; Find out if generic comment delimiters work. + ;; Find out if "\\s!" (generic comment delimiters) work. (c-safe (modify-syntax-entry ?x "!") (if (string-match "\\s!" "x") (setq list (cons 'gen-comment-delim list)))) - ;; Find out if generic string delimiters work. + ;; Find out if "\\s|" (generic string delimiters) work. (c-safe (modify-syntax-entry ?x "|") (if (string-match "\\s|" "x") @@ -1691,7 +1854,8 @@ non-nil, a caret is prepended to invert the set." (kill-buffer buf)) ;; See if `parse-partial-sexp' returns the eighth element. - (if (c-safe (>= (length (save-excursion (parse-partial-sexp (point) (point)))) + (if (c-safe (>= (length (save-excursion + (parse-partial-sexp (point) (point)))) 10)) (setq list (cons 'pps-extended-state list)) (error (concat @@ -1707,13 +1871,14 @@ might be present: '8-bit 8 bit syntax entry flags (XEmacs style). '1-bit 1 bit syntax entry flags (Emacs style). -'argumentative-bod-function beginning-of-defun passes ARG through - to a non-null beginning-of-defun-function. It is assumed - the end-of-defun does the same thing. +'argumentative-bod-function beginning-of-defun and end-of-defun pass + ARG through to beginning/end-of-defun-function. 'syntax-properties It works to override the syntax for specific characters in the buffer with the 'syntax-table property. It's always set - CC Mode no longer works in emacsen without this feature. +'category-properties Syntax routines can add a level of indirection to text + properties using the 'category property. 'gen-comment-delim Generic comment delimiters work (i.e. the syntax class `!'). 'gen-string-delim Generic string delimiters work @@ -1804,11 +1969,11 @@ system." (put mode 'c-fallback-mode base-mode)) (defvar c-lang-constants (make-vector 151 0)) -;; This obarray is a cache to keep track of the language constants -;; defined by `c-lang-defconst' and the evaluated values returned by -;; `c-lang-const'. It's mostly used at compile time but it's not +;; Obarray used as a cache to keep track of the language constants. +;; The constants stored are those defined by `c-lang-defconst' and the values +;; computed by `c-lang-const'. It's mostly used at compile time but it's not ;; stored in compiled files. -;; + ;; The obarray contains all the language constants as symbols. The ;; value cells hold the evaluated values as alists where each car is ;; the mode name symbol and the corresponding cdr is the evaluated @@ -1818,20 +1983,25 @@ system." (defvar c-lang-const-expansion nil) +;; Ugly hack to pull in the definition of `cc-bytecomp-compiling-or-loading` +;; from cc-bytecomp to make it available at loadtime. This is the same +;; mechanism used in cc-mode.el for `c-populate-syntax-table'. +(defalias 'cc-bytecomp-compiling-or-loading + (cc-eval-when-compile + (let ((f (symbol-function 'cc-bytecomp-compiling-or-loading))) + (if (byte-code-function-p f) f (byte-compile f))))) + (defsubst c-get-current-file () ;; Return the base name of the current file. - (let ((file (cond - (load-in-progress - ;; Being loaded. - load-file-name) - ((and (boundp 'byte-compile-dest-file) - (stringp byte-compile-dest-file)) - ;; Being compiled. - byte-compile-dest-file) - (t - ;; Being evaluated interactively. - (buffer-file-name))))) - (and file (file-name-base file)))) + (let* ((c-or-l (cc-bytecomp-compiling-or-loading)) + (file + (cond + ((eq c-or-l 'loading) load-file-name) + ((eq c-or-l 'compiling) byte-compile-dest-file) + ((null c-or-l) (buffer-file-name))))) + (and file + (file-name-sans-extension + (file-name-nondirectory file))))) (defmacro c-lang-defconst-eval-immediately (form) "Can be used inside a VAL in `c-lang-defconst' to evaluate FORM @@ -1895,11 +2065,14 @@ constant. A file is identified by its base name." ;; language constant source definitions.) (c-lang-const-expansion 'call) (c-langs-are-parametric t) + (file (intern + (or (c-get-current-file) + (error "`c-lang-defconst' can only be used in a file")))) bindings pre-files) (or (symbolp name) - (error "Not a symbol: %s" name)) + (error "Not a symbol: %S" name)) (when (stringp (car-safe args)) ;; The docstring is hardly used anywhere since there's no normal @@ -1909,7 +2082,7 @@ constant. A file is identified by its base name." (setq args (cdr args))) (or args - (error "No assignments in `c-lang-defconst' for %s" name)) + (error "No assignments in `c-lang-defconst' for %S" name)) ;; Rework ARGS to an association list to make it easier to handle. ;; It's reversed at the same time to make it easier to implement @@ -1923,17 +2096,17 @@ constant. A file is identified by its base name." ((listp (car args)) (mapcar (lambda (lang) (or (symbolp lang) - (error "Not a list of symbols: %s" + (error "Not a list of symbols: %S" (car args))) (intern (concat (symbol-name lang) "-mode"))) (car args))) - (t (error "Not a symbol or a list of symbols: %s" + (t (error "Not a symbol or a list of symbols: %S" (car args))))) val) (or (cdr args) - (error "No value for %s" (car args))) + (error "No value for %S" (car args))) (setq args (cdr args) val (car args)) @@ -1947,19 +2120,24 @@ constant. A file is identified by its base name." ;; dependencies on the `c-lang-const's in VAL.) (setq val (c--macroexpand-all val)) - (setq bindings (cons (cons assigned-mode val) bindings) + (setq bindings `(cons (cons ',assigned-mode (lambda () ,val)) ,bindings) args (cdr args)))) ;; Compile in the other files that have provided source ;; definitions for this symbol, to make sure the order in the ;; `source' property is correct even when files are loaded out of ;; order. - (setq pre-files (nreverse - ;; Reverse to get the right load order. - (mapcar 'car (get sym 'source)))) + (setq pre-files (mapcar 'car (get sym 'source))) + (if (memq file pre-files) + ;; This can happen when the source file (e.g. cc-langs.el) is first + ;; loaded as source, setting a 'source property entry, and then itself + ;; being compiled. + (setq pre-files (cdr (memq file pre-files)))) + ;; Reverse to get the right load order. + (setq pre-files (nreverse pre-files)) `(eval-and-compile - (c-define-lang-constant ',name ',bindings + (c-define-lang-constant ',name ,bindings ,@(and pre-files `(',pre-files)))))) (put 'c-lang-defconst 'lisp-indent-function 1) @@ -2024,19 +2202,16 @@ language. NAME and LANG are not evaluated so they should not be quoted." (or (symbolp name) - (error "Not a symbol: %s" name)) + (error "Not a symbol: %S" name)) (or (symbolp lang) - (error "Not a symbol: %s" lang)) + (error "Not a symbol: %S" lang)) (let ((sym (intern (symbol-name name) c-lang-constants)) - mode source-files args) + (mode (when lang (intern (concat (symbol-name lang) "-mode"))))) - (when lang - (setq mode (intern (concat (symbol-name lang) "-mode"))) - (unless (get mode 'c-mode-prefix) - (error - "Unknown language %S since it got no `c-mode-prefix' property" - (symbol-name lang)))) + (or (get mode 'c-mode-prefix) (null mode) + (error "Unknown language %S: no `c-mode-prefix' property" + lang)) (if (eq c-lang-const-expansion 'immediate) ;; No need to find out the source file(s) when we evaluate @@ -2044,49 +2219,54 @@ quoted." ;; `source' property. `',(c-get-lang-constant name nil mode) - (let ((file (c-get-current-file))) - (if file (setq file (intern file))) - ;; Get the source file(s) that must be loaded to get the value - ;; of the constant. If the symbol isn't defined yet we assume - ;; that its definition will come later in this file, and thus - ;; are no file dependencies needed. - (setq source-files (nreverse - ;; Reverse to get the right load order. - (apply 'nconc - (mapcar (lambda (elem) - (if (eq file (car elem)) - nil ; Exclude our own file. - (list (car elem)))) - (get sym 'source)))))) - - ;; Make some effort to do a compact call to - ;; `c-get-lang-constant' since it will be compiled in. - (setq args (and mode `(',mode))) - (if (or source-files args) - (setq args (cons (and source-files `',source-files) - args))) - - (if (or (eq c-lang-const-expansion 'call) - (and (not c-lang-const-expansion) - (not mode)) - load-in-progress - (not (boundp 'byte-compile-dest-file)) - (not (stringp byte-compile-dest-file))) - ;; Either a straight call is requested in the context, or - ;; we're in an "uncontrolled" context and got no language, - ;; or we're not being byte compiled so the compile time - ;; stuff below is unnecessary. - `(c-get-lang-constant ',name ,@args) - - ;; Being compiled. If the loading and compiling version is - ;; the same we use a value that is evaluated at compile time, - ;; otherwise it's evaluated at runtime. - `(if (eq c-version-sym ',c-version-sym) - (cc-eval-when-compile - (c-get-lang-constant ',name ,@args)) - (c-get-lang-constant ',name ,@args)))))) - -(defvar c-lang-constants-under-evaluation nil) + (let ((source-files + (let ((file (c-get-current-file))) + (if file (setq file (intern file))) + ;; Get the source file(s) that must be loaded to get the value + ;; of the constant. If the symbol isn't defined yet we assume + ;; that its definition will come later in this file, and thus + ;; are no file dependencies needed. + (nreverse + ;; Reverse to get the right load order. + (apply 'nconc + (mapcar (lambda (elem) + (if (eq file (car elem)) + nil ; Exclude our own file. + (list (car elem)))) + (get sym 'source)))))) + ;; Make some effort to do a compact call to + ;; `c-get-lang-constant' since it will be compiled in. + (args (and mode `(',mode)))) + + (if (or source-files args) + (push (and source-files `',source-files) args)) + + (if (or (eq c-lang-const-expansion 'call) + (and (not c-lang-const-expansion) + (not mode)) + (not (cc-bytecomp-is-compiling))) + ;; Either a straight call is requested in the context, or + ;; we're in an "uncontrolled" context and got no language, + ;; or we're not being byte compiled so the compile time + ;; stuff below is unnecessary. + `(c-get-lang-constant ',name ,@args) + + ;; Being compiled. If the loading and compiling version is + ;; the same we use a value that is evaluated at compile time, + ;; otherwise it's evaluated at runtime. + `(if (eq c-version-sym ',c-version-sym) + (cc-eval-when-compile + (c-get-lang-constant ',name ,@args)) + (c-get-lang-constant ',name ,@args))))))) + +(defvar c-lang-constants-under-evaluation nil + "Alist of constants in the process of being evaluated. +The `cdr' of each entry indicates how far we've looked in the list +of definitions, so that the def for var FOO in c-mode can be defined in +terms of the def for that same var FOO (which will then rely on the +fallback definition for all modes, to break the cycle).") + +(defconst c-lang--novalue "novalue") (defun c-get-lang-constant (name &optional source-files mode) ;; Used by `c-lang-const'. @@ -2152,7 +2332,7 @@ quoted." ;; mode might have an explicit entry before that. (eq (setq value (c-find-assignment-for-mode (cdr source-pos) mode nil name)) - c-lang-constants) + c-lang--novalue) ;; Try again with the fallback mode from the ;; original position. Note that ;; `c-buffer-is-cc-mode' still is the real mode if @@ -2160,22 +2340,22 @@ quoted." (eq (setq value (c-find-assignment-for-mode (setcdr source-pos backup-source-pos) fallback t name)) - c-lang-constants))) + c-lang--novalue))) ;; A simple lookup with no fallback mode. (eq (setq value (c-find-assignment-for-mode (cdr source-pos) mode t name)) - c-lang-constants)) + c-lang--novalue)) (error - "`%s' got no (prior) value in %s (might be a cyclic reference)" + "`%s' got no (prior) value in %S (might be a cyclic reference)" name mode)) (condition-case err - (setq value (eval value)) + (setq value (funcall value)) (error ;; Print a message to aid in locating the error. We don't ;; print the error itself since that will be done later by ;; some caller higher up. - (message "Eval error in the `c-lang-defconst' for `%s' in %s:" + (message "Eval error in the `c-lang-defconst' for `%S' in %s:" sym mode) (makunbound sym) (signal (car err) (cdr err)))) @@ -2183,13 +2363,13 @@ quoted." (set sym (cons (cons mode value) (symbol-value sym))) value)))) -(defun c-find-assignment-for-mode (source-pos mode match-any-lang name) +(defun c-find-assignment-for-mode (source-pos mode match-any-lang _name) ;; Find the first assignment entry that applies to MODE at or after ;; SOURCE-POS. If MATCH-ANY-LANG is non-nil, entries with `t' as ;; the language list are considered to match, otherwise they don't. ;; On return SOURCE-POS is updated to point to the next assignment ;; after the returned one. If no assignment is found, - ;; `c-lang-constants' is returned as a magic value. + ;; `c-lang--novalue' is returned as a magic value. ;; ;; SOURCE-POS is a vector that points out a specific assignment in ;; the double alist that's used in the `source' property. The first @@ -2245,7 +2425,7 @@ quoted." match-any-lang) (throw 'found (cdr assignment)))) - c-lang-constants))) + c-lang--novalue))) (defun c-lang-major-mode-is (mode) ;; `c-major-mode-is' expands to a call to this function inside @@ -2266,4 +2446,8 @@ quoted." (cc-provide 'cc-defs) +;;; Local Variables: +;;; indent-tabs-mode: t +;;; tab-width: 8 +;;; End: ;;; cc-defs.el ends here diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 1f4aa819a53..328e0f79a1c 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -147,18 +147,19 @@ (cc-require-when-compile 'cc-langs) (cc-require 'cc-vars) +(eval-when-compile (require 'cl)) + ;; Make declarations for all the `c-lang-defvar' variables in cc-langs. (defmacro c-declare-lang-variables () `(progn - ,@(apply 'nconc - (mapcar (lambda (init) - `(,(if (elt init 2) - `(defvar ,(car init) nil ,(elt init 2)) - `(defvar ,(car init) nil)) - (make-variable-buffer-local ',(car init)))) - (cdr c-lang-variable-inits))))) + ,@(mapcan (lambda (init) + `(,(if (elt init 2) + `(defvar ,(car init) nil ,(elt init 2)) + `(defvar ,(car init) nil)) + (make-variable-buffer-local ',(car init)))) + (cdr c-lang-variable-inits)))) (c-declare-lang-variables) @@ -533,7 +534,7 @@ comment at the start of cc-engine.el for more info." (while (progn (when (eq (get-text-property (point) 'c-type) value) (c-clear-char-property (point) 'c-type)) - (goto-char (next-single-property-change (point) 'c-type nil to)) + (goto-char (c-next-single-property-change (point) 'c-type nil to)) (< (point) to))))) @@ -845,7 +846,6 @@ comment at the start of cc-engine.el for more info." ;; Record this as the first token if not starting inside it. (setq tok start)) - ;; The following while loop goes back one sexp (balanced parens, ;; etc. with contents, or symbol or suchlike) each iteration. This ;; movement is accomplished with a call to c-backward-sexp approx 170 @@ -1052,7 +1052,10 @@ comment at the start of cc-engine.el for more info." ;; Just gone back over a brace block? ((and (eq (char-after) ?{) - (not (c-looking-at-inexpr-block lim nil t))) + (not (c-looking-at-inexpr-block lim nil t)) + (save-excursion + (c-backward-token-2 1 t nil) + (not (looking-at "=\\([^=]\\|$\\)")))) (save-excursion (c-forward-sexp) (point))) ;; Just gone back over some paren block? @@ -1720,7 +1723,7 @@ comment at the start of cc-engine.el for more info." ;; the cases when the marked rung is complete. ;; (`next-single-property-change' is certain to move at least one ;; step forward.) - (setq rung-pos (1- (next-single-property-change + (setq rung-pos (1- (c-next-single-property-change rung-is-marked 'c-is-sws nil rung-end-pos))) ;; Got no marked rung here. Since the simple ws might have started ;; inside a line comment or cpp directive we must set `rung-pos' as @@ -1736,7 +1739,7 @@ comment at the start of cc-engine.el for more info." ;; The following search is the main reason that `c-in-sws' ;; and `c-is-sws' aren't combined to one property. - (goto-char (next-single-property-change + (goto-char (c-next-single-property-change (point) 'c-in-sws nil (point-max))) (unless (get-text-property (point) 'c-is-sws) ;; If the `c-in-sws' region extended past the last @@ -1858,7 +1861,7 @@ comment at the start of cc-engine.el for more info." ;; possible since we can't be in the ending ws of a line comment or ;; cpp directive now. (if (setq rung-is-marked next-rung-is-marked) - (setq rung-pos (1- (next-single-property-change + (setq rung-pos (1- (c-next-single-property-change rung-is-marked 'c-is-sws nil rung-end-pos))) (setq rung-pos next-rung-pos)) (setq safe-start t))) @@ -1936,7 +1939,7 @@ comment at the start of cc-engine.el for more info." (unless (get-text-property (point) 'c-is-sws) ;; If the `c-in-sws' region extended past the first ;; `c-is-sws' char we have to go forward a bit. - (goto-char (next-single-property-change + (goto-char (c-next-single-property-change (point) 'c-is-sws))) (c-debug-sws-msg @@ -2175,7 +2178,6 @@ comment at the start of cc-engine.el for more info." ;; the middle of the desert, as long as it is not within a brace pair ;; recorded in `c-state-cache' or a paren/bracket pair. - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; We maintain a simple cache of positions which aren't in a literal, so as to ;; speed up testing for non-literality. @@ -2545,7 +2547,7 @@ comment at the start of cc-engine.el for more info." (setq pos here+) (c-safe (while - (setq ren+1 (scan-lists pos 1 1)) ; might signal + (setq ren+1 (c-sc-scan-lists pos 1 1)) ; might signal (setq lonely-rens (cons ren+1 lonely-rens) pos ren+1))))) @@ -2557,7 +2559,7 @@ comment at the start of cc-engine.el for more info." (c-safe (while (and lonely-rens ; actual values aren't used. - (setq pa (scan-lists pos -1 1))) + (setq pa (c-sc-scan-lists pos -1 1))) (setq pos pa) (setq lonely-rens (cdr lonely-rens))))) pos)) @@ -2713,8 +2715,8 @@ comment at the start of cc-engine.el for more info." (progn (c-safe (while - (and (setq ce (scan-lists bra -1 -1)) ; back past )/]/}; might signal - (setq bra (scan-lists ce -1 1)) ; back past (/[/{; might signal + (and (setq ce (c-sc-scan-lists bra -1 -1)) ; back past )/]/}; might signal + (setq bra (c-sc-scan-lists ce -1 1)) ; back past (/[/{; might signal (or (> bra here) ;(> ce here) (and (< ce here) @@ -2766,7 +2768,7 @@ comment at the start of cc-engine.el for more info." (not (c-beginning-of-macro)))) (setq c-state-cache (cons (cons (1- bra+1) - (scan-lists bra+1 1 1)) + (c-sc-scan-lists bra+1 1 1)) (if (consp (car c-state-cache)) (cdr c-state-cache) c-state-cache))) @@ -2795,7 +2797,7 @@ comment at the start of cc-engine.el for more info." paren+1 ; Pos after some opening or closing paren. paren+1s ; A list of `paren+1's; used to determine a ; good-pos. - bra+1 ce+1 ; just after L/R bra-ces. + bra+1 ; just after L bra-ce. bra+1s ; list of OLD values of bra+1. mstart) ; start of a macro. @@ -2816,9 +2818,9 @@ comment at the start of cc-engine.el for more info." ;; are no more b/b/p's to scan. (c-safe (while t - (setq pa+1 (scan-lists ren+1 1 -1) ; Into (/{/[; might signal + (setq pa+1 (c-sc-scan-lists ren+1 1 -1) ; Into (/{/[; might signal paren+1s (cons pa+1 paren+1s)) - (setq ren+1 (scan-lists pa+1 1 1)) ; Out of )/}/]; might signal + (setq ren+1 (c-sc-scan-lists pa+1 1 1)) ; Out of )/}/]; might signal (if (and (eq (char-before pa+1) ?{)) ; Check for a macro later. (setq bra+1 pa+1)) (setcar paren+1s ren+1))) @@ -2842,7 +2844,7 @@ comment at the start of cc-engine.el for more info." ;; finished - we just need to check for having found an ;; unmatched )/}/], which we ignore. Such a )/}/] can't be in a ;; macro, due the action of `c-neutralize-syntax-in-CPP'. - (c-safe (setq ren+1 (scan-lists ren+1 1 1)))))) ; acts as loop control. + (c-safe (setq ren+1 (c-sc-scan-lists ren+1 1 1)))))) ; acts as loop control. ;; Record the final, innermost, brace-pair if there is one. (c-state-push-any-brace-pair bra+1 macro-start-or-here) @@ -2945,7 +2947,7 @@ comment at the start of cc-engine.el for more info." ;; The next loop jumps forward out of a nested level of parens each ;; time round; the corresponding elements in `c-state-cache' are ;; removed. `pos' is just after the brace-pair or the open paren at - ;; (car c-state-cache). There can be no open parens/braces/brackets + ;; (car c-state-cache). There can be no open parens/braces/brackets ;; between `start-point'/`start-point-actual-macro-start' and HERE, ;; due to the interface spec to this function. (setq pos (if (and start-point-actual-macro-end @@ -2969,7 +2971,7 @@ comment at the start of cc-engine.el for more info." ;; Scan! (setq pps-state - (parse-partial-sexp + (c-sc-parse-partial-sexp (point) (if (< (point) pps-point) pps-point here) target-depth nil pps-state)) @@ -3000,9 +3002,10 @@ comment at the start of cc-engine.el for more info." ))) (if (< (point) pps-point) - (setq pps-state (parse-partial-sexp (point) pps-point - nil nil ; TARGETDEPTH, STOPBEFORE - pps-state))) + (setq pps-state (c-sc-parse-partial-sexp + (point) pps-point + nil nil ; TARGETDEPTH, STOPBEFORE + pps-state))) ;; If the last paren pair we moved out of was actually a brace pair, ;; insert it into `c-state-cache'. @@ -3123,12 +3126,15 @@ comment at the start of cc-engine.el for more info." (save-restriction (narrow-to-region here-bol (point-max)) (setq pos here-lit-start) - (c-safe (while (setq pa (scan-lists pos -1 1)) + (c-safe (while (setq pa (c-sc-scan-lists pos -1 1)) (setq pos pa)))) ; might signal nil)) ; for the cond - ((setq ren (c-safe-scan-lists pos -1 -1 too-far-back)) - ;; CASE 3: After a }/)/] before `here''s BOL. + ((save-restriction + (narrow-to-region too-far-back (point-max)) + (setq ren (c-safe (c-sc-scan-lists pos -1 -1)))) + + ;; CASE 3: After a }/)/] before `here''s BOL. (list (1+ ren) (and dropped-cons pos) nil)) ; Return value (t @@ -3311,7 +3317,7 @@ comment at the start of cc-engine.el for more info." (setq res (c-remove-stale-state-cache start-point here here-bopl)) (setq cache-pos (car res) scan-backward-pos (cadr res) - cons-separated (car (cddr res)) + cons-separated (car (cddr res)) bopl-state (cadr (cddr res))) ; will be nil if (< here-bopl ; start-point) (if (and scan-backward-pos @@ -3350,15 +3356,19 @@ comment at the start of cc-engine.el for more info." ;; of all parens in preprocessor constructs, except for any such construct ;; containing point. We can then call `c-invalidate-state-cache-1' without ;; worrying further about macros and template delimiters. - (c-with-<->-as-parens-suppressed - (if (and c-state-old-cpp-beg - (< c-state-old-cpp-beg here)) - (c-with-all-but-one-cpps-commented-out - c-state-old-cpp-beg - (min c-state-old-cpp-end here) - (c-invalidate-state-cache-1 here)) - (c-with-cpps-commented-out - (c-invalidate-state-cache-1 here))))) + (if (eval-when-compile (memq 'category-properties c-emacs-features)) + ;; Emacs + (c-with-<->-as-parens-suppressed + (if (and c-state-old-cpp-beg + (< c-state-old-cpp-beg here)) + (c-with-all-but-one-cpps-commented-out + c-state-old-cpp-beg + (min c-state-old-cpp-end here) + (c-invalidate-state-cache-1 here)) + (c-with-cpps-commented-out + (c-invalidate-state-cache-1 here)))) + ;; XEmacs + (c-invalidate-state-cache-1 here))) (defmacro c-state-maybe-marker (place marker) ;; If PLACE is non-nil, return a marker marking it, otherwise nil. @@ -3386,13 +3396,17 @@ comment at the start of cc-engine.el for more info." ;; FIXME!!! Put in a `condition-case' here to protect the integrity of the ;; subsystem. (prog1 - (c-with-<->-as-parens-suppressed - (if (and here-cpp-beg (> here-cpp-end here-cpp-beg)) - (c-with-all-but-one-cpps-commented-out - here-cpp-beg here-cpp-end - (c-parse-state-1)) - (c-with-cpps-commented-out - (c-parse-state-1)))) + (if (eval-when-compile (memq 'category-properties c-emacs-features)) + ;; Emacs + (c-with-<->-as-parens-suppressed + (if (and here-cpp-beg (> here-cpp-end here-cpp-beg)) + (c-with-all-but-one-cpps-commented-out + here-cpp-beg here-cpp-end + (c-parse-state-1)) + (c-with-cpps-commented-out + (c-parse-state-1)))) + ;; XEmacs + (c-parse-state-1)) (setq c-state-old-cpp-beg (c-state-maybe-marker here-cpp-beg c-state-old-cpp-beg-marker) c-state-old-cpp-end @@ -3407,6 +3421,7 @@ comment at the start of cc-engine.el for more info." (defvar c-parse-state-point nil) (defvar c-parse-state-state nil) +(make-variable-buffer-local 'c-parse-state-state) (defun c-record-parse-state-state () (setq c-parse-state-point (point)) (setq c-parse-state-state @@ -3414,9 +3429,9 @@ comment at the start of cc-engine.el for more info." (lambda (arg) (let ((val (symbol-value arg))) (cons arg - (if (consp val) - (copy-tree val) - val)))) + (cond ((consp val) (copy-tree val)) + ((markerp val) (copy-marker val)) + (t val))))) '(c-state-cache c-state-cache-good-pos c-state-nonlit-pos-cache @@ -3436,7 +3451,11 @@ comment at the start of cc-engine.el for more info." (concat "(setq " (mapconcat (lambda (arg) - (format "%s %s%s" (car arg) (if (atom (cdr arg)) "" "'") (cdr arg))) + (format "%s %s%s" (car arg) + (if (atom (cdr arg)) "" "'") + (if (markerp (cdr arg)) + (format "(copy-marker %s)" (marker-position (cdr arg))) + (cdr arg)))) c-parse-state-state " ") ")"))) @@ -4181,7 +4200,7 @@ comment at the start of cc-engine.el for more info." ;; Use `parse-partial-sexp' from a safe position down to the point to check ;; if it's outside comments and strings. (save-excursion - (let ((pos (point)) safe-pos state pps-end-pos) + (let ((pos (point)) safe-pos state) ;; Pick a safe position as close to the point as possible. ;; ;; FIXME: Consult `syntax-ppss' here if our cache doesn't give a good @@ -4263,16 +4282,18 @@ comment at the start of cc-engine.el for more info." ;; loops when it hasn't succeeded. (while (and - (< (skip-chars-backward skip-chars limit) 0) + (let ((pos (point))) + (while (and + (< (skip-chars-backward skip-chars limit) 0) + ;; Don't stop inside a literal. + (when (setq lit-beg (c-ssb-lit-begin)) + (goto-char lit-beg) + t))) + (< (point) pos)) (let ((pos (point)) state-2 pps-end-pos) (cond - ;; Don't stop inside a literal - ((setq lit-beg (c-ssb-lit-begin)) - (goto-char lit-beg) - t) - ((and paren-level (save-excursion (setq state-2 (parse-partial-sexp @@ -4778,7 +4799,7 @@ comment at the start of cc-engine.el for more info." (unless cfd-prop-match (save-excursion (while (progn - (goto-char (next-single-property-change + (goto-char (c-next-single-property-change (point) 'c-type nil cfd-limit)) (and (< (point) cfd-limit) (not (eq (c-get-char-property (1- (point)) 'c-type) @@ -4818,7 +4839,7 @@ comment at the start of cc-engine.el for more info." ;; Pseudo match inside a comment or string literal. Skip out ;; of comments and string literals. (while (progn - (goto-char (next-single-property-change + (goto-char (c-next-single-property-change (point) 'face nil cfd-limit)) (and (< (point) cfd-limit) (c-got-face-at (point) c-literal-faces)))) @@ -4873,14 +4894,17 @@ comment at the start of cc-engine.el for more info." ;; it should return non-nil to ensure that the next search will find them. ;; ;; Such a spot is: - ;; o The first token after bob. - ;; o The first token after the end of submatch 1 in - ;; `c-decl-prefix-or-start-re' when that submatch matches. - ;; o The start of each `c-decl-prefix-or-start-re' match when - ;; submatch 1 doesn't match. - ;; o The first token after the end of each occurrence of the - ;; `c-type' text property with the value `c-decl-end', provided - ;; `c-type-decl-end-used' is set. + ;; o The first token after bob. + ;; o The first token after the end of submatch 1 in + ;; `c-decl-prefix-or-start-re' when that submatch matches. This + ;; submatch is typically a (L or R) brace or paren, a ;, or a ,. + ;; o The start of each `c-decl-prefix-or-start-re' match when + ;; submatch 1 doesn't match. This is, for example, the keyword + ;; "class" in Pike. + ;; o The start of a previously recognized declaration; "recognized" + ;; means that the last char of the previous token has a `c-type' + ;; text property with the value `c-decl-end'; this only holds + ;; when `c-type-decl-end-used' is set. ;; ;; Only a spot that match CFD-DECL-RE and whose face is in the ;; CFD-FACE-CHECKLIST list causes CFD-FUN to be called. The face @@ -4912,7 +4936,7 @@ comment at the start of cc-engine.el for more info." ;; ;; This function might do hidden buffer changes. - (let ((cfd-start-pos (point)) + (let ((cfd-start-pos (point)) ; never changed (cfd-buffer-end (point-max)) ;; The end of the token preceding the decl spot last found ;; with `c-decl-prefix-or-start-re'. `cfd-limit' if there's @@ -4951,10 +4975,20 @@ comment at the start of cc-engine.el for more info." ;; statement or declaration, which is earlier than the first ;; returned match. + ;; This `cond' moves back over any literals or macros. It has special + ;; handling for when the region being searched is entirely within a + ;; macro. It sets `cfd-continue-pos' (unless we've reached + ;; `cfd-limit'). (cond ;; First we need to move to a syntactically relevant position. ;; Begin by backing out of comment or string literals. + ;; + ;; This arm of the cond actually triggers if we're in a literal, + ;; and cfd-limit is at most at BONL. ((and + ;; This arm of the `and' moves backwards out of a literal when + ;; the face at point is a literal face. In this case, its value + ;; is always non-nil. (when (c-got-face-at (point) c-literal-faces) ;; Try to use the faces to back up to the start of the ;; literal. FIXME: What if the point is on a declaration @@ -4983,7 +5017,7 @@ comment at the start of cc-engine.el for more info." (let ((range (c-literal-limits))) (if range (goto-char (car range))))) - (setq start-in-literal (point))) + (setq start-in-literal (point))) ; end of `and' arm. ;; The start is in a literal. If the limit is in the same ;; one we don't have to find a syntactic position etc. We @@ -4994,22 +5028,22 @@ comment at the start of cc-engine.el for more info." (save-excursion (goto-char cfd-start-pos) (while (progn - (goto-char (next-single-property-change + (goto-char (c-next-single-property-change (point) 'face nil cfd-limit)) (and (< (point) cfd-limit) (c-got-face-at (point) c-literal-faces)))) - (= (point) cfd-limit))) + (= (point) cfd-limit))) ; end of `cond' arm condition ;; Completely inside a literal. Set up variables to trig the ;; (< cfd-continue-pos cfd-start-pos) case below and it'll ;; find a suitable start position. - (setq cfd-continue-pos start-in-literal)) + (setq cfd-continue-pos start-in-literal)) ; end of `cond' arm ;; Check if the region might be completely inside a macro, to ;; optimize that like the completely-inside-literal above. ((save-excursion (and (= (forward-line 1) 0) - (bolp) ; forward-line has funny behavior at eob. + (bolp) ; forward-line has funny behavior at eob. (>= (point) cfd-limit) (progn (backward-char) (eq (char-before) ?\\)))) @@ -5019,6 +5053,8 @@ comment at the start of cc-engine.el for more info." (setq cfd-continue-pos (1- cfd-start-pos) start-in-macro t)) + ;; The default arm of the `cond' moves back over any macro we're in + ;; and over any syntactic WS. It sets `c-find-decl-syntactic-pos'. (t ;; Back out of any macro so we don't miss any declaration ;; that could follow after it. @@ -5065,10 +5101,10 @@ comment at the start of cc-engine.el for more info." (< (point) cfd-limit)) ;; Do an initial search now. In the bob case above it's ;; only done to search for a `c-decl-end' spot. - (c-find-decl-prefix-search)) + (c-find-decl-prefix-search)) ; sets cfd-continue-pos (setq c-find-decl-match-pos (and (< cfd-match-pos cfd-start-pos) - cfd-match-pos))))) + cfd-match-pos))))) ; end of `cond' ;; Advance `cfd-continue-pos' if it's before the start position. ;; The closest continue position that might have effect at or @@ -5127,7 +5163,7 @@ comment at the start of cc-engine.el for more info." ;; `cfd-match-pos' so we can continue at the start position. ;; (Note that we don't get here if the first match is below ;; it.) - (goto-char cfd-start-pos))) + (goto-char cfd-start-pos))) ; end of `cond' ;; Delete found matches if they are before our new continue ;; position, so that `c-find-decl-prefix-search' won't back up @@ -5136,7 +5172,7 @@ comment at the start of cc-engine.el for more info." (when (and cfd-re-match (< cfd-re-match cfd-continue-pos)) (setq cfd-re-match nil)) (when (and cfd-prop-match (< cfd-prop-match cfd-continue-pos)) - (setq cfd-prop-match nil))) + (setq cfd-prop-match nil))) ; end of `when' (if syntactic-pos ;; This is the normal case and we got a proper syntactic @@ -5157,9 +5193,10 @@ comment at the start of cc-engine.el for more info." ;; good start position for the search, so do it. (c-find-decl-prefix-search))) - ;; Now loop. Round what? (ACM, 2006/7/5). We already got the first match. - + ;; Now loop, one decl spot per iteration. We already have the first + ;; match in `cfd-match-pos'. (while (progn + ;; Go forward over "false matches", one per iteration. (while (and (< cfd-match-pos cfd-limit) @@ -5200,10 +5237,10 @@ comment at the start of cc-engine.el for more info." (goto-char cfd-continue-pos) t))) - (< (point) cfd-limit)) - (c-find-decl-prefix-search)) + (< (point) cfd-limit)) ; end of "false matches" condition + (c-find-decl-prefix-search)) ; end of "false matches" loop - (< (point) cfd-limit)) + (< (point) cfd-limit)) ; end of condition for "decl-spot" while (when (and (>= (point) cfd-start-pos) @@ -5231,7 +5268,7 @@ comment at the start of cc-engine.el for more info." ;; The matched token was the last thing in the macro, ;; so the whole match is bogus. (setq cfd-macro-end 0) - nil)))) + nil)))) ; end of when condition (c-debug-put-decl-spot-faces cfd-match-pos (point)) (if (funcall cfd-fun cfd-match-pos (/= cfd-macro-end 0)) @@ -5411,8 +5448,8 @@ comment at the start of cc-engine.el for more info." (c-go-list-forward)) (when (equal (c-get-char-property (1- (point)) 'syntax-table) c->-as-paren-syntax) ; should always be true. - (c-clear-char-property (1- (point)) 'category)) - (c-clear-char-property pos 'category)))) + (c-unmark-<->-as-paren (1- (point)))) + (c-unmark-<->-as-paren pos)))) (defun c-clear->-pair-props (&optional pos) ;; POS (default point) is at a > character. If it is marked with @@ -5428,8 +5465,8 @@ comment at the start of cc-engine.el for more info." (c-go-up-list-backward)) (when (equal (c-get-char-property (point) 'syntax-table) c-<-as-paren-syntax) ; should always be true. - (c-clear-char-property (point) 'category)) - (c-clear-char-property pos 'category)))) + (c-unmark-<->-as-paren (point))) + (c-unmark-<->-as-paren pos)))) (defun c-clear-<>-pair-props (&optional pos) ;; POS (default point) is at a < or > character. If it has an @@ -5518,9 +5555,10 @@ comment at the start of cc-engine.el for more info." (c-syntactic-skip-backward "^;{}" (c-determine-limit 512)) (setq new-beg (point)) - ;; Remove the syntax-table properties from each pertinent <...> pair. - ;; Firsly, the ones with the < before beg and > after beg. - (while (c-search-forward-char-property 'category 'c-<-as-paren-syntax beg) + ;; Remove the syntax-table/category properties from each pertinent <...> + ;; pair. Firsly, the ones with the < before beg and > after beg. + (while + (c-search-forward-char-property 'syntax-table c-<-as-paren-syntax beg) (if (c-clear-<-pair-props-if-match-after beg (1- (point))) (setq need-new-beg t))) @@ -5531,7 +5569,7 @@ comment at the start of cc-engine.el for more info." ;; Remove syntax-table properties from the remaining pertinent <...> ;; pairs, those with a > after end and < before end. - (while (c-search-backward-char-property 'category 'c->-as-paren-syntax end) + (while (c-search-backward-char-property 'syntax-table c->-as-paren-syntax end) (if (c-clear->-pair-props-if-match-before end) (setq need-new-end t))) @@ -5544,8 +5582,6 @@ comment at the start of cc-engine.el for more info." (when need-new-end (and (> new-end c-new-END) (setq c-new-END new-end)))))) - - (defun c-after-change-check-<>-operators (beg end) ;; This is called from `after-change-functions' when ;; c-recognize-<>-arglists' is set. It ensures that no "<" or ">" @@ -5880,7 +5916,6 @@ comment at the start of cc-engine.el for more info." ;; Recursive part of `c-forward-<>-arglist'. ;; ;; This function might do hidden buffer changes. - (let ((start (point)) res pos tmp ;; Cover this so that any recorded found type ranges are ;; automatically lost if it turns out to not be an angle @@ -5916,32 +5951,31 @@ comment at the start of cc-engine.el for more info." (while (and (progn (c-forward-syntactic-ws) - (let ((orig-record-found-types c-record-found-types)) - (when (or (and c-record-type-identifiers all-types) - (c-major-mode-is 'java-mode)) - ;; All encountered identifiers are types, so set the - ;; promote flag and parse the type. - (progn - (c-forward-syntactic-ws) - (if (looking-at "\\?") - (forward-char) - (when (looking-at c-identifier-start) - (let ((c-promote-possible-types t) - (c-record-found-types t)) - (c-forward-type)))) - - (c-forward-syntactic-ws) - - (when (or (looking-at "extends") - (looking-at "super")) - (forward-word) - (c-forward-syntactic-ws) + (when (or (and c-record-type-identifiers all-types) + (c-major-mode-is 'java-mode)) + ;; All encountered identifiers are types, so set the + ;; promote flag and parse the type. + (progn + (c-forward-syntactic-ws) + (if (looking-at "\\?") + (forward-char) + (when (looking-at c-identifier-start) (let ((c-promote-possible-types t) (c-record-found-types t)) - (c-forward-type) - (c-forward-syntactic-ws)))))) + (c-forward-type)))) + + (c-forward-syntactic-ws) + + (when (or (looking-at "extends") + (looking-at "super")) + (forward-word) + (c-forward-syntactic-ws) + (let ((c-promote-possible-types t) + (c-record-found-types t)) + (c-forward-type) + (c-forward-syntactic-ws))))) - (setq pos (point)) ; e.g. first token inside the '<' + (setq pos (point)) ; e.g. first token inside the '<' ;; Note: These regexps exploit the match order in \| so ;; that "<>" is matched by "<" rather than "[^>:-]>". @@ -5957,7 +5991,7 @@ comment at the start of cc-engine.el for more info." ;; Either an operator starting with '>' or the end of ;; the angle bracket arglist. - (if (looking-at c->-op-cont-regexp) + (if (looking-at c->-op-without->-cont-regexp) (progn (goto-char (match-end 0)) t) ; Continue the loop. @@ -6006,7 +6040,6 @@ comment at the start of cc-engine.el for more info." (c-keyword-member (c-keyword-sym (match-string 1)) 'c-<>-type-kwds))))))) - ;; It was an angle bracket arglist. (setq c-record-found-types subres) @@ -6032,7 +6065,7 @@ comment at the start of cc-engine.el for more info." (or (and (eq (char-before) ?&) (not (eq (char-after) ?&))) (eq (char-before) ?,))) - ;; Just another argument. Record the position. The + ;; Just another argument. Record the position. The ;; type check stuff that made us stop at it is at ;; the top of the loop. (setq arg-start-pos (cons (point) arg-start-pos))) @@ -6299,7 +6332,8 @@ comment at the start of cc-engine.el for more info." ;; `*-font-lock-extra-types'); ;; o - 'prefix if it's a known prefix of a type; ;; o - 'found if it's a type that matches one in `c-found-types'; - ;; o - 'maybe if it's an identifier that might be a type; or + ;; o - 'maybe if it's an identifier that might be a type; + ;; o - 'decltype if it's a decltype(variable) declaration; - or ;; o - nil if it can't be a type (the point isn't moved then). ;; ;; The point is assumed to be at the beginning of a token. @@ -6329,6 +6363,16 @@ comment at the start of cc-engine.el for more info." (setq res 'prefix))) (cond + ((looking-at c-typeof-key) ; e.g. C++'s "decltype". + (goto-char (match-end 1)) + (c-forward-syntactic-ws) + (setq res (and (eq (char-after) ?\() + (c-safe (c-forward-sexp)) + 'decltype)) + (if res + (c-forward-syntactic-ws) + (goto-char start))) + ((looking-at c-type-prefix-key) ; e.g. "struct", "class", but NOT ; "typedef". (goto-char (match-end 1)) @@ -6444,18 +6488,19 @@ comment at the start of cc-engine.el for more info." (setq res nil))))) (when res - ;; Skip trailing type modifiers. If any are found we know it's + ;; Skip trailing type modifiers. If any are found we know it's ;; a type. (when c-opt-type-modifier-key (while (looking-at c-opt-type-modifier-key) ; e.g. "const", "volatile" (goto-char (match-end 1)) (c-forward-syntactic-ws) (setq res t))) + ;; Step over any type suffix operator. Do not let the existence ;; of these alter the classification of the found type, since ;; these operators typically are allowed in normal expressions ;; too. - (when c-opt-type-suffix-key + (when c-opt-type-suffix-key ; e.g. "..." (while (looking-at c-opt-type-suffix-key) (goto-char (match-end 1)) (c-forward-syntactic-ws))) @@ -6532,7 +6577,7 @@ comment at the start of cc-engine.el for more info." (progn (c-forward-syntactic-ws) t) (if (looking-at "(") (c-go-list-forward) - t))) + t))) (defmacro c-pull-open-brace (ps) ;; Pull the next open brace from PS (which has the form of paren-state), @@ -6543,6 +6588,36 @@ comment at the start of cc-engine.el for more info." (prog1 (car ,ps) (setq ,ps (cdr ,ps))))) +(defun c-back-over-member-initializer-braces () + ;; Point is just after a closing brace/parenthesis. Try to parse this as a + ;; C++ member initializer list, going back to just after the introducing ":" + ;; and returning t. Otherwise return nil, leaving point unchanged. + (let ((here (point)) res) + (setq res + (catch 'done + (when (not (c-go-list-backward)) + (throw 'done nil)) + (c-backward-syntactic-ws) + (when (not (c-simple-skip-symbol-backward)) + (throw 'done nil)) + (c-backward-syntactic-ws) + + (while (eq (char-before) ?,) + (backward-char) + (c-backward-syntactic-ws) + (when (not (memq (char-before) '(?\) ?}))) + (throw 'done nil)) + (when (not (c-go-list-backward)) + (throw 'done nil)) + (c-backward-syntactic-ws) + (when (not (c-simple-skip-symbol-backward)) + (throw 'done nil)) + (c-backward-syntactic-ws)) + + (eq (char-before) ?:))) + (or res (goto-char here)) + res)) + (defun c-back-over-member-initializers () ;; Test whether we are in a C++ member initializer list, and if so, go back ;; to the introducing ":", returning the position of the opening paren of @@ -6667,6 +6742,13 @@ comment at the start of cc-engine.el for more info." ;; Foo::Foo (int b) : Base (b) {} ;; car ^ ^ point ;; + ;; auto foo = 5; + ;; car ^ ^ point + ;; auto cplusplus_11 (int a, char *b) -> decltype (bar): + ;; car ^ ^ point + ;; + ;; + ;; ;; The cdr of the return value is non-nil when a ;; `c-typedef-decl-kwds' specifier is found in the declaration. ;; Specifically it is a dotted pair (A . B) where B is t when a @@ -6732,6 +6814,10 @@ comment at the start of cc-engine.el for more info." ;; If `backup-at-type' is nil then the other variables have ;; undefined values. backup-at-type backup-type-start backup-id-start + ;; This stores `kwd-sym' of the symbol before the current one. + ;; This is needed to distinguish the C++11 version of "auto" from + ;; the pre C++11 meaning. + backup-kwd-sym ;; Set if we've found a specifier (apart from "typedef") that makes ;; the defined identifier(s) types. at-type-decl @@ -6740,6 +6826,10 @@ comment at the start of cc-engine.el for more info." ;; Set if we've found a specifier that can start a declaration ;; where there's no type. maybe-typeless + ;; Save the value of kwd-sym between loops of the "Check for a + ;; type" loop. Needed to distinguish a C++11 "auto" from a pre + ;; C++11 one. + prev-kwd-sym ;; If a specifier is found that also can be a type prefix, ;; these flags are set instead of those above. If we need to ;; back up an identifier, they are copied to the real flag @@ -6757,6 +6847,8 @@ comment at the start of cc-engine.el for more info." backup-if-not-cast ;; For casts, the return position. cast-end + ;; Have we got a new-style C++11 "auto"? + new-style-auto ;; Save `c-record-type-identifiers' and ;; `c-record-ref-identifiers' since ranges are recorded ;; speculatively and should be thrown away if it turns out @@ -6775,11 +6867,12 @@ comment at the start of cc-engine.el for more info." (let* ((start (point)) kwd-sym kwd-clause-end found-type) ;; Look for a specifier keyword clause. - (when (or (looking-at c-prefix-spec-kwds-re) + (when (or (looking-at c-prefix-spec-kwds-re) ;FIXME!!! includes auto (and (c-major-mode-is 'java-mode) (looking-at "@[A-Za-z0-9]+"))) - (if (looking-at c-typedef-key) - (setq at-typedef t)) + (save-match-data + (if (looking-at c-typedef-key) + (setq at-typedef t))) (setq kwd-sym (c-keyword-sym (match-string 1))) (save-excursion (c-forward-keyword-clause 1) @@ -6787,6 +6880,12 @@ comment at the start of cc-engine.el for more info." (when (setq found-type (c-forward-type t)) ; brace-block-too ;; Found a known or possible type or a prefix of a known type. + (when (and (c-major-mode-is 'c++-mode) ; C++11 style "auto"? + (eq prev-kwd-sym (c-keyword-sym "auto")) + (looking-at "[=(]")) ; FIXME!!! proper regexp. + (setq new-style-auto t) + (setq found-type nil) + (goto-char start)) ; position of foo in "auto foo" (when at-type ;; Got two identifiers with nothing but whitespace @@ -6805,6 +6904,7 @@ comment at the start of cc-engine.el for more info." (setq backup-at-type at-type backup-type-start type-start backup-id-start id-start + backup-kwd-sym kwd-sym at-type found-type type-start start id-start (point) @@ -6860,6 +6960,7 @@ comment at the start of cc-engine.el for more info." ;; specifier keyword and we know we're in a ;; declaration. (setq at-decl-or-cast t) + (setq prev-kwd-sym kwd-sym) (goto-char kwd-clause-end)))) @@ -7051,50 +7152,60 @@ comment at the start of cc-engine.el for more info." (c-forward-syntactic-ws)) - (when (and (or maybe-typeless backup-maybe-typeless) - (not got-identifier) - (not got-prefix) - at-type) + (when (or (and new-style-auto + (looking-at c-auto-ops-re)) + (and (or maybe-typeless backup-maybe-typeless) + (not got-identifier) + (not got-prefix) + at-type)) ;; Have found no identifier but `c-typeless-decl-kwds' has ;; matched so we know we're inside a declaration. The ;; preceding type must be the identifier instead. (c-fdoc-shift-type-backward)) + ;; Prepare the "-> type;" for fontification later on. + (when (and new-style-auto + (looking-at c-haskell-op-re)) + (save-excursion + (goto-char (match-end 0)) + (c-forward-syntactic-ws) + (setq type-start (point)) + (setq at-type (c-forward-type)))) + (setq at-decl-or-cast (catch 'at-decl-or-cast ;; CASE 1 - (when (> paren-depth 0) - ;; Encountered something inside parens that isn't matched by - ;; the `c-type-decl-*' regexps, so it's not a type decl - ;; expression. Try to skip out to the same paren depth to - ;; not confuse the cast check below. - (c-safe (goto-char (scan-lists (point) 1 paren-depth))) - ;; If we've found a specifier keyword then it's a - ;; declaration regardless. - (throw 'at-decl-or-cast (eq at-decl-or-cast t))) - - (setq at-decl-end - (looking-at (cond ((eq context '<>) "[,>]") - (context "[,\)]") - (t "[,;]")))) - - ;; Now we've collected info about various characteristics of - ;; the construct we're looking at. Below follows a decision - ;; tree based on that. It's ordered to check more certain - ;; signs before less certain ones. - - (if got-identifier - (progn - - ;; CASE 2 - (when (and (or at-type maybe-typeless) - (not (or got-prefix got-parens))) - ;; Got another identifier directly after the type, so it's a - ;; declaration. - (throw 'at-decl-or-cast t)) + (when (> paren-depth 0) + ;; Encountered something inside parens that isn't matched by + ;; the `c-type-decl-*' regexps, so it's not a type decl + ;; expression. Try to skip out to the same paren depth to + ;; not confuse the cast check below. + (c-safe (goto-char (scan-lists (point) 1 paren-depth))) + ;; If we've found a specifier keyword then it's a + ;; declaration regardless. + (throw 'at-decl-or-cast (eq at-decl-or-cast t))) + + (setq at-decl-end + (looking-at (cond ((eq context '<>) "[,>]") + (context "[,\)]") + (t "[,;]")))) + + ;; Now we've collected info about various characteristics of + ;; the construct we're looking at. Below follows a decision + ;; tree based on that. It's ordered to check more certain + ;; signs before less certain ones. + + (if got-identifier + (progn + ;; CASE 2 + (when (and (or at-type maybe-typeless) + (not (or got-prefix got-parens))) + ;; Got another identifier directly after the type, so it's a + ;; declaration. + (throw 'at-decl-or-cast t)) (when (and got-parens (not got-prefix) @@ -7116,9 +7227,9 @@ comment at the start of cc-engine.el for more info." (c-fdoc-shift-type-backward))) ;; Found no identifier. - (if backup-at-type - (progn + (if backup-at-type + (progn ;; CASE 3 (when (= (point) start) @@ -7141,250 +7252,251 @@ comment at the start of cc-engine.el for more info." (setq backup-if-not-cast t) (throw 'at-decl-or-cast t))) - ;; CASE 4 - (when (and got-suffix - (not got-prefix) - (not got-parens)) - ;; Got a plain list of identifiers followed by some suffix. - ;; If this isn't a cast then the last identifier probably is - ;; the declared one and we should back up to the previous - ;; type. - (setq backup-if-not-cast t) - (throw 'at-decl-or-cast t))) - - ;; CASE 5 - (when (eq at-type t) - ;; If the type is known we know that there can't be any - ;; identifier somewhere else, and it's only in declarations in - ;; e.g. function prototypes and in casts that the identifier may - ;; be left out. - (throw 'at-decl-or-cast t)) - - (when (= (point) start) - ;; Only got a single identifier (parsed as a type so far). - ;; CASE 6 - (if (and - ;; Check that the identifier isn't at the start of an - ;; expression. - at-decl-end - (cond - ((eq context 'decl) - ;; Inside an arglist that contains declarations. If K&R - ;; style declarations and parenthesis style initializers - ;; aren't allowed then the single identifier must be a - ;; type, else we require that it's known or found - ;; (primitive types are handled above). - (or (and (not c-recognize-knr-p) - (not c-recognize-paren-inits)) - (memq at-type '(known found)))) - ((eq context '<>) - ;; Inside a template arglist. Accept known and found - ;; types; other identifiers could just as well be - ;; constants in C++. - (memq at-type '(known found))))) - (throw 'at-decl-or-cast t) - ;; CASE 7 - ;; Can't be a valid declaration or cast, but if we've found a - ;; specifier it can't be anything else either, so treat it as - ;; an invalid/unfinished declaration or cast. - (throw 'at-decl-or-cast at-decl-or-cast)))) - - (if (and got-parens - (not got-prefix) - (not context) - (not (eq at-type t)) - (or backup-at-type - maybe-typeless - backup-maybe-typeless - (when c-recognize-typeless-decls - (or (not got-suffix) - (not (looking-at - c-after-suffixed-type-maybe-decl-key)))))) - ;; Got an empty paren pair and a preceding type that probably - ;; really is the identifier. Shift the type backwards to make - ;; the last one the identifier. This is analogous to the - ;; "backtracking" done inside the `c-type-decl-suffix-key' loop - ;; above. - ;; - ;; Exception: In addition to the conditions in that - ;; "backtracking" code, do not shift backward if we're not - ;; looking at either `c-after-suffixed-type-decl-key' or "[;,]". - ;; Since there's no preceding type, the shift would mean that - ;; the declaration is typeless. But if the regexp doesn't match - ;; then we will simply fall through in the tests below and not - ;; recognize it at all, so it's better to try it as an abstract - ;; declarator instead. - (c-fdoc-shift-type-backward) - - ;; Still no identifier. - ;; CASE 8 - (when (and got-prefix (or got-parens got-suffix)) - ;; Require `got-prefix' together with either `got-parens' or - ;; `got-suffix' to recognize it as an abstract declarator: - ;; `got-parens' only is probably an empty function call. - ;; `got-suffix' only can build an ordinary expression together - ;; with the preceding identifier which we've taken as a type. - ;; We could actually accept on `got-prefix' only, but that can - ;; easily occur temporarily while writing an expression so we - ;; avoid that case anyway. We could do a better job if we knew - ;; the point when the fontification was invoked. - (throw 'at-decl-or-cast t)) - - ;; CASE 9 - (when (and at-type - (not got-prefix) - (not got-parens) - got-suffix-after-parens - (eq (char-after got-suffix-after-parens) ?\()) - ;; Got a type, no declarator but a paren suffix. I.e. it's a - ;; normal function call after all (or perhaps a C++ style object - ;; instantiation expression). - (throw 'at-decl-or-cast nil)))) - - ;; CASE 10 - (when at-decl-or-cast - ;; By now we've located the type in the declaration that we know - ;; we're in. - (throw 'at-decl-or-cast t)) - - ;; CASE 11 - (when (and got-identifier - (not context) - (looking-at c-after-suffixed-type-decl-key) - (if (and got-parens + ;; CASE 4 + (when (and got-suffix (not got-prefix) - (not got-suffix) - (not (eq at-type t))) - ;; Shift the type backward in the case that there's a - ;; single identifier inside parens. That can only - ;; occur in K&R style function declarations so it's - ;; more likely that it really is a function call. - ;; Therefore we only do this after - ;; `c-after-suffixed-type-decl-key' has matched. - (progn (c-fdoc-shift-type-backward) t) - got-suffix-after-parens)) - ;; A declaration according to `c-after-suffixed-type-decl-key'. - (throw 'at-decl-or-cast t)) - - ;; CASE 12 - (when (and (or got-prefix (not got-parens)) - (memq at-type '(t known))) - ;; It's a declaration if a known type precedes it and it can't be a - ;; function call. - (throw 'at-decl-or-cast t)) - - ;; If we get here we can't tell if this is a type decl or a normal - ;; expression by looking at it alone. (That's under the assumption - ;; that normal expressions always can look like type decl expressions, - ;; which isn't really true but the cases where it doesn't hold are so - ;; uncommon (e.g. some placements of "const" in C++) it's not worth - ;; the effort to look for them.) + (not got-parens)) + ;; Got a plain list of identifiers followed by some suffix. + ;; If this isn't a cast then the last identifier probably is + ;; the declared one and we should back up to the previous + ;; type. + (setq backup-if-not-cast t) + (throw 'at-decl-or-cast t))) + + ;; CASE 5 + (when (eq at-type t) + ;; If the type is known we know that there can't be any + ;; identifier somewhere else, and it's only in declarations in + ;; e.g. function prototypes and in casts that the identifier may + ;; be left out. + (throw 'at-decl-or-cast t)) + + (when (= (point) start) + ;; Only got a single identifier (parsed as a type so far). + ;; CASE 6 + (if (and + ;; Check that the identifier isn't at the start of an + ;; expression. + at-decl-end + (cond + ((eq context 'decl) + ;; Inside an arglist that contains declarations. If K&R + ;; style declarations and parenthesis style initializers + ;; aren't allowed then the single identifier must be a + ;; type, else we require that it's known or found + ;; (primitive types are handled above). + (or (and (not c-recognize-knr-p) + (not c-recognize-paren-inits)) + (memq at-type '(known found)))) + ((eq context '<>) + ;; Inside a template arglist. Accept known and found + ;; types; other identifiers could just as well be + ;; constants in C++. + (memq at-type '(known found))))) + (throw 'at-decl-or-cast t) + ;; CASE 7 + ;; Can't be a valid declaration or cast, but if we've found a + ;; specifier it can't be anything else either, so treat it as + ;; an invalid/unfinished declaration or cast. + (throw 'at-decl-or-cast at-decl-or-cast)))) + + (if (and got-parens + (not got-prefix) + (not context) + (not (eq at-type t)) + (or backup-at-type + maybe-typeless + backup-maybe-typeless + (when c-recognize-typeless-decls + (or (not got-suffix) + (not (looking-at + c-after-suffixed-type-maybe-decl-key)))))) + ;; Got an empty paren pair and a preceding type that probably + ;; really is the identifier. Shift the type backwards to make + ;; the last one the identifier. This is analogous to the + ;; "backtracking" done inside the `c-type-decl-suffix-key' loop + ;; above. + ;; + ;; Exception: In addition to the conditions in that + ;; "backtracking" code, do not shift backward if we're not + ;; looking at either `c-after-suffixed-type-decl-key' or "[;,]". + ;; Since there's no preceding type, the shift would mean that + ;; the declaration is typeless. But if the regexp doesn't match + ;; then we will simply fall through in the tests below and not + ;; recognize it at all, so it's better to try it as an abstract + ;; declarator instead. + (c-fdoc-shift-type-backward) + + ;; Still no identifier. + ;; CASE 8 + (when (and got-prefix (or got-parens got-suffix)) + ;; Require `got-prefix' together with either `got-parens' or + ;; `got-suffix' to recognize it as an abstract declarator: + ;; `got-parens' only is probably an empty function call. + ;; `got-suffix' only can build an ordinary expression together + ;; with the preceding identifier which we've taken as a type. + ;; We could actually accept on `got-prefix' only, but that can + ;; easily occur temporarily while writing an expression so we + ;; avoid that case anyway. We could do a better job if we knew + ;; the point when the fontification was invoked. + (throw 'at-decl-or-cast t)) + + ;; CASE 9 + (when (and at-type + (not got-prefix) + (not got-parens) + got-suffix-after-parens + (eq (char-after got-suffix-after-parens) ?\()) + ;; Got a type, no declarator but a paren suffix. I.e. it's a + ;; normal function call after all (or perhaps a C++ style object + ;; instantiation expression). + (throw 'at-decl-or-cast nil)))) + + ;; CASE 10 + (when at-decl-or-cast + ;; By now we've located the type in the declaration that we know + ;; we're in. + (throw 'at-decl-or-cast t)) + + ;; CASE 11 + (when (and got-identifier + (not context) + (looking-at c-after-suffixed-type-decl-key) + (if (and got-parens + (not got-prefix) + (not got-suffix) + (not (eq at-type t))) + ;; Shift the type backward in the case that there's a + ;; single identifier inside parens. That can only + ;; occur in K&R style function declarations so it's + ;; more likely that it really is a function call. + ;; Therefore we only do this after + ;; `c-after-suffixed-type-decl-key' has matched. + (progn (c-fdoc-shift-type-backward) t) + got-suffix-after-parens)) + ;; A declaration according to `c-after-suffixed-type-decl-key'. + (throw 'at-decl-or-cast t)) + + ;; CASE 12 + (when (and (or got-prefix (not got-parens)) + (memq at-type '(t known))) + ;; It's a declaration if a known type precedes it and it can't be a + ;; function call. + (throw 'at-decl-or-cast t)) + + ;; If we get here we can't tell if this is a type decl or a normal + ;; expression by looking at it alone. (That's under the assumption + ;; that normal expressions always can look like type decl expressions, + ;; which isn't really true but the cases where it doesn't hold are so + ;; uncommon (e.g. some placements of "const" in C++) it's not worth + ;; the effort to look for them.) ;;; 2008-04-16: commented out the next form, to allow the function to recognize ;;; "foo (int bar)" in CC (an implicit type (in class foo) without a semicolon) ;;; as a(n almost complete) declaration, enabling it to be fontified. - ;; CASE 13 - ;; (unless (or at-decl-end (looking-at "=[^=]")) - ;; If this is a declaration it should end here or its initializer(*) - ;; should start here, so check for allowed separation tokens. Note - ;; that this rule doesn't work e.g. with a K&R arglist after a - ;; function header. - ;; - ;; *) Don't check for C++ style initializers using parens - ;; since those already have been matched as suffixes. - ;; - ;; If `at-decl-or-cast' is then we've found some other sign that - ;; it's a declaration or cast, so then it's probably an - ;; invalid/unfinished one. - ;; (throw 'at-decl-or-cast at-decl-or-cast)) - - ;; Below are tests that only should be applied when we're certain to - ;; not have parsed halfway through an expression. - - ;; CASE 14 - (when (memq at-type '(t known)) - ;; The expression starts with a known type so treat it as a - ;; declaration. - (throw 'at-decl-or-cast t)) - - ;; CASE 15 - (when (and (c-major-mode-is 'c++-mode) - ;; In C++ we check if the identifier is a known type, since - ;; (con|de)structors use the class name as identifier. - ;; We've always shifted over the identifier as a type and - ;; then backed up again in this case. - identifier-type - (or (memq identifier-type '(found known)) - (and (eq (char-after identifier-start) ?~) - ;; `at-type' probably won't be 'found for - ;; destructors since the "~" is then part of the - ;; type name being checked against the list of - ;; known types, so do a check without that - ;; operator. - (or (save-excursion - (goto-char (1+ identifier-start)) - (c-forward-syntactic-ws) - (c-with-syntax-table - c-identifier-syntax-table - (looking-at c-known-type-key))) - (save-excursion - (goto-char (1+ identifier-start)) - ;; We have already parsed the type earlier, - ;; so it'd be possible to cache the end - ;; position instead of redoing it here, but - ;; then we'd need to keep track of another - ;; position everywhere. - (c-check-type (point) - (progn (c-forward-type) - (point)))))))) - (throw 'at-decl-or-cast t)) - - (if got-identifier - (progn - ;; CASE 16 - (when (and got-prefix-before-parens - at-type - (or at-decl-end (looking-at "=[^=]")) - (not context) - (not got-suffix)) - ;; Got something like "foo * bar;". Since we're not inside an - ;; arglist it would be a meaningless expression because the - ;; result isn't used. We therefore choose to recognize it as - ;; a declaration. Do not allow a suffix since it could then - ;; be a function call. - (throw 'at-decl-or-cast t)) - - ;; CASE 17 - (when (and (or got-suffix-after-parens - (looking-at "=[^=]")) - (eq at-type 'found) - (not (eq context 'arglist))) - ;; Got something like "a (*b) (c);" or "a (b) = c;". It could - ;; be an odd expression or it could be a declaration. Treat - ;; it as a declaration if "a" has been used as a type - ;; somewhere else (if it's a known type we won't get here). - (throw 'at-decl-or-cast t))) - - ;; CASE 18 - (when (and context - (or got-prefix - (and (eq context 'decl) - (not c-recognize-paren-inits) - (or got-parens got-suffix)))) - ;; Got a type followed by an abstract declarator. If `got-prefix' - ;; is set it's something like "a *" without anything after it. If - ;; `got-parens' or `got-suffix' is set it's "a()", "a[]", "a()[]", - ;; or similar, which we accept only if the context rules out - ;; expressions. - (throw 'at-decl-or-cast t))) - - ;; If we had a complete symbol table here (which rules out - ;; `c-found-types') we should return t due to the disambiguation rule - ;; (in at least C++) that anything that can be parsed as a declaration - ;; is a declaration. Now we're being more defensive and prefer to - ;; highlight things like "foo (bar);" as a declaration only if we're - ;; inside an arglist that contains declarations. - (eq context 'decl)))) + ;; CASE 13 + ;; (unless (or at-decl-end (looking-at "=[^=]")) + ;; If this is a declaration it should end here or its initializer(*) + ;; should start here, so check for allowed separation tokens. Note + ;; that this rule doesn't work e.g. with a K&R arglist after a + ;; function header. + ;; + ;; *) Don't check for C++ style initializers using parens + ;; since those already have been matched as suffixes. + ;; + ;; If `at-decl-or-cast' is then we've found some other sign that + ;; it's a declaration or cast, so then it's probably an + ;; invalid/unfinished one. + ;; (throw 'at-decl-or-cast at-decl-or-cast)) + + ;; Below are tests that only should be applied when we're certain to + ;; not have parsed halfway through an expression. + + ;; CASE 14 + (when (memq at-type '(t known)) + ;; The expression starts with a known type so treat it as a + ;; declaration. + (throw 'at-decl-or-cast t)) + + ;; CASE 15 + (when (and (c-major-mode-is 'c++-mode) + ;; In C++ we check if the identifier is a known type, since + ;; (con|de)structors use the class name as identifier. + ;; We've always shifted over the identifier as a type and + ;; then backed up again in this case. + identifier-type + (or (memq identifier-type '(found known)) + (and (eq (char-after identifier-start) ?~) + ;; `at-type' probably won't be 'found for + ;; destructors since the "~" is then part of the + ;; type name being checked against the list of + ;; known types, so do a check without that + ;; operator. + (or (save-excursion + (goto-char (1+ identifier-start)) + (c-forward-syntactic-ws) + (c-with-syntax-table + c-identifier-syntax-table + (looking-at c-known-type-key))) + (save-excursion + (goto-char (1+ identifier-start)) + ;; We have already parsed the type earlier, + ;; so it'd be possible to cache the end + ;; position instead of redoing it here, but + ;; then we'd need to keep track of another + ;; position everywhere. + (c-check-type (point) + (progn (c-forward-type) + (point)))))))) + (throw 'at-decl-or-cast t)) + + (if got-identifier + (progn + ;; CASE 16 + (when (and got-prefix-before-parens + at-type + (or at-decl-end (looking-at "=[^=]")) + (not context) + (not got-suffix)) + ;; Got something like "foo * bar;". Since we're not inside an + ;; arglist it would be a meaningless expression because the + ;; result isn't used. We therefore choose to recognize it as + ;; a declaration. Do not allow a suffix since it could then + ;; be a function call. + (throw 'at-decl-or-cast t)) + + ;; CASE 17 + (when (and (or got-suffix-after-parens + (looking-at "=[^=]")) + (eq at-type 'found) + (not (eq context 'arglist))) + ;; Got something like "a (*b) (c);" or "a (b) = c;". It could + ;; be an odd expression or it could be a declaration. Treat + ;; it as a declaration if "a" has been used as a type + ;; somewhere else (if it's a known type we won't get here). + (throw 'at-decl-or-cast t))) + + ;; CASE 18 + (when (and context + (or got-prefix + (and (eq context 'decl) + (not c-recognize-paren-inits) + (or got-parens got-suffix)))) + ;; Got a type followed by an abstract declarator. If `got-prefix' + ;; is set it's something like "a *" without anything after it. If + ;; `got-parens' or `got-suffix' is set it's "a()", "a[]", "a()[]", + ;; or similar, which we accept only if the context rules out + ;; expressions. + (throw 'at-decl-or-cast t))) + + ;; If we had a complete symbol table here (which rules out + ;; `c-found-types') we should return t due to the disambiguation rule + ;; (in at least C++) that anything that can be parsed as a declaration + ;; is a declaration. Now we're being more defensive and prefer to + ;; highlight things like "foo (bar);" as a declaration only if we're + ;; inside an arglist that contains declarations. + ;; CASE 19 + (eq context 'decl)))) ;; The point is now after the type decl expression. @@ -7473,6 +7585,8 @@ comment at the start of cc-engine.el for more info." ;; interactive refontification. (c-put-c-type-property (point) 'c-decl-arg-start)) + ;; Record the type's coordinates in `c-record-type-identifiers' for + ;; later fontification. (when (and c-record-type-identifiers at-type ;; (not (eq at-type t)) ;; There seems no reason to exclude a token from ;; fontification just because it's "a known type that can't @@ -7571,10 +7685,10 @@ comment at the start of cc-engine.el for more info." (c-put-c-type-property (1- (point)) 'c-decl-end) t) - ;; It's an unfinished label. We consider the keyword enough - ;; to recognize it as a label, so that it gets fontified. - ;; Leave the point at the end of it, but don't put any - ;; `c-decl-end' marker. + ;; It's an unfinished label. We consider the keyword enough + ;; to recognize it as a label, so that it gets fontified. + ;; Leave the point at the end of it, but don't put any + ;; `c-decl-end' marker. (goto-char kwd-end) t)))) @@ -7759,69 +7873,69 @@ comment at the start of cc-engine.el for more info." ;; ;; This function might do hidden buffer changes. - (let ((start (point)) - start-char - (c-promote-possible-types t) - lim - ;; Turn off recognition of angle bracket arglists while parsing - ;; types here since the protocol reference list might then be - ;; considered part of the preceding name or superclass-name. - c-recognize-<>-arglists) - - (if (or - (when (looking-at - (eval-when-compile - (c-make-keywords-re t - (append (c-lang-const c-protection-kwds objc) - '("@end")) - 'objc-mode))) - (goto-char (match-end 1)) - t) + (let ((start (point)) + start-char + (c-promote-possible-types t) + lim + ;; Turn off recognition of angle bracket arglists while parsing + ;; types here since the protocol reference list might then be + ;; considered part of the preceding name or superclass-name. + c-recognize-<>-arglists) + + (if (or + (when (looking-at + (eval-when-compile + (c-make-keywords-re t + (append (c-lang-const c-protection-kwds objc) + '("@end")) + 'objc-mode))) + (goto-char (match-end 1)) + t) - (and - (looking-at - (eval-when-compile - (c-make-keywords-re t - '("@interface" "@implementation" "@protocol") - 'objc-mode))) + (and + (looking-at + (eval-when-compile + (c-make-keywords-re t + '("@interface" "@implementation" "@protocol") + 'objc-mode))) - ;; Handle the name of the class itself. - (progn -; (c-forward-token-2) ; 2006/1/13 This doesn't move if the token's -; at EOB. - (goto-char (match-end 0)) - (setq lim (point)) - (c-skip-ws-forward) - (c-forward-type)) - - (catch 'break - ;; Look for ": superclass-name" or "( category-name )". - (when (looking-at "[:\(]") - (setq start-char (char-after)) + ;; Handle the name of the class itself. + (progn + ;; (c-forward-token-2) ; 2006/1/13 This doesn't move if the token's + ;; at EOB. + (goto-char (match-end 0)) + (setq lim (point)) + (c-skip-ws-forward) + (c-forward-type)) + + (catch 'break + ;; Look for ": superclass-name" or "( category-name )". + (when (looking-at "[:\(]") + (setq start-char (char-after)) + (forward-char) + (c-forward-syntactic-ws) + (unless (c-forward-type) (throw 'break nil)) + (when (eq start-char ?\() + (unless (eq (char-after) ?\)) (throw 'break nil)) (forward-char) - (c-forward-syntactic-ws) - (unless (c-forward-type) (throw 'break nil)) - (when (eq start-char ?\() - (unless (eq (char-after) ?\)) (throw 'break nil)) - (forward-char) - (c-forward-syntactic-ws))) - - ;; Look for a protocol reference list. - (if (eq (char-after) ?<) - (let ((c-recognize-<>-arglists t) - (c-parse-and-markup-<>-arglists t) - c-restricted-<>-arglists) - (c-forward-<>-arglist t)) - t)))) + (c-forward-syntactic-ws))) - (progn - (c-backward-syntactic-ws lim) - (c-clear-c-type-property start (1- (point)) 'c-decl-end) - (c-put-c-type-property (1- (point)) 'c-decl-end) - t) + ;; Look for a protocol reference list. + (if (eq (char-after) ?<) + (let ((c-recognize-<>-arglists t) + (c-parse-and-markup-<>-arglists t) + c-restricted-<>-arglists) + (c-forward-<>-arglist t)) + t)))) - (c-clear-c-type-property start (point) 'c-decl-end) - nil))) + (progn + (c-backward-syntactic-ws lim) + (c-clear-c-type-property start (1- (point)) 'c-decl-end) + (c-put-c-type-property (1- (point)) 'c-decl-end) + t) + + (c-clear-c-type-property start (point) 'c-decl-end) + nil))) (defun c-beginning-of-inheritance-list (&optional lim) ;; Go to the first non-whitespace after the colon that starts a @@ -7908,7 +8022,7 @@ comment at the start of cc-engine.el for more info." ;; ;; This function might do hidden buffer changes. - (let ((beg (point)) end id-start) + (let ((beg (point)) id-start) (and (eq (c-beginning-of-statement-1 lim) 'same) @@ -7998,54 +8112,54 @@ comment at the start of cc-engine.el for more info." (throw 'knr nil))) (if after-rparen - ;; We're inside a paren. Could it be our argument list....? - (if - (and - (progn - (goto-char after-rparen) - (unless (c-go-list-backward) (throw 'knr nil)) ; - ;; FIXME!!! What about macros between the parens? 2007/01/20 - (setq before-lparen (point))) + ;; We're inside a paren. Could it be our argument list....? + (if + (and + (progn + (goto-char after-rparen) + (unless (c-go-list-backward) (throw 'knr nil)) ; + ;; FIXME!!! What about macros between the parens? 2007/01/20 + (setq before-lparen (point))) - ;; It can't be the arg list if next token is ; or { - (progn (goto-char after-rparen) - (c-forward-syntactic-ws) - (not (memq (char-after) '(?\; ?\{ ?\=)))) + ;; It can't be the arg list if next token is ; or { + (progn (goto-char after-rparen) + (c-forward-syntactic-ws) + (not (memq (char-after) '(?\; ?\{ ?\=)))) - ;; Is the thing preceding the list an identifier (the - ;; function name), or a macro expansion? - (progn - (goto-char before-lparen) - (eq (c-backward-token-2) 0) - (or (eq (c-on-identifier) (point)) - (and (eq (char-after) ?\)) - (c-go-up-list-backward) - (eq (c-backward-token-2) 0) - (eq (c-on-identifier) (point))))) - - ;; Have we got a non-empty list of comma-separated - ;; identifiers? - (progn - (goto-char before-lparen) - (c-forward-token-2) ; to first token inside parens - (and - (c-on-identifier) - (c-forward-token-2) - (catch 'id-list - (while (eq (char-after) ?\,) - (c-forward-token-2) - (unless (c-on-identifier) (throw 'id-list nil)) - (c-forward-token-2)) - (eq (char-after) ?\)))))) - - ;; ...Yes. We've identified the function's argument list. - (throw 'knr - (progn (goto-char after-rparen) - (c-forward-syntactic-ws) - (point))) - - ;; ...No. The current parens aren't the function's arg list. - (goto-char before-lparen)) + ;; Is the thing preceding the list an identifier (the + ;; function name), or a macro expansion? + (progn + (goto-char before-lparen) + (eq (c-backward-token-2) 0) + (or (eq (c-on-identifier) (point)) + (and (eq (char-after) ?\)) + (c-go-up-list-backward) + (eq (c-backward-token-2) 0) + (eq (c-on-identifier) (point))))) + + ;; Have we got a non-empty list of comma-separated + ;; identifiers? + (progn + (goto-char before-lparen) + (c-forward-token-2) ; to first token inside parens + (and + (c-on-identifier) + (c-forward-token-2) + (catch 'id-list + (while (eq (char-after) ?\,) + (c-forward-token-2) + (unless (c-on-identifier) (throw 'id-list nil)) + (c-forward-token-2)) + (eq (char-after) ?\)))))) + + ;; ...Yes. We've identified the function's argument list. + (throw 'knr + (progn (goto-char after-rparen) + (c-forward-syntactic-ws) + (point))) + + ;; ...No. The current parens aren't the function's arg list. + (goto-char before-lparen)) (or (c-go-list-backward) ; backwards over [ .... ] (throw 'knr nil))))))))) @@ -8251,7 +8365,7 @@ comment at the start of cc-engine.el for more info." (and (progn (while ; keep going back to "[;={"s until we either find - ; no more, or get to one which isn't an "operator =" + ; no more, or get to one which isn't an "operator =" (and (c-syntactic-re-search-forward "[;={]" start t t t) (eq (char-before) ?=) c-overloadable-operators-regexp @@ -8365,10 +8479,7 @@ comment at the start of cc-engine.el for more info." (when (and c-recognize-<>-arglists (eq (char-before) ?>)) ;; Could be at the end of a template arglist. - (let ((c-parse-and-markup-<>-arglists t) - (c-disallow-comma-in-<>-arglists - (and containing-sexp - (not (eq (char-after containing-sexp) ?{))))) + (let ((c-parse-and-markup-<>-arglists t)) (while (and (c-backward-<>-arglist nil limit) (progn @@ -8392,31 +8503,44 @@ comment at the start of cc-engine.el for more info." (cond ((c-syntactic-re-search-forward c-decl-block-key open-brace t t t) (goto-char (setq kwd-start (match-beginning 0))) - (or - - ;; Found a keyword that can't be a type? - (match-beginning 1) - - ;; Can be a type too, in which case it's the return type of a - ;; function (under the assumption that no declaration level - ;; block construct starts with a type). - (not (c-forward-type)) - - ;; Jumped over a type, but it could be a declaration keyword - ;; followed by the declared identifier that we've jumped over - ;; instead (e.g. in "class Foo {"). If it indeed is a type - ;; then we should be at the declarator now, so check for a - ;; valid declarator start. - ;; - ;; Note: This doesn't cope with the case when a declared - ;; identifier is followed by e.g. '(' in a language where '(' - ;; also might be part of a declarator expression. Currently - ;; there's no such language. - (not (or (looking-at c-symbol-start) - (looking-at c-type-decl-prefix-key))))) + (and + ;; Exclude cases where we matched what would ordinarily + ;; be a block declaration keyword, except where it's not + ;; legal because it's part of a "compound keyword" like + ;; "enum class". Of course, if c-after-brace-list-key + ;; is nil, we can skip the test. + (or (equal c-after-brace-list-key "\\<\\>") + (save-match-data + (save-excursion + (not + (and + (looking-at c-after-brace-list-key) + (= (c-backward-token-2 1 t) 0) + (looking-at c-brace-list-key)))))) + (or + ;; Found a keyword that can't be a type? + (match-beginning 1) + + ;; Can be a type too, in which case it's the return type of a + ;; function (under the assumption that no declaration level + ;; block construct starts with a type). + (not (c-forward-type)) + + ;; Jumped over a type, but it could be a declaration keyword + ;; followed by the declared identifier that we've jumped over + ;; instead (e.g. in "class Foo {"). If it indeed is a type + ;; then we should be at the declarator now, so check for a + ;; valid declarator start. + ;; + ;; Note: This doesn't cope with the case when a declared + ;; identifier is followed by e.g. '(' in a language where '(' + ;; also might be part of a declarator expression. Currently + ;; there's no such language. + (not (or (looking-at c-symbol-start) + (looking-at c-type-decl-prefix-key)))))) ;; In Pike a list of modifiers may be followed by a brace - ;; to make them apply to many identifiers. Note that the + ;; to make them apply to many identifiers. Note that the ;; match data will be empty on return in this case. ((and (c-major-mode-is 'pike-mode) (progn @@ -8518,11 +8642,44 @@ comment at the start of cc-engine.el for more info." (not (looking-at "="))))) b-pos))) +(defun c-backward-colon-prefixed-type () + ;; We're at the token after what might be a type prefixed with a colon. Try + ;; moving backward over this type and the colon. On success, return t and + ;; leave point before colon; on failure, leave point unchanged. Will clobber + ;; match data. + (let ((here (point)) + (colon-pos nil)) + (save-excursion + (while + (and (eql (c-backward-token-2) 0) + (or (not (looking-at "\\s)")) + (c-go-up-list-backward)) + (cond + ((eql (char-after) ?:) + (setq colon-pos (point)) + (forward-char) + (c-forward-syntactic-ws) + (or (and (c-forward-type) + (progn (c-forward-syntactic-ws) + (eq (point) here))) + (setq colon-pos nil)) + nil) + ((eql (char-after) ?\() + t) + ((looking-at c-symbol-key) + t) + (t nil))))) + (when colon-pos + (goto-char colon-pos) + t))) + (defun c-backward-over-enum-header () ;; We're at a "{". Move back to the enum-like keyword that starts this ;; declaration and return t, otherwise don't move and return nil. (let ((here (point)) up-sexp-pos before-identifier) + (when c-recognize-post-brace-list-type-p + (c-backward-colon-prefixed-type)) (while (and (eq (c-backward-token-2) 0) @@ -8533,10 +8690,11 @@ comment at the start of cc-engine.el for more info." (not before-identifier)) (setq before-identifier t)) ((and before-identifier - (or (eq (char-after) ?,) + (or (eql (char-after) ?,) (looking-at c-postfix-decl-spec-key))) (setq before-identifier nil) t) + ((looking-at c-after-brace-list-key) t) ((looking-at c-brace-list-key) nil) ((and c-recognize-<>-arglists (eq (char-after) ?<) @@ -8574,86 +8732,86 @@ comment at the start of cc-engine.el for more info." (while (and (not bufpos) containing-sexp) (when paren-state - (if (consp (car paren-state)) - (setq lim (cdr (car paren-state)) - paren-state (cdr paren-state)) - (setq lim (car paren-state))) - (when paren-state - (setq next-containing (car paren-state) - paren-state (cdr paren-state)))) - (goto-char containing-sexp) - (if (c-looking-at-inexpr-block next-containing next-containing) - ;; We're in an in-expression block of some kind. Do not - ;; check nesting. We deliberately set the limit to the - ;; containing sexp, so that c-looking-at-inexpr-block - ;; doesn't check for an identifier before it. - (setq containing-sexp nil) - ;; see if the open brace is preceded by = or [...] in - ;; this statement, but watch out for operator= - (setq braceassignp 'dontknow) - (c-backward-token-2 1 t lim) - ;; Checks to do only on the first sexp before the brace. - (when (and c-opt-inexpr-brace-list-key - (eq (char-after) ?\[)) - ;; In Java, an initialization brace list may follow - ;; directly after "new Foo[]", so check for a "new" - ;; earlier. - (while (eq braceassignp 'dontknow) - (setq braceassignp - (cond ((/= (c-backward-token-2 1 t lim) 0) nil) - ((looking-at c-opt-inexpr-brace-list-key) t) - ((looking-at "\\sw\\|\\s_\\|[.[]") - ;; Carry on looking if this is an - ;; identifier (may contain "." in Java) - ;; or another "[]" sexp. - 'dontknow) - (t nil))))) - ;; Checks to do on all sexps before the brace, up to the - ;; beginning of the statement. + (if (consp (car paren-state)) + (setq lim (cdr (car paren-state)) + paren-state (cdr paren-state)) + (setq lim (car paren-state))) + (when paren-state + (setq next-containing (car paren-state) + paren-state (cdr paren-state)))) + (goto-char containing-sexp) + (if (c-looking-at-inexpr-block next-containing next-containing) + ;; We're in an in-expression block of some kind. Do not + ;; check nesting. We deliberately set the limit to the + ;; containing sexp, so that c-looking-at-inexpr-block + ;; doesn't check for an identifier before it. + (setq containing-sexp nil) + ;; see if the open brace is preceded by = or [...] in + ;; this statement, but watch out for operator= + (setq braceassignp 'dontknow) + (c-backward-token-2 1 t lim) + ;; Checks to do only on the first sexp before the brace. + (when (and c-opt-inexpr-brace-list-key + (eq (char-after) ?\[)) + ;; In Java, an initialization brace list may follow + ;; directly after "new Foo[]", so check for a "new" + ;; earlier. (while (eq braceassignp 'dontknow) - (cond ((eq (char-after) ?\;) - (setq braceassignp nil)) - ((and class-key - (looking-at class-key)) - (setq braceassignp nil)) - ((eq (char-after) ?=) - ;; We've seen a =, but must check earlier tokens so - ;; that it isn't something that should be ignored. - (setq braceassignp 'maybe) - (while (and (eq braceassignp 'maybe) - (zerop (c-backward-token-2 1 t lim))) - (setq braceassignp - (cond - ;; Check for operator = - ((and c-opt-op-identifier-prefix - (looking-at c-opt-op-identifier-prefix)) - nil) - ;; Check for `<opchar>= in Pike. - ((and (c-major-mode-is 'pike-mode) - (or (eq (char-after) ?`) - ;; Special case for Pikes - ;; `[]=, since '[' is not in - ;; the punctuation class. - (and (eq (char-after) ?\[) - (eq (char-before) ?`)))) - nil) - ((looking-at "\\s.") 'maybe) - ;; make sure we're not in a C++ template - ;; argument assignment - ((and - (c-major-mode-is 'c++-mode) - (save-excursion - (let ((here (point)) - (pos< (progn - (skip-chars-backward "^<>") - (point)))) - (and (eq (char-before) ?<) - (not (c-crosses-statement-barrier-p - pos< here)) - (not (c-in-literal)) - )))) - nil) - (t t)))))) + (setq braceassignp + (cond ((/= (c-backward-token-2 1 t lim) 0) nil) + ((looking-at c-opt-inexpr-brace-list-key) t) + ((looking-at "\\sw\\|\\s_\\|[.[]") + ;; Carry on looking if this is an + ;; identifier (may contain "." in Java) + ;; or another "[]" sexp. + 'dontknow) + (t nil))))) + ;; Checks to do on all sexps before the brace, up to the + ;; beginning of the statement. + (while (eq braceassignp 'dontknow) + (cond ((eq (char-after) ?\;) + (setq braceassignp nil)) + ((and class-key + (looking-at class-key)) + (setq braceassignp nil)) + ((eq (char-after) ?=) + ;; We've seen a =, but must check earlier tokens so + ;; that it isn't something that should be ignored. + (setq braceassignp 'maybe) + (while (and (eq braceassignp 'maybe) + (zerop (c-backward-token-2 1 t lim))) + (setq braceassignp + (cond + ;; Check for operator = + ((and c-opt-op-identifier-prefix + (looking-at c-opt-op-identifier-prefix)) + nil) + ;; Check for `<opchar>= in Pike. + ((and (c-major-mode-is 'pike-mode) + (or (eq (char-after) ?`) + ;; Special case for Pikes + ;; `[]=, since '[' is not in + ;; the punctuation class. + (and (eq (char-after) ?\[) + (eq (char-before) ?`)))) + nil) + ((looking-at "\\s.") 'maybe) + ;; make sure we're not in a C++ template + ;; argument assignment + ((and + (c-major-mode-is 'c++-mode) + (save-excursion + (let ((here (point)) + (pos< (progn + (skip-chars-backward "^<>") + (point)))) + (and (eq (char-before) ?<) + (not (c-crosses-statement-barrier-p + pos< here)) + (not (c-in-literal)) + )))) + nil) + (t t)))))) (if (and (eq braceassignp 'dontknow) (/= (c-backward-token-2 1 t lim) 0)) (setq braceassignp nil))) @@ -9176,7 +9334,7 @@ comment at the start of cc-engine.el for more info." (max (c-point 'boi paren-pos) (point)))) (t (c-add-syntax 'defun-block-intro nil)))) - (c-add-syntax 'statement-block-intro nil))) + (c-add-syntax 'statement-block-intro nil))) (if (= paren-pos boi) ;; Always done if the open brace was at boi. The @@ -9346,15 +9504,15 @@ comment at the start of cc-engine.el for more info." ;;annotations. ((and (c-major-mode-is 'java-mode) (setq placeholder (point)) - (c-beginning-of-statement-1) - (progn - (while (and (c-forward-annotation) - (< (point) placeholder)) - (c-forward-syntactic-ws)) - t) - (prog1 - (>= (point) placeholder) - (goto-char placeholder))) + (c-beginning-of-statement-1) + (progn + (while (and (c-forward-annotation) + (< (point) placeholder)) + (c-forward-syntactic-ws)) + t) + (prog1 + (>= (point) placeholder) + (goto-char placeholder))) (c-beginning-of-statement-1 containing-sexp) (c-add-syntax 'annotation-var-cont (point))) @@ -9373,16 +9531,16 @@ comment at the start of cc-engine.el for more info." (not (looking-at c-<-op-cont-regexp)))))) (c-with-syntax-table c++-template-syntax-table (goto-char placeholder) - (c-beginning-of-statement-1 containing-sexp t) - (if (save-excursion - (c-backward-syntactic-ws containing-sexp) - (eq (char-before) ?<)) - ;; In a nested template arglist. - (progn - (goto-char placeholder) - (c-syntactic-skip-backward "^,;" containing-sexp t) - (c-forward-syntactic-ws)) - (back-to-indentation))) + (c-beginning-of-statement-1 containing-sexp t)) + (if (save-excursion + (c-backward-syntactic-ws containing-sexp) + (eq (char-before) ?<)) + ;; In a nested template arglist. + (progn + (goto-char placeholder) + (c-syntactic-skip-backward "^,;" containing-sexp t) + (c-forward-syntactic-ws)) + (back-to-indentation)) ;; FIXME: Should use c-add-stmt-syntax, but it's not yet ;; template aware. (c-add-syntax 'template-args-cont (point) placeholder)) @@ -9405,7 +9563,7 @@ comment at the start of cc-engine.el for more info." ((indent-point (point)) (case-fold-search nil) open-paren-in-column-0-is-defun-start - ;; A whole ugly bunch of various temporary variables. Have + ;; A whole ugly bunch of various temporary variables. Have ;; to declare them here since it's not possible to declare ;; a variable with only the scope of a cond test and the ;; following result clauses, and most of this function is a @@ -9460,22 +9618,26 @@ comment at the start of cc-engine.el for more info." (c-keyword-sym (match-string 1))))) ;; Init some position variables. - (if c-state-cache + (if paren-state (progn (setq containing-sexp (car paren-state) paren-state (cdr paren-state)) (if (consp containing-sexp) - (progn - (setq lim (cdr containing-sexp)) - (if (cdr c-state-cache) - ;; Ignore balanced paren. The next entry - ;; can't be another one. - (setq containing-sexp (car (cdr c-state-cache)) - paren-state (cdr paren-state)) - ;; If there is no surrounding open paren then - ;; put the last balanced pair back on paren-state. - (setq paren-state (cons containing-sexp paren-state) - containing-sexp nil))) + (save-excursion + (goto-char (cdr containing-sexp)) + (if (and (c-major-mode-is 'c++-mode) + (c-back-over-member-initializer-braces)) + (c-syntactic-skip-backward "^}" nil t)) + (setq lim (point)) + (if paren-state + ;; Ignore balanced paren. The next entry + ;; can't be another one. + (setq containing-sexp (car paren-state) + paren-state (cdr paren-state)) + ;; If there is no surrounding open paren then + ;; put the last balanced pair back on paren-state. + (setq paren-state (cons containing-sexp paren-state) + containing-sexp nil))) (setq lim (1+ containing-sexp)))) (setq lim (point-min))) @@ -10040,16 +10202,16 @@ comment at the start of cc-engine.el for more info." (eq (char-after placeholder) ?<)))))) (c-with-syntax-table c++-template-syntax-table (goto-char placeholder) - (c-beginning-of-statement-1 lim t) - (if (save-excursion - (c-backward-syntactic-ws lim) - (eq (char-before) ?<)) - ;; In a nested template arglist. - (progn - (goto-char placeholder) - (c-syntactic-skip-backward "^,;" lim t) - (c-forward-syntactic-ws)) - (back-to-indentation))) + (c-beginning-of-statement-1 lim t)) + (if (save-excursion + (c-backward-syntactic-ws lim) + (eq (char-before) ?<)) + ;; In a nested template arglist. + (progn + (goto-char placeholder) + (c-syntactic-skip-backward "^,;" lim t) + (c-forward-syntactic-ws)) + (back-to-indentation)) ;; FIXME: Should use c-add-stmt-syntax, but it's not yet ;; template aware. (c-add-syntax 'template-args-cont (point) placeholder)) @@ -10289,7 +10451,6 @@ comment at the start of cc-engine.el for more info." (c-add-syntax 'topmost-intro-cont (c-point 'boi))) )) - ;; (CASE 6 has been removed.) ;; CASE 7: line is an expression, not a statement. Most @@ -10318,7 +10479,7 @@ comment at the start of cc-engine.el for more info." paren-state)) ;; CASE 7B: Looking at the opening brace of an - ;; in-expression block or brace list. C.f. cases 4, 16A + ;; in-expression block or brace list. C.f. cases 4, 16A ;; and 17E. ((and (eq char-after-ip ?{) (progn @@ -10440,7 +10601,7 @@ comment at the start of cc-engine.el for more info." ))) ;; CASE 9: we are inside a brace-list - ((and (not (c-major-mode-is 'awk-mode)) ; Maybe this isn't needed (ACM, 2002/3/29) + ((and (not (c-major-mode-is 'awk-mode)) ; Maybe this isn't needed (ACM, 2002/3/29) (setq special-brace-list (or (and c-special-brace-lists ;;;; ALWAYS NIL FOR AWK!! (save-excursion @@ -10492,7 +10653,7 @@ comment at the start of cc-engine.el for more info." (if (eq (point) (c-point 'boi)) (c-add-syntax 'brace-list-close (point)) (setq lim (c-most-enclosing-brace c-state-cache (point))) - (c-beginning-of-statement-1 lim) + (c-beginning-of-statement-1 lim nil nil t) (c-add-stmt-syntax 'brace-list-close nil t lim paren-state))) (t @@ -10654,9 +10815,9 @@ comment at the start of cc-engine.el for more info." )) ;; CASE 19: line is an expression, not a statement, and is directly - ;; contained by a template delimiter. Most likely, we are in a + ;; contained by a template delimiter. Most likely, we are in a ;; template arglist within a statement. This case is based on CASE - ;; 7. At some point in the future, we may wish to create more + ;; 7. At some point in the future, we may wish to create more ;; syntactic symbols such as `template-intro', ;; `template-cont-nonempty', etc., and distinguish between them as we ;; do for `arglist-intro' etc. (2009-12-07). @@ -10992,7 +11153,7 @@ Cannot combine absolute offsets %S and %S in `add' method" ;; ;; This function might do hidden buffer changes. (let* ((symbol (c-langelem-sym langelem)) - (match (assq symbol c-offsets-alist)) + (match (assq symbol c-offsets-alist)) (offset (cdr-safe match))) (if match (setq offset (c-evaluate-offset offset langelem symbol)) @@ -11063,4 +11224,8 @@ Cannot combine absolute offsets %S and %S in `add' method" (cc-provide 'cc-engine) +;;; Local Variables: +;;; indent-tabs-mode: t +;;; tab-width: 8 +;;; End: ;;; cc-engine.el ends here diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 6b1abc1eedf..9a1273ddcce 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -266,7 +266,7 @@ ;; This function might do hidden buffer changes. (when (c-got-face-at (point) c-literal-faces) (while (progn - (goto-char (next-single-property-change + (goto-char (c-next-single-property-change (point) 'face nil limit)) (and (< (point) limit) (c-got-face-at (point) c-literal-faces)))) @@ -366,39 +366,7 @@ (parse-sexp-lookup-properties (cc-eval-when-compile (boundp 'parse-sexp-lookup-properties)))) - - ;; (while (re-search-forward ,regexp limit t) - ;; (unless (progn - ;; (goto-char (match-beginning 0)) - ;; (c-skip-comments-and-strings limit)) - ;; (goto-char (match-end 0)) - ;; ,@(mapcar - ;; (lambda (highlight) - ;; (if (integerp (car highlight)) - ;; (progn - ;; (unless (eq (nth 2 highlight) t) - ;; (error - ;; "The override flag must currently be t in %s" - ;; highlight)) - ;; (when (nth 3 highlight) - ;; (error - ;; "The laxmatch flag may currently not be set in %s" - ;; highlight)) - ;; `(save-match-data - ;; (c-put-font-lock-face - ;; (match-beginning ,(car highlight)) - ;; (match-end ,(car highlight)) - ;; ,(elt highlight 1)))) - ;; (when (nth 3 highlight) - ;; (error "Match highlights currently not supported in %s" - ;; highlight)) - ;; `(progn - ;; ,(nth 1 highlight) - ;; (save-match-data ,(car highlight)) - ;; ,(nth 2 highlight)))) - ;; highlights))) ,(c-make-font-lock-search-form regexp highlights)) - nil))) (defun c-make-font-lock-BO-decl-search-function (regexp &rest highlights) @@ -591,8 +559,7 @@ stuff. Used on level 1 and higher." (progn (c-mark-<-as-paren beg) (c-mark->-as-paren end)) - ;; (c-clear-char-property beg 'syntax-table) - (c-clear-char-property beg 'category))) + (c-unmark-<->-as-paren beg))) nil))))))) ;; #define. @@ -716,7 +683,11 @@ stuff. Used on level 1 and higher." (let ((start (1- (point)))) (save-excursion (and (eq (elt (parse-partial-sexp start (c-point 'eol)) 8) start) - (if (integerp c-multiline-string-start-char) + (if (if (eval-when-compile (integerp ?c)) + ;; Emacs + (integerp c-multiline-string-start-char) + ;; XEmacs + (characterp c-multiline-string-start-char)) ;; There's no multiline string start char before the ;; string, so newlines aren't allowed. (not (eq (char-before start) c-multiline-string-start-char)) @@ -1037,7 +1008,8 @@ casts and declarations are fontified. Used on level 2 and higher." paren-depth id-face got-init c-last-identifier-range - (separator-prop (if types 'c-decl-type-start 'c-decl-id-start))) + (separator-prop (if types 'c-decl-type-start 'c-decl-id-start)) + brackets-after-id) ;; The following `while' fontifies a single declarator id each time round. ;; It loops only when LIST is non-nil. @@ -1110,17 +1082,21 @@ casts and declarations are fontified. Used on level 2 and higher." ;; Search syntactically to the end of the declarator (";", ;; ",", a closing paren, eob etc) or to the beginning of an ;; initializer or function prototype ("=" or "\\s\("). - ;; Note that the open paren will match array specs in - ;; square brackets, and we treat them as initializers too. - (c-syntactic-re-search-forward - "[;,]\\|\\s)\\|\\'\\|\\(=\\|\\s(\\)" limit t t)) + ;; Note that square brackets are now not also treated as + ;; initializers, since this broke when there were also + ;; initializing brace lists. + (let (found) + (while + (and (setq found (c-syntactic-re-search-forward + "[;,]\\|\\s)\\|\\'\\|\\(=\\|\\s(\\)" limit t t)) + (eq (char-before) ?\[) + (c-go-up-list-forward)) + (setq brackets-after-id t)) + found)) (setq next-pos (match-beginning 0) id-face (if (and (eq (char-after next-pos) ?\() - (let (c-last-identifier-range) - (save-excursion - (goto-char next-pos) - (c-at-toplevel-p)))) + (not brackets-after-id)) 'font-lock-function-name-face 'font-lock-variable-name-face) got-init (and (match-beginning 1) @@ -1146,7 +1122,6 @@ casts and declarations are fontified. Used on level 2 and higher." (when list ;; Jump past any initializer or function prototype to see if ;; there's a ',' to continue at. - (cond ((eq id-face 'font-lock-function-name-face) ;; Skip a parenthesized initializer (C++) or a function ;; prototype. @@ -1214,8 +1189,8 @@ casts and declarations are fontified. Used on level 2 and higher." ;; o - nil, if not in an arglist at all. This includes the ;; parenthesized condition which follows "if", "while", etc. context - ;; The position of the next token after the closing paren of - ;; the last detected cast. + ;; A list of starting positions of possible type declarations, or of + ;; the typedef preceding one, if any. last-cast-end ;; The result from `c-forward-decl-or-cast-1'. decl-or-cast @@ -1303,14 +1278,15 @@ casts and declarations are fontified. Used on level 2 and higher." (cond ((not (memq (char-before match-pos) '(?\( ?, ?\[ ?<))) (setq context nil c-restricted-<>-arglists nil)) - ;; A control flow expression + ;; A control flow expression or a decltype ((and (eq (char-before match-pos) ?\() (save-excursion (goto-char match-pos) (backward-char) (c-backward-token-2) (or (looking-at c-block-stmt-2-key) - (looking-at c-block-stmt-1-2-key)))) + (looking-at c-block-stmt-1-2-key) + (looking-at c-typeof-key)))) (setq context nil c-restricted-<>-arglists t)) ;; Near BOB. @@ -1488,33 +1464,38 @@ casts and declarations are fontified. Used on level 2 and higher." c-recognize-knr-p) ; Strictly speaking, bogus, but it ; speeds up lisp.h tremendously. (save-excursion - (setq bod-res (car (c-beginning-of-decl-1 decl-search-lim))) - (if (and (eq bod-res 'same) - (progn - (c-backward-syntactic-ws) - (eq (char-before) ?\}))) - (c-beginning-of-decl-1 decl-search-lim)) - - ;; We're now putatively at the declaration. - (setq paren-state (c-parse-state)) - ;; At top level or inside a "{"? - (if (or (not (setq encl-pos - (c-most-enclosing-brace paren-state))) - (eq (char-after encl-pos) ?\{)) - (progn - (when (looking-at c-typedef-key) ; "typedef" - (setq is-typedef t) - (goto-char (match-end 0)) - (c-forward-syntactic-ws)) - ;; At a real declaration? - (if (memq (c-forward-type t) '(t known found)) - (progn - (c-font-lock-declarators (point-max) t is-typedef) - nil) - ;; False alarm. Return t to go on to the next check. - (goto-char start-pos) - t)) - t)))))) + (if (c-back-over-member-initializers) + t ; Can't be at a declarator + (unless (or (eobp) + (looking-at "\\s(\\|\\s)")) + (forward-char)) + (setq bod-res (car (c-beginning-of-decl-1 decl-search-lim))) + (if (and (eq bod-res 'same) + (save-excursion + (c-backward-syntactic-ws) + (eq (char-before) ?\}))) + (c-beginning-of-decl-1 decl-search-lim)) + + ;; We're now putatively at the declaration. + (setq paren-state (c-parse-state)) + ;; At top level or inside a "{"? + (if (or (not (setq encl-pos + (c-most-enclosing-brace paren-state))) + (eq (char-after encl-pos) ?\{)) + (progn + (when (looking-at c-typedef-key) ; "typedef" + (setq is-typedef t) + (goto-char (match-end 0)) + (c-forward-syntactic-ws)) + ;; At a real declaration? + (if (memq (c-forward-type t) '(t known found decltype)) + (progn + (c-font-lock-declarators (point-max) t is-typedef) + nil) + ;; False alarm. Return t to go on to the next check. + (goto-char start-pos) + t)) + t))))))) ;; It was a false alarm. Check if we're in a label (or other ;; construct with `:' except bitfield) instead. @@ -1557,9 +1538,7 @@ casts and declarations are fontified. Used on level 2 and higher." ;; Note that this function won't attempt to fontify beyond the end of the ;; current enum block, if any. (let* ((paren-state (c-parse-state)) - (encl-pos (c-most-enclosing-brace paren-state)) - (start (point)) - ) + (encl-pos (c-most-enclosing-brace paren-state))) (when (and encl-pos (eq (char-after encl-pos) ?\{) @@ -2124,7 +2103,7 @@ need for `c-font-lock-extra-types'.") ;; Got two parenthesized expressions, so we have to look ;; closer at them to decide which is the type. No need to ;; handle `c-record-ref-identifiers' since all references - ;; has already been handled by other fontification rules. + ;; have already been handled by other fontification rules. (let (expr1-res expr2-res) (goto-char expr1-pos) @@ -2159,6 +2138,9 @@ need for `c-font-lock-extra-types'.") ;; unusual than an initializer. (cond ((memq expr1-res '(t known prefix))) ((memq expr2-res '(t known prefix))) + ;; Presumably 'decltype's will be fontified elsewhere. + ((eq expr1-res 'decltype)) + ((eq expr2-res 'decltype)) ((eq expr1-res 'found) (let ((c-promote-possible-types t)) (goto-char expr1-pos) @@ -2721,4 +2703,8 @@ need for `pike-font-lock-extra-types'.") ;; 2006-07-10: awk-font-lock-keywords has been moved back to cc-awk.el. (cc-provide 'cc-fonts) +;;; Local Variables: +;;; indent-tabs-mode: t +;;; tab-width: 8 +;;; End: ;;; cc-fonts.el ends here diff --git a/lisp/progmodes/cc-guess.el b/lisp/progmodes/cc-guess.el index df55b8f2b98..20534737d8a 100644 --- a/lisp/progmodes/cc-guess.el +++ b/lisp/progmodes/cc-guess.el @@ -504,8 +504,7 @@ is called with one argument, the guessed style." (cond ((or (and a-guessed? b-guessed?) (not (or a-guessed? b-guessed?))) - (string-lessp (symbol-name (car a)) - (symbol-name (car b)))) + (string-lessp (car a) (car b))) (a-guessed? t) (b-guessed? nil))))))) style) @@ -520,7 +519,8 @@ is called with one argument, the guessed style." (goto-char (point-min)) (when (search-forward (concat "(" (symbol-name (car needs-markers)) - " ") nil t) + " ") + nil t) (move-end-of-line 1) (comment-dwim nil) (insert " Guessed value")) @@ -572,4 +572,9 @@ WITH-NAME is asked to the user." (cc-provide 'cc-guess) + +;;; Local Variables: +;;; indent-tabs-mode: t +;;; tab-width: 8 +;;; End: ;;; cc-guess.el ends here diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 575c25d6519..4d16a9b9d33 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -130,9 +130,7 @@ ;; This file is not always loaded. See note above. -;; Except it is always loaded - see bug#17463. -;;;(cc-external-require 'cl) -(require 'cl-lib) +(cc-external-require 'cl) ;;; Setup for the `c-lang-defvar' system. @@ -253,14 +251,14 @@ the evaluated constant value at compile time." (unless xlate (setq xlate 'identity)) (c-with-syntax-table (c-lang-const c-mode-syntax-table) - (cl-delete-duplicates - (cl-mapcan (lambda (opgroup) + (delete-duplicates + (mapcan (lambda (opgroup) (when (if (symbolp (car opgroup)) (when (funcall opgroup-filter (car opgroup)) (setq opgroup (cdr opgroup)) t) t) - (cl-mapcan (lambda (op) + (mapcan (lambda (op) (when (funcall op-filter op) (let ((res (funcall xlate op))) (if (listp res) res (list res))))) @@ -301,7 +299,8 @@ the evaluated constant value at compile time." ["Set Style..." c-set-style t] ["Show Current Style Name" (message "Style Name: %s" - c-indentation-style) t] + c-indentation-style) + t] ["Guess Style from this Buffer" c-guess-buffer-no-install t] ["Install the Last Guessed Style..." c-guess-install (and c-guess-guessed-offsets-alist @@ -319,9 +318,9 @@ the evaluated constant value at compile time." :style toggle :selected c-auto-newline] ["Hungry delete" c-toggle-hungry-state :style toggle :selected c-hungry-delete-key] - ["Subword mode" subword-mode - :style toggle :selected (and (boundp 'subword-mode) - subword-mode)]))) + ["Subword mode" c-subword-mode + :style toggle :selected (and (boundp 'c-subword-mode) + c-subword-mode)]))) ;;; Syntax tables. @@ -393,7 +392,9 @@ The syntax tables aren't stored directly since they're quite large." ;; lists are parsed. Note that this encourages incorrect parsing of ;; templates since they might contain normal operators that uses the ;; '<' and '>' characters. Therefore this syntax table might go - ;; away when CC Mode handles templates correctly everywhere. + ;; away when CC Mode handles templates correctly everywhere. WHILE + ;; THIS SYNTAX TABLE IS CURRENT, `c-parse-state' MUST _NOT_ BE + ;; CALLED!!! t nil (java c++) `(lambda () (let ((table (funcall ,(c-lang-const c-make-mode-syntax-table)))) @@ -404,7 +405,7 @@ The syntax tables aren't stored directly since they're quite large." (and (c-lang-const c++-make-template-syntax-table) (funcall (c-lang-const c++-make-template-syntax-table)))) -(c-lang-defconst c-no-parens-syntax-table +(c-lang-defconst c-make-no-parens-syntax-table ;; A variant of the standard syntax table which is used to find matching ;; "<"s and ">"s which have been marked as parens using syntax table ;; properties. The other paren characters (e.g. "{", ")" "]") are given a @@ -412,18 +413,20 @@ The syntax tables aren't stored directly since they're quite large." ;; even when there's unbalanced other parens inside them. ;; ;; This variable is nil for languages which don't have template stuff. - t `(lambda () - (if (c-lang-const c-recognize-<>-arglists) - (let ((table (funcall ,(c-lang-const c-make-mode-syntax-table)))) - (modify-syntax-entry ?\( "." table) - (modify-syntax-entry ?\) "." table) - (modify-syntax-entry ?\[ "." table) - (modify-syntax-entry ?\] "." table) - (modify-syntax-entry ?\{ "." table) - (modify-syntax-entry ?\} "." table) - table)))) + t (if (c-lang-const c-recognize-<>-arglists) + `(lambda () + ;(if (c-lang-const c-recognize-<>-arglists) + (let ((table (funcall ,(c-lang-const c-make-mode-syntax-table)))) + (modify-syntax-entry ?\( "." table) + (modify-syntax-entry ?\) "." table) + (modify-syntax-entry ?\[ "." table) + (modify-syntax-entry ?\] "." table) + (modify-syntax-entry ?\{ "." table) + (modify-syntax-entry ?\} "." table) + table)))) (c-lang-defvar c-no-parens-syntax-table - (funcall (c-lang-const c-no-parens-syntax-table))) + (and (c-lang-const c-make-no-parens-syntax-table) + (funcall (c-lang-const c-make-no-parens-syntax-table)))) (c-lang-defconst c-identifier-syntax-modifications "A list that describes the modifications that should be done to the @@ -574,9 +577,18 @@ EOL terminated statements." (c c++ objc) t) (c-lang-defvar c-has-bitfields (c-lang-const c-has-bitfields)) +(c-lang-defconst c-modified-constant + "Regexp that matches a \"modified\" constant literal such as \"L'a'\", +a \"long character\". In particular, this recognizes forms of constant +which `c-backward-sexp' needs to be called twice to move backwards over." + t nil + (c c++ objc) "L'\\([^\\'\t\f\n\r]\\|\\\\.\\)'") +;; FIXME!!! Extend this to cover strings, if needed. 2008-04-11 +(c-lang-defvar c-modified-constant (c-lang-const c-modified-constant)) + (c-lang-defconst c-symbol-start "Regexp that matches the start of a symbol, i.e. any identifier or -keyword. It's unspecified how far it matches. Does not contain a \\| +keyword. It's unspecified how far it matches. Does not contain a \\| operator at the top level." t (concat "[" c-alpha "_]") java (concat "[" c-alpha "_@]") @@ -938,10 +950,13 @@ Note that operators like \".\" and \"->\" which in language references often are described as postfix operators are considered binary here, since CC Mode treats every identifier as an expression." - ;; There's currently no code in CC Mode that exploit all the info + ;; There's currently no code in CC Mode that exploits all the info ;; in this variable; precedence, associativity etc are present as a ;; preparation for future work. + ;; FIXME!!! C++11's "auto" operators "=" and "->" need to go in here + ;; somewhere. 2012-03-24. + t `(;; Preprocessor. ,@(when (c-lang-const c-opt-cpp-prefix) `((prefix "#" @@ -964,7 +979,8 @@ since CC Mode treats every identifier as an expression." ,@(when (c-major-mode-is 'c++-mode) ;; The following need special treatment. `((prefix "dynamic_cast" "static_cast" - "reinterpret_cast" "const_cast" "typeid"))) + "reinterpret_cast" "const_cast" "typeid" + "alignof"))) (left-assoc "." ,@(unless (c-major-mode-is 'java-mode) '("->"))) @@ -1137,7 +1153,8 @@ operators." c++ (append '("&" "<%" "%>" "<:" ":>" "%:" "%:%:") (c-lang-const c-other-op-syntax-tokens)) objc (append '("#" "##" ; Used by cpp. - "+" "-") (c-lang-const c-other-op-syntax-tokens)) + "+" "-") + (c-lang-const c-other-op-syntax-tokens)) idl (append '("#" "##") ; Used by cpp. (c-lang-const c-other-op-syntax-tokens)) pike (append '("..") @@ -1148,7 +1165,7 @@ operators." (c-lang-defconst c-all-op-syntax-tokens ;; List of all tokens in the punctuation and parenthesis syntax ;; classes. - t (cl-delete-duplicates (append (c-lang-const c-other-op-syntax-tokens) + t (delete-duplicates (append (c-lang-const c-other-op-syntax-tokens) (c-lang-const c-operator-list)) :test 'string-equal)) @@ -1215,22 +1232,41 @@ operators." (c-lang-defvar c-<-op-cont-regexp (c-lang-const c-<-op-cont-regexp)) +(c-lang-defconst c->-op-cont-tokens + ;; A list of second and subsequent characters of all multicharacter tokens + ;; that begin with ">". + t (c-filter-ops (c-lang-const c-all-op-syntax-tokens) + t + "\\`>." + (lambda (op) (substring op 1))) + java (c-filter-ops (c-lang-const c-all-op-syntax-tokens) + t + "\\`>[^>]\\|\\`>>[^>]" + (lambda (op) (substring op 1)))) + (c-lang-defconst c->-op-cont-regexp ;; Regexp matching the second and subsequent characters of all ;; multicharacter tokens that begin with ">". - t (c-make-keywords-re nil - (c-filter-ops (c-lang-const c-all-op-syntax-tokens) - t - "\\`>." - (lambda (op) (substring op 1)))) - java (c-make-keywords-re nil - (c-filter-ops (c-lang-const c-all-op-syntax-tokens) - t - "\\`>[^>]\\|\\`>>[^>]" - (lambda (op) (substring op 1))))) + t (c-make-keywords-re nil (c-lang-const c->-op-cont-tokens))) (c-lang-defvar c->-op-cont-regexp (c-lang-const c->-op-cont-regexp)) +(c-lang-defconst c->-op-without->-cont-regexp + ;; Regexp matching the second and subsequent characters of all + ;; multicharacter tokens that begin with ">" except for those beginning with + ;; ">>". + t (c-make-keywords-re nil + (set-difference + (c-lang-const c->-op-cont-tokens) + (c-filter-ops (c-lang-const c-all-op-syntax-tokens) + t + "\\`>>" + (lambda (op) (substring op 1))) + :test 'string-equal))) + +(c-lang-defvar c->-op-without->-cont-regexp + (c-lang-const c->-op-without->-cont-regexp)) + (c-lang-defconst c-stmt-delim-chars ;; The characters that should be considered to bound statements. To ;; optimize `c-crosses-statement-barrier-p' somewhat, it's assumed to @@ -1245,6 +1281,21 @@ operators." (c-lang-defvar c-stmt-delim-chars-with-comma (c-lang-const c-stmt-delim-chars-with-comma)) +(c-lang-defconst c-auto-ops + ;; Ops which signal C++11's new auto uses. + t nil + c++ '("=" "->")) +(c-lang-defconst c-auto-ops-re + t (c-make-keywords-re nil (c-lang-const c-auto-ops))) +(c-lang-defvar c-auto-ops-re (c-lang-const c-auto-ops-re)) + +(c-lang-defconst c-haskell-op + ;; Op used in the new C++11 auto function definition, indicating type. + t nil + c++ '("->")) +(c-lang-defconst c-haskell-op-re + t (c-make-keywords-re nil (c-lang-const c-haskell-op))) +(c-lang-defvar c-haskell-op-re (c-lang-const c-haskell-op-re)) ;;; Syntactic whitespace. @@ -1546,13 +1597,14 @@ properly." (c-lang-defvar c-syntactic-eol (c-lang-const c-syntactic-eol)) -;;; Defun functions - -;; The Emacs variables beginning-of-defun-function and -;; end-of-defun-function will be set so that commands like -;; `mark-defun' and `narrow-to-defun' work right. The key sequences -;; C-M-a and C-M-e are, however, bound directly to the CC Mode -;; functions, allowing optimization for large n. +;;; Defun handling. + +;; The Emacs variables beginning-of-defun-function and end-of-defun-function +;; will be set so that commands like `mark-defun' and `narrow-to-defun' work +;; right. In older Emacsen, the key sequences C-M-a and C-M-e are, however, +;; bound directly to the CC Mode functions, allowing optimization for large n. +;; From Emacs 23, this isn't necessary any more, since n is passed to the two +;; functions. (c-lang-defconst beginning-of-defun-function "Function to which beginning-of-defun-function will be set." t 'c-beginning-of-defun @@ -1607,7 +1659,7 @@ the appropriate place for that." '("_Bool" "_Complex" "_Imaginary") ; Conditionally defined in C99. (c-lang-const c-primitive-type-kwds)) c++ (append - '("bool" "wchar_t") + '("bool" "wchar_t" "char16_t" "char32_t") (c-lang-const c-primitive-type-kwds)) ;; Objective-C extends C, but probably not the new stuff in C99. objc (append @@ -1652,6 +1704,18 @@ of a variable declaration." t (c-make-keywords-re t (c-lang-const c-typedef-kwds))) (c-lang-defvar c-typedef-key (c-lang-const c-typedef-key)) +(c-lang-defconst c-typeof-kwds + "Keywords followed by a parenthesized expression, which stands for +the type of that expression." + t nil + c '("typeof") ; longstanding GNU C(++) extension. + c++ '("decltype" "typeof")) + +(c-lang-defconst c-typeof-key + ;; Adorned regexp matching `c-typeof-kwds'. + t (c-make-keywords-re t (c-lang-const c-typeof-kwds))) +(c-lang-defvar c-typeof-key (c-lang-const c-typeof-key)) + (c-lang-defconst c-type-prefix-kwds "Keywords where the following name - if any - is a type name, and where the keyword together with the symbol works as a type in @@ -1677,7 +1741,7 @@ but they don't build a type of themselves. Unlike the keywords on not the type face." t nil c '("const" "restrict" "volatile") - c++ '("const" "volatile" "throw") + c++ '("const" "constexpr" "noexcept" "volatile" "throw" "final" "override") objc '("const" "volatile")) (c-lang-defconst c-opt-type-modifier-key @@ -1701,7 +1765,7 @@ not the type face." (c-lang-defconst c-type-start-kwds ;; All keywords that can start a type (i.e. are either a type prefix ;; or a complete type). - t (cl-delete-duplicates (append (c-lang-const c-primitive-type-kwds) + t (delete-duplicates (append (c-lang-const c-primitive-type-kwds) (c-lang-const c-type-prefix-kwds) (c-lang-const c-type-modifier-kwds)) :test 'string-equal)) @@ -1754,6 +1818,26 @@ will be handled." t (c-make-keywords-re t (c-lang-const c-brace-list-decl-kwds))) (c-lang-defvar c-brace-list-key (c-lang-const c-brace-list-key)) +(c-lang-defconst c-after-brace-list-decl-kwds + "Keywords that might follow keywords in `c-brace-list-decl-kwds' +and precede the opening brace." + t nil + c++ '("class" "struct")) + +(c-lang-defconst c-after-brace-list-key + ;; Regexp matching keywords that can fall between a brace-list + ;; keyword and the associated brace list. + t (c-make-keywords-re t (c-lang-const c-after-brace-list-decl-kwds))) +(c-lang-defvar c-after-brace-list-key (c-lang-const c-after-brace-list-key)) + +(c-lang-defconst c-recognize-post-brace-list-type-p + "Set to t when we recognize a colon and then a type after an enum, +e.g., enum foo : int { A, B, C };" + t nil + c++ t) +(c-lang-defvar c-recognize-post-brace-list-type-p + (c-lang-const c-recognize-post-brace-list-type-p)) + (c-lang-defconst c-other-block-decl-kwds "Keywords where the following block (if any) contains another declaration level that should not be considered a class. For every @@ -1835,6 +1919,7 @@ will be handled." ;; {...}"). t (append (c-lang-const c-class-decl-kwds) (c-lang-const c-brace-list-decl-kwds)) + c++ (append (c-lang-const c-typeless-decl-kwds) '("auto")) ; C++11. ;; Note: "manages" for CORBA CIDL clashes with its presence on ;; `c-type-list-kwds' for IDL. idl (append (c-lang-const c-typeless-decl-kwds) @@ -1858,7 +1943,8 @@ If any of these also are on `c-type-list-kwds', `c-ref-list-kwds', will be handled." t nil (c c++) '("auto" "extern" "inline" "register" "static") - c++ (append '("explicit" "friend" "mutable" "template" "using" "virtual") + c++ (append '("explicit" "friend" "mutable" "template" "thread_local" + "using" "virtual") (c-lang-const c-modifier-kwds)) objc '("auto" "bycopy" "byref" "extern" "in" "inout" "oneway" "out" "static") ;; FIXME: Some of those below ought to be on `c-other-decl-kwds' instead. @@ -1944,7 +2030,7 @@ one of `c-type-list-kwds', `c-ref-list-kwds', ;; something is a type or just some sort of macro in front of the ;; declaration. They might be ambiguous with types or type ;; prefixes. - t (cl-delete-duplicates (append (c-lang-const c-class-decl-kwds) + t (delete-duplicates (append (c-lang-const c-class-decl-kwds) (c-lang-const c-brace-list-decl-kwds) (c-lang-const c-other-block-decl-kwds) (c-lang-const c-typedef-decl-kwds) @@ -1984,7 +2070,8 @@ one of `c-type-list-kwds', `c-ref-list-kwds', t (c-make-keywords-re t (set-difference (c-lang-const c-keywords) (append (c-lang-const c-type-start-kwds) - (c-lang-const c-prefix-spec-kwds)) + (c-lang-const c-prefix-spec-kwds) + (c-lang-const c-typeof-kwds)) :test 'string-equal))) (c-lang-defvar c-not-decl-init-keywords (c-lang-const c-not-decl-init-keywords)) @@ -2137,7 +2224,7 @@ type identifiers separated by arbitrary tokens." pike '("array" "function" "int" "mapping" "multiset" "object" "program")) (c-lang-defconst c-paren-any-kwds - t (cl-delete-duplicates (append (c-lang-const c-paren-nontype-kwds) + t (delete-duplicates (append (c-lang-const c-paren-nontype-kwds) (c-lang-const c-paren-type-kwds)) :test 'string-equal)) @@ -2163,7 +2250,7 @@ assumed to be set if this isn't nil." (c-lang-defconst c-<>-sexp-kwds ;; All keywords that can be followed by an angle bracket sexp. - t (cl-delete-duplicates (append (c-lang-const c-<>-type-kwds) + t (delete-duplicates (append (c-lang-const c-<>-type-kwds) (c-lang-const c-<>-arglist-kwds)) :test 'string-equal)) @@ -2223,7 +2310,7 @@ Keywords here should also be in `c-block-stmt-1-kwds'." (c-lang-defconst c-block-stmt-kwds ;; Union of `c-block-stmt-1-kwds' and `c-block-stmt-2-kwds'. - t (cl-delete-duplicates (append (c-lang-const c-block-stmt-1-kwds) + t (delete-duplicates (append (c-lang-const c-block-stmt-1-kwds) (c-lang-const c-block-stmt-2-kwds)) :test 'string-equal)) @@ -2309,8 +2396,11 @@ This construct is \"<keyword> <expression> :\"." (c-lang-defconst c-constant-kwds "Keywords for constants." t nil - (c c++) '("NULL" ;; Not a keyword, but practically works as one. + c '("NULL" ;; Not a keyword, but practically works as one. "false" "true") ; Defined in C99. + c++ (append + '("nullptr") + (c-lang-const c-constant-kwds)) objc '("nil" "Nil" "YES" "NO" "NS_DURING" "NS_HANDLER" "NS_ENDHANDLER") idl '("TRUE" "FALSE") java '("true" "false" "null") ; technically "literals", not keywords @@ -2327,7 +2417,7 @@ This construct is \"<keyword> <expression> :\"." (c-lang-defconst c-expr-kwds ;; Keywords that can occur anywhere in expressions. Built from ;; `c-primary-expr-kwds' and all keyword operators in `c-operators'. - t (cl-delete-duplicates + t (delete-duplicates (append (c-lang-const c-primary-expr-kwds) (c-filter-ops (c-lang-const c-operator-list) t @@ -2431,7 +2521,7 @@ Note that Java specific rules are currently applied to tell this from (c-lang-defconst c-keywords ;; All keywords as a list. - t (cl-delete-duplicates + t (delete-duplicates (c-lang-defconst-eval-immediately `(append ,@(mapcar (lambda (kwds-lang-const) `(c-lang-const ,kwds-lang-const)) @@ -2771,7 +2861,7 @@ possible for good performance." (c-lang-defvar c-block-prefix-charset (c-lang-const c-block-prefix-charset)) (c-lang-defconst c-type-decl-prefix-key - "Regexp matching the declarator operators that might precede the + "Regexp matching any declarator operator that might precede the identifier in a declaration, e.g. the \"*\" in \"char *argv\". This regexp should match \"(\" if parentheses are valid in declarators. The end of the first submatch is taken as the end of the operator. @@ -2916,17 +3006,15 @@ is in effect or not." (when (boundp (c-mode-symbol "font-lock-extra-types")) (c-mode-var "font-lock-extra-types"))) (regexp-strings - (apply 'nconc - (mapcar (lambda (re) - (when (string-match "[][.*+?^$\\]" re) - (list re))) - extra-types))) + (delq nil (mapcar (lambda (re) + (when (string-match "[][.*+?^$\\]" re) + re)) + extra-types))) (plain-strings - (apply 'nconc - (mapcar (lambda (re) - (unless (string-match "[][.*+?^$\\]" re) - (list re))) - extra-types)))) + (delq nil (mapcar (lambda (re) + (unless (string-match "[][.*+?^$\\]" re) + re)) + extra-types)))) (concat "\\<\\(" (c-concat-separated (append (list (c-make-keywords-re nil @@ -2970,7 +3058,8 @@ identifier or one of the keywords on `c-<>-type-kwds' or expression is considered to be a type." t (or (consp (c-lang-const c-<>-type-kwds)) (consp (c-lang-const c-<>-arglist-kwds))) - java t) + java t) ; 2008-10-19. This is crude. The syntax for java + ; generics is not yet coded in CC Mode. (c-lang-defvar c-recognize-<>-arglists (c-lang-const c-recognize-<>-arglists)) (c-lang-defconst c-enums-contain-decls @@ -3171,10 +3260,7 @@ function it returns is byte compiled with all the evaluated results from the language constants. Use the `c-init-language-vars' macro to accomplish that conveniently." - (if (and (not load-in-progress) - (boundp 'byte-compile-dest-file) - (stringp byte-compile-dest-file)) - + (if (cc-bytecomp-is-compiling) ;; No need to byte compile this lambda since the byte compiler is ;; smart enough to detect the `funcall' construct in the ;; `c-init-language-vars' macro below and compile it all straight @@ -3194,7 +3280,7 @@ accomplish that conveniently." ;; `c-lang-const' will expand to the evaluated ;; constant immediately in `c--macroexpand-all' ;; below. - (cl-mapcan + (mapcan (lambda (init) `(current-var ',(car init) ,(car init) ,(c--macroexpand-all @@ -3269,4 +3355,8 @@ evaluated and should not be quoted." (cc-provide 'cc-langs) +;;; Local Variables: +;;; indent-tabs-mode: t +;;; tab-width: 8 +;;; End: ;;; cc-langs.el ends here diff --git a/lisp/progmodes/cc-menus.el b/lisp/progmodes/cc-menus.el index 784e5c69353..414b957fe94 100644 --- a/lisp/progmodes/cc-menus.el +++ b/lisp/progmodes/cc-menus.el @@ -269,7 +269,7 @@ nested angle brackets constructs." "\\(" ; method name which gets captured ; into index "[" c-alpha "_]" - "[" c-alnum "_]*" + "[" c-alnum "_]*" "\\)" "[ \t\n\r]*" ;; An argument list that contains zero or more arguments. @@ -361,7 +361,7 @@ Example: p (1+ p)) (cond ;; Is CHAR part of a objc token? - ((and (not inargvar) ; Ignore if CHAR is part of an argument variable. + ((and (not inargvar) ; Ignore if CHAR is part of an argument variable. (eq 0 betweenparen) ; Ignore if CHAR is in parentheses. (or (and (<= ?a char) (<= char ?z)) (and (<= ?A char) (<= char ?Z)) @@ -521,4 +521,8 @@ Example: (cc-provide 'cc-menus) +;;; Local Variables: +;;; indent-tabs-mode: t +;;; tab-width: 8 +;;; End: ;;; cc-menus.el ends here diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index c4f1efbfdb1..01e93b3f202 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -108,11 +108,6 @@ ;; with your version of Emacs, you are incompatible! (cc-external-require 'easymenu) -;; Autoload directive for emacsen that doesn't have an older CC Mode -;; version in the dist. -(autoload 'subword-mode "subword" - "Mode enabling subword movement and editing keys." t) - ;; Load cc-fonts first after font-lock is loaded, since it isn't ;; necessary until font locking is requested. ; (eval-after-load "font-lock" ; 2006-07-09: font-lock is now preloaded. @@ -185,8 +180,7 @@ control). See \"cc-mode.el\" for more info." (run-hooks 'c-initialization-hook) ;; Fix obsolete variables. (if (boundp 'c-comment-continuation-stars) - (setq c-block-comment-prefix - (symbol-value 'c-comment-continuation-stars))) + (setq c-block-comment-prefix c-comment-continuation-stars)) (add-hook 'change-major-mode-hook 'c-leave-cc-mode-mode) (setq c-initialization-ok t) ;; Connect up with Emacs's electric-indent-mode, for >= Emacs 24.4 @@ -380,7 +374,7 @@ control). See \"cc-mode.el\" for more info." ;; conflicts with OOBR ;;(define-key c-mode-base-map "\C-c\C-v" 'c-version) ;; (define-key c-mode-base-map "\C-c\C-y" 'c-toggle-hungry-state) Commented out by ACM, 2005-11-22. - (define-key c-mode-base-map "\C-c\C-w" 'subword-mode) + (define-key c-mode-base-map "\C-c\C-w" 'c-subword-mode) ) ;; We don't require the outline package, but we configure it a bit anyway. @@ -472,6 +466,14 @@ preferably use the `c-mode-menu' language constant directly." (defvar c-maybe-stale-found-type nil) (make-variable-buffer-local 'c-maybe-stale-found-type) +(defvar c-just-done-before-change nil) +(make-variable-buffer-local 'c-just-done-before-change) +;; This variable is set to t by `c-before-change' and to nil by +;; `c-after-change'. It is used to detect a spurious invocation of +;; `before-change-functions' directly following on from a correct one. This +;; happens in some Emacsen, for example when `basic-save-buffer' does (insert +;; ?\n) when `require-final-newline' is non-nil. + (defun c-basic-common-init (mode default-style) "Do the necessary initialization for the syntax handling routines and the line breaking/filling code. Intended to be used by other @@ -542,10 +544,11 @@ that requires a literal mode spec at compile time." ;; Use this in Emacs 21+ to avoid meddling with the rear-nonsticky ;; property on each character. (when (boundp 'text-property-default-nonsticky) + (make-local-variable 'text-property-default-nonsticky) (mapc (lambda (tprop) (unless (assq tprop text-property-default-nonsticky) - (set (make-local-variable 'text-property-default-nonsticky) - (cons `(,tprop . t) text-property-default-nonsticky)))) + (setq text-property-default-nonsticky + (cons `(,tprop . t) text-property-default-nonsticky)))) '(syntax-table category c-type))) ;; In Emacs 21 and later it's possible to turn off the ad-hoc @@ -605,10 +608,12 @@ that requires a literal mode spec at compile time." (make-local-hook 'before-change-functions) (make-local-hook 'after-change-functions)) (add-hook 'before-change-functions 'c-before-change nil t) + (setq c-just-done-before-change nil) (add-hook 'after-change-functions 'c-after-change nil t) - (set (make-local-variable 'font-lock-extend-after-change-region-function) - 'c-extend-after-change-region)) ; Currently (2009-05) used by all - ; languages with #define (C, C++,; ObjC), and by AWK. + (when (boundp 'font-lock-extend-after-change-region-function) + (set (make-local-variable 'font-lock-extend-after-change-region-function) + 'c-extend-after-change-region))) ; Currently (2009-05) used by all + ; languages with #define (C, C++,; ObjC), and by AWK. (defun c-setup-doc-comment-style () "Initialize the variables that depend on the value of `c-doc-comment-style'." @@ -669,9 +674,11 @@ compatible with old code; callers should always specify it." (or (c-cpp-define-name) (c-defun-name)))) (let ((rfn (assq mode c-require-final-newline))) (when rfn - (and (cdr rfn) - (set (make-local-variable 'require-final-newline) - mode-require-final-newline))))) + (if (boundp 'mode-require-final-newline) + (and (cdr rfn) + (set (make-local-variable 'require-final-newline) + mode-require-final-newline)) + (set (make-local-variable 'require-final-newline) (cdr rfn)))))) (defun c-count-cfss (lv-alist) ;; LV-ALIST is an alist like `file-local-variables-alist'. Count how many @@ -948,7 +955,11 @@ Note that the style variables are always made local to the buffer." c-new-END (min (cdr new-bounds) (c-determine-+ve-limit 500 endd))) ;; Clear all old relevant properties. (c-clear-char-property-with-value c-new-BEG c-new-END 'syntax-table '(1)) - (c-clear-char-property-with-value c-new-BEG c-new-END 'category 'c-cpp-delimiter) + + ;; CPP "comment" markers: + (if (eval-when-compile (memq 'category-properties c-emacs-features));Emacs. + (c-clear-char-property-with-value + c-new-BEG c-new-END 'category 'c-cpp-delimiter)) ;; FIXME!!! What about the "<" and ">" category properties? 2009-11-16 ;; Add needed properties to each CPP construct in the region. @@ -967,8 +978,10 @@ Note that the style variables are always made local to the buffer." (setq mbeg (point)) (if (> (c-syntactic-end-of-macro) mbeg) (progn - (c-neutralize-CPP-line mbeg (point)) - (c-set-cpp-delimiters mbeg (point))) + (c-neutralize-CPP-line mbeg (point)) ; "punctuation" properties + (if (eval-when-compile + (memq 'category-properties c-emacs-features)) ;Emacs. + (c-set-cpp-delimiters mbeg (point)))) ; "comment" markers (forward-line)) ; no infinite loop with, e.g., "#//" ))))) @@ -988,64 +1001,71 @@ Note that the style variables are always made local to the buffer." ;; it/them from the cache. Don't worry about being inside a string ;; or a comment - "wrongly" removing a symbol from `c-found-types' ;; isn't critical. - (setq c-maybe-stale-found-type nil) - (save-restriction - (save-match-data - (widen) - (save-excursion - ;; Are we inserting/deleting stuff in the middle of an identifier? - (c-unfind-enclosing-token beg) - (c-unfind-enclosing-token end) - ;; Are we coalescing two tokens together, e.g. "fo o" -> "foo"? - (when (< beg end) - (c-unfind-coalesced-tokens beg end)) - ;; Are we (potentially) disrupting the syntactic context which - ;; makes a type a type? E.g. by inserting stuff after "foo" in - ;; "foo bar;", or before "foo" in "typedef foo *bar;"? - ;; - ;; We search for appropriate c-type properties "near" the change. - ;; First, find an appropriate boundary for this property search. - (let (lim - type type-pos - marked-id term-pos - (end1 - (or (and (eq (get-text-property end 'face) 'font-lock-comment-face) - (previous-single-property-change end 'face)) - end))) - (when (>= end1 beg) ; Don't hassle about changes entirely in comments. - ;; Find a limit for the search for a `c-type' property - (while - (and (/= (skip-chars-backward "^;{}") 0) - (> (point) (point-min)) - (memq (c-get-char-property (1- (point)) 'face) - '(font-lock-comment-face font-lock-string-face)))) - (setq lim (max (point-min) (1- (point)))) - - ;; Look for the latest `c-type' property before end1 - (when (and (> end1 (point-min)) - (setq type-pos - (if (get-text-property (1- end1) 'c-type) - end1 - (previous-single-property-change end1 'c-type nil lim)))) - (setq type (get-text-property (max (1- type-pos) lim) 'c-type)) - - (when (memq type '(c-decl-id-start c-decl-type-start)) - ;; Get the identifier, if any, that the property is on. - (goto-char (1- type-pos)) - (setq marked-id - (when (looking-at "\\(\\sw\\|\\s_\\)") - (c-beginning-of-current-token) - (buffer-substring-no-properties (point) type-pos))) - - (goto-char end1) - (skip-chars-forward "^;{}") ; FIXME!!! loop for comment, maybe - (setq lim (point)) - (setq term-pos - (or (next-single-property-change end 'c-type nil lim) lim)) - (setq c-maybe-stale-found-type - (list type marked-id - type-pos term-pos - (buffer-substring-no-properties type-pos term-pos) + (unless c-just-done-before-change ; Guard against a spurious second + ; invocation of before-change-functions. + (setq c-just-done-before-change t) + (setq c-maybe-stale-found-type nil) + (save-restriction + (save-match-data + (widen) + (save-excursion + ;; Are we inserting/deleting stuff in the middle of an identifier? + (c-unfind-enclosing-token beg) + (c-unfind-enclosing-token end) + ;; Are we coalescing two tokens together, e.g. "fo o" -> "foo"? + (when (< beg end) + (c-unfind-coalesced-tokens beg end)) + ;; Are we (potentially) disrupting the syntactic context which + ;; makes a type a type? E.g. by inserting stuff after "foo" in + ;; "foo bar;", or before "foo" in "typedef foo *bar;"? + ;; + ;; We search for appropriate c-type properties "near" the change. + ;; First, find an appropriate boundary for this property search. + (let (lim + type type-pos + marked-id term-pos + (end1 + (or (and (eq (get-text-property end 'face) + 'font-lock-comment-face) + (previous-single-property-change end 'face)) + end))) + (when (>= end1 beg) ; Don't hassle about changes entirely in comments. + ;; Find a limit for the search for a `c-type' property + (while + (and (/= (skip-chars-backward "^;{}") 0) + (> (point) (point-min)) + (memq (c-get-char-property (1- (point)) 'face) + '(font-lock-comment-face font-lock-string-face)))) + (setq lim (max (point-min) (1- (point)))) + + ;; Look for the latest `c-type' property before end1 + (when (and (> end1 (point-min)) + (setq type-pos + (if (get-text-property (1- end1) 'c-type) + end1 + (previous-single-property-change end1 'c-type + nil lim)))) + (setq type (get-text-property (max (1- type-pos) lim) 'c-type)) + + (when (memq type '(c-decl-id-start c-decl-type-start)) + ;; Get the identifier, if any, that the property is on. + (goto-char (1- type-pos)) + (setq marked-id + (when (looking-at "\\(\\sw\\|\\s_\\)") + (c-beginning-of-current-token) + (buffer-substring-no-properties (point) type-pos))) + + (goto-char end1) + (skip-chars-forward "^;{}") ;FIXME!!! loop for comment, maybe + (setq lim (point)) + (setq term-pos + (or (c-next-single-property-change end 'c-type nil lim) + lim)) + (setq c-maybe-stale-found-type + (list type marked-id + type-pos term-pos + (buffer-substring-no-properties type-pos + term-pos) (buffer-substring-no-properties beg end))))))) (if c-get-state-before-change-functions @@ -1056,7 +1076,7 @@ Note that the style variables are always made local to the buffer." ))) ;; The following must be done here rather than in `c-after-change' because ;; newly inserted parens would foul up the invalidation algorithm. - (c-invalidate-state-cache beg)) + (c-invalidate-state-cache beg))) (defvar c-in-after-change-fontification nil) (make-variable-buffer-local 'c-in-after-change-fontification) @@ -1077,6 +1097,7 @@ Note that the style variables are always made local to the buffer." ;; This calls the language variable c-before-font-lock-functions, if non nil. ;; This typically sets `syntax-table' properties. + (setq c-just-done-before-change nil) (c-save-buffer-state (case-fold-search open-paren-in-column-0-is-defun-start) ;; When `combine-after-change-calls' is used we might get calls ;; with regions outside the current narrowing. This has been @@ -1097,11 +1118,12 @@ Note that the style variables are always made local to the buffer." ;; C-y is capable of spuriously converting category properties ;; c-</>-as-paren-syntax and c-cpp-delimiter into hard syntax-table ;; properties. Remove these when it happens. - (c-clear-char-property-with-value beg end 'syntax-table - c-<-as-paren-syntax) - (c-clear-char-property-with-value beg end 'syntax-table - c->-as-paren-syntax) - (c-clear-char-property-with-value beg end 'syntax-table nil) + (when (eval-when-compile (memq 'category-properties c-emacs-features)) + (c-clear-char-property-with-value beg end 'syntax-table + c-<-as-paren-syntax) + (c-clear-char-property-with-value beg end 'syntax-table + c->-as-paren-syntax) + (c-clear-char-property-with-value beg end 'syntax-table nil)) (c-trim-found-types beg end old-len) ; maybe we don't need all of these. (c-invalidate-sws-region-after beg end) @@ -1239,6 +1261,7 @@ This function is called from `c-common-init', once per mode initialization." (make-local-hook 'font-lock-mode-hook)) (add-hook 'font-lock-mode-hook 'c-after-font-lock-init nil t)) +;; Emacs 22 and later. (defun c-extend-after-change-region (_beg _end _old-len) "Extend the region to be fontified, if necessary." ;; Note: the parameters are ignored here. This somewhat indirect @@ -1252,6 +1275,21 @@ This function is called from `c-common-init', once per mode initialization." ;; function. (cons c-new-BEG c-new-END)) +;; Emacs < 22 and XEmacs +(defmacro c-advise-fl-for-region (function) + `(defadvice ,function (before get-awk-region activate) + ;; Make sure that any string/regexp is completely font-locked. + (when c-buffer-is-cc-mode + (save-excursion + (ad-set-arg 1 c-new-END) ; end + (ad-set-arg 0 c-new-BEG))))) ; beg + +(unless (boundp 'font-lock-extend-after-change-region-function) + (c-advise-fl-for-region font-lock-after-change-function) + (c-advise-fl-for-region jit-lock-after-change) + (c-advise-fl-for-region lazy-lock-defer-rest-after-change) + (c-advise-fl-for-region lazy-lock-defer-line-after-change)) + ;; Connect up to `electric-indent-mode' (Emacs 24.4 and later). (defun c-electric-indent-mode-hook () ;; Emacs has en/disabled `electric-indent-mode'. Propagate this through to @@ -1322,6 +1360,7 @@ This function is called from `c-common-init', once per mode initialization." ;;;###autoload (add-to-list 'auto-mode-alist '("\\.i\\'" . c-mode)) ;;;###autoload (add-to-list 'auto-mode-alist '("\\.ii\\'" . c++-mode)) +(unless (fboundp 'prog-mode) (defalias 'prog-mode 'fundamental-mode)) ;;;###autoload (define-derived-mode c-mode prog-mode "C" @@ -1779,4 +1818,8 @@ Key bindings: (cc-provide 'cc-mode) +;;; Local Variables: +;;; indent-tabs-mode: t +;;; tab-width: 8 +;;; End: ;;; cc-mode.el ends here diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index 01a856a8434..9a29c01c62e 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -165,8 +165,8 @@ (c-offsets-alist . ((topmost-intro . 0) (substatement . +) (substatement-open . 0) - (case-label . +) - (access-label . -) + (case-label . +) + (access-label . -) (inclass . +) (inline-open . 0)))) ("linux" @@ -209,15 +209,15 @@ (c-offsets-alist . ((inline-open . 0) (topmost-intro-cont . +) (statement-block-intro . +) - (knr-argdecl-intro . 5) + (knr-argdecl-intro . 5) (substatement-open . +) (substatement-label . +) - (label . +) - (statement-case-open . +) - (statement-cont . +) - (arglist-intro . c-lineup-arglist-intro-after-paren) - (arglist-close . c-lineup-arglist) - (access-label . 0) + (label . +) + (statement-case-open . +) + (statement-cont . +) + (arglist-intro . c-lineup-arglist-intro-after-paren) + (arglist-close . c-lineup-arglist) + (access-label . 0) (inher-cont . c-lineup-java-inher) (func-decl-cont . c-lineup-java-throws)))) @@ -663,4 +663,8 @@ DEFAULT-STYLE has the same format as `c-default-style'." (cc-provide 'cc-styles) +;;; Local Variables: +;;; indent-tabs-mode: t +;;; tab-width: 8 +;;; End: ;;; cc-styles.el ends here diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index a4f9345371a..022bc225c9f 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -271,17 +271,23 @@ nil." :group 'c) ;;;###autoload(put 'c-basic-offset 'safe-local-variable 'integerp) + (defcustom c-tab-always-indent t "*Controls the operation of the TAB key. If t, hitting TAB always just indents the current line. If nil, hitting TAB indents the current line if point is at the left margin or in the -line's indentation, otherwise it calls `c-insert-tab-function' to -insert a `real' tab character. If some other value (neither nil nor t), -then inserts a tab only within literals (comments and strings), but -always reindents the line. - -Note: the variable `c-comment-only-line-offset' also controls the -indentation of lines containing only comments." +line's indentation, otherwise it inserts a `real' tab character \(see +note\). If some other value (not nil or t), then tab is inserted only +within literals \(comments and strings), but the line is always +reindented. + +Note: The value of `indent-tabs-mode' will determine whether a real +tab character will be inserted, or the equivalent number of spaces. +When inserting a tab, actually the function stored in the variable +`c-insert-tab-function' is called. + +Note: indentation of lines containing only comments is also controlled +by the `c-comment-only-line-offset' variable." :type '(radio (const :tag "TAB key always indents, never inserts TAB" t) (const :tag "TAB key indents in left margin, otherwise inserts TAB" nil) @@ -535,7 +541,7 @@ variable in a mode hook." (const :format "IDL " idl-mode) (regexp :format "%v")) (cons :format "%v" (const :format "Pike " pike-mode) (regexp :format "%v")) - (cons :format "%v" + (cons :format "%v" (const :format "AWK " awk-mode) (regexp :format "%v"))) (cons :format " %v" (const :format "Other " other) (regexp :format "%v")))) @@ -920,7 +926,7 @@ Only currently supported behavior is `alignleft'." (defcustom c-special-indent-hook nil "*Hook for user defined special indentation adjustments. This hook gets called after each line is indented by the mode. It is only -called if `c-syntactic-indentation' is non-nil." +called when `c-syntactic-indentation' is non-nil." :type 'hook :group 'c) @@ -1170,7 +1176,7 @@ can always override the use of `c-default-style' by making calls to (objc-method-args-cont . c-lineup-ObjC-method-args) ;; Anchor pos: At the method start (always at boi). (objc-method-call-cont . (c-lineup-ObjC-method-call-colons - c-lineup-ObjC-method-call +)) + c-lineup-ObjC-method-call +)) ;; Anchor pos: At the open bracket. (extern-lang-open . 0) (namespace-open . 0) @@ -1689,7 +1695,8 @@ as designated in the variable `c-file-style'.") ;; It isn't possible to specify a doc-string without specifying an ;; initial value with `defvar', so the following two variables have been ;; given doc-strings by setting the property `variable-documentation' -;; directly. It's really good not to have an initial value for +;; directly. C-h v will read this documentation only for versions of GNU +;; Emacs from 22.1. It's really good not to have an initial value for ;; variables like these that always should be dynamically bound, so it's ;; worth the inconvenience. @@ -1765,4 +1772,8 @@ It treats escaped EOLs as whitespace.") (cc-provide 'cc-vars) +;;; Local Variables: +;;; indent-tabs-mode: t +;;; tab-width: 8 +;;; End: ;;; cc-vars.el ends here diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 2a96181406c..aec7d208022 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -27,9 +27,6 @@ ;; Provides support for editing GNU Cfengine files, including ;; font-locking, Imenu and indentation, but with no special keybindings. -;; The CFEngine 3.x support doesn't have Imenu support but patches are -;; welcome. - ;; By default, CFEngine 3.x syntax is used. ;; You can set it up so either `cfengine2-mode' (2.x and earlier) or @@ -56,7 +53,6 @@ ;;; Code: (autoload 'json-read "json") -(autoload 'regexp-opt "regexp-opt") (defgroup cfengine () "Editing CFEngine files." @@ -815,24 +811,24 @@ bundle agent rcfiles "List of the action keywords supported by Cfengine. This includes those for cfservd as well as cfagent.") - (defconst cfengine3-defuns - (mapcar - 'symbol-name - '(bundle body)) + (defconst cfengine3-defuns '("bundle" "body") "List of the CFEngine 3.x defun headings.") - (defconst cfengine3-defuns-regex - (regexp-opt cfengine3-defuns t) + (defconst cfengine3-defuns-regex (regexp-opt cfengine3-defuns t) "Regex to match the CFEngine 3.x defuns.") + (defconst cfengine3-defun-full-re (concat "^\\s-*" cfengine3-defuns-regex + "\\s-+\\(\\(?:\\w\\|\\s_\\)+\\)" ;type + "\\s-+\\(\\(?:\\w\\|\\s_\\)+\\)" ;id + ) + "Regexp matching full defun declaration (excluding argument list).") + (defconst cfengine3-class-selector-regex "\\([[:alnum:]_().&|!:]+\\)::") (defconst cfengine3-category-regex "\\([[:alnum:]_]+\\):") - (defconst cfengine3-vartypes - (mapcar - 'symbol-name - '(string int real slist ilist rlist irange rrange counter data)) + (defconst cfengine3-vartypes '("string" "int" "real" "slist" "ilist" "rlist" + "irange" "rrange" "counter" "data") "List of the CFEngine 3.x variable types.")) (defvar cfengine2-font-lock-keywords @@ -1231,29 +1227,32 @@ Should not be necessary unless you reinstall CFEngine." (setq cfengine-mode-syntax-cache nil)) (defun cfengine3-make-syntax-cache () - "Build the CFEngine 3 syntax cache. -Calls `cfengine-cf-promises' with \"-s json\"" - (let ((syntax (cddr (assoc cfengine-cf-promises cfengine-mode-syntax-cache)))) - (if cfengine-cf-promises - (or syntax - (with-demoted-errors - (with-temp-buffer - (call-process-shell-command cfengine-cf-promises - nil ; no input - t ; current buffer - nil ; no redisplay - "-s" "json") - (goto-char (point-min)) - (setq syntax (json-read)) - (setq cfengine-mode-syntax-cache - (cons (cons cfengine-cf-promises syntax) - cfengine-mode-syntax-cache)) - (setq cfengine-mode-syntax-functions-regex - (regexp-opt (mapcar (lambda (def) - (format "%s" (car def))) - (cdr (assq 'functions syntax))) - 'symbols)))))) - cfengine3-fallback-syntax)) + "Build the CFEngine 3 syntax cache and return the syntax. +Calls `cfengine-cf-promises' with \"-s json\"." + (or (cdr (assoc cfengine-cf-promises cfengine-mode-syntax-cache)) + (let ((syntax (or (when cfengine-cf-promises + (with-demoted-errors "cfengine3-make-syntax-cache: %S" + (with-temp-buffer + (or (zerop (process-file cfengine-cf-promises + nil ; no input + t ; output + nil ; no redisplay + "-s" "json")) + (error "%s" (buffer-substring + (point-min) + (progn (goto-char (point-min)) + (line-end-position))))) + (goto-char (point-min)) + (json-read)))) + cfengine3-fallback-syntax))) + (push (cons cfengine-cf-promises syntax) + cfengine-mode-syntax-cache) + (setq cfengine-mode-syntax-functions-regex + (regexp-opt (mapcar (lambda (def) + (format "%s" (car def))) + (cdr (assq 'functions syntax))) + 'symbols)) + syntax))) (defun cfengine3-documentation-function () "Document CFengine 3 functions around point. @@ -1265,7 +1264,6 @@ Use it by enabling `eldoc-mode'." (defun cfengine3-completion-function () "Return completions for function name around or before point." - (cfengine3-make-syntax-cache) (let* ((bounds (save-excursion (let ((p (point))) (skip-syntax-backward "w_" (point-at-bol)) @@ -1306,6 +1304,26 @@ Use it by enabling `eldoc-mode'." ("=>" . ?⇒) ("::" . ?∷))) +(defun cfengine3-create-imenu-index () + "A function for `imenu-create-index-function'. +Note: defun name is separated by space such as `body +package_method opencsw' and imenu will replace spaces according +to `imenu-space-replacement' (which see)." + (goto-char (point-min)) + (let ((defuns ())) + (while (re-search-forward cfengine3-defun-full-re nil t) + (push (cons (mapconcat #'match-string '(1 2 3) " ") + (copy-marker (match-beginning 3))) + defuns)) + (nreverse defuns))) + +(defun cfengine3-current-defun () + "A function for `add-log-current-defun-function'." + (end-of-line) + (beginning-of-defun) + (and (looking-at cfengine3-defun-full-re) + (mapconcat #'match-string '(1 2 3) " "))) + ;;;###autoload (define-derived-mode cfengine3-mode prog-mode "CFE3" "Major mode for editing CFEngine3 input. @@ -1332,17 +1350,18 @@ to the action header." (when buffer-file-name (shell-quote-argument buffer-file-name))))) - (set (make-local-variable 'eldoc-documentation-function) - #'cfengine3-documentation-function) + (add-function :before-until (local 'eldoc-documentation-function) + #'cfengine3-documentation-function) (add-hook 'completion-at-point-functions #'cfengine3-completion-function nil t) ;; Use defuns as the essential syntax block. - (set (make-local-variable 'beginning-of-defun-function) - #'cfengine3-beginning-of-defun) - (set (make-local-variable 'end-of-defun-function) - #'cfengine3-end-of-defun)) + (setq-local beginning-of-defun-function #'cfengine3-beginning-of-defun) + (setq-local end-of-defun-function #'cfengine3-end-of-defun) + + (setq-local imenu-create-index-function #'cfengine3-create-imenu-index) + (setq-local add-log-current-defun-function #'cfengine3-current-defun)) ;;;###autoload (define-derived-mode cfengine2-mode prog-mode "CFE2" @@ -1376,15 +1395,18 @@ to the action header." ;;;###autoload (defun cfengine-auto-mode () - "Choose between `cfengine2-mode' and `cfengine3-mode' depending -on the buffer contents" - (let ((v3 nil)) - (save-restriction - (goto-char (point-min)) - (while (not (or (eobp) v3)) - (setq v3 (looking-at (concat cfengine3-defuns-regex "\\_>"))) - (forward-line))) - (if v3 (cfengine3-mode) (cfengine2-mode)))) + "Choose `cfengine2-mode' or `cfengine3-mode' by buffer contents." + (interactive) + (if (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (forward-comment (point-max)) + (or (eobp) + (re-search-forward + (concat "^\\s-*" cfengine3-defuns-regex "\\_>") nil t)))) + (cfengine3-mode) + (cfengine2-mode))) (defalias 'cfengine-mode 'cfengine3-mode) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 3d4ac6ebd32..362bbf54c0b 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -134,7 +134,7 @@ and a string describing how the process finished.") ;; emacs -batch -l compile-tests.el -f ert-run-tests-batch-and-exit (defvar compilation-error-regexp-alist-alist - '((absoft + `((absoft "^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) @@ -255,16 +255,46 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) ;; can be composed of any non-newline char, but it also rules out some ;; valid but unlikely cases, such as a trailing space or a space ;; followed by a -, or a colon followed by a space. - + ;; ;; The "in \\|from " exception was added to handle messages from Ruby. - "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\|[ \t]+\\(?:in \\|from \\)\\)?\ -\\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\): ?\ -\\([0-9]+\\)\\(?:-\\(?4:[0-9]+\\)\\(?:\\.\\(?5:[0-9]+\\)\\)?\ -\\|[.:]\\(?3:[0-9]+\\)\\(?:-\\(?:\\(?4:[0-9]+\\)\\.\\)?\\(?5:[0-9]+\\)\\)?\\)?:\ -\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\ - *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\|\\[ skipping .+ \\]\\|\ -\\(?:instantiated\\|required\\) from\\|[Nn]ote\\)\\|\ - *[Ee]rror\\|[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)" + ,(rx + bol + (? (| (regexp "[[:alpha:]][-[:alnum:].]+: ?") + (regexp "[ \t]+\\(?:in \\|from\\)"))) + (group-n 1 (: (regexp "[0-9]*[^0-9\n]") + (*? (| (regexp "[^\n :]") + (regexp " [^-/\n]") + (regexp ":[^ \n]"))))) + (regexp ": ?") + (group-n 2 (regexp "[0-9]+")) + (? (| (: "-" + (group-n 4 (regexp "[0-9]+")) + (? "." (group-n 5 (regexp "[0-9]+")))) + (: (in ".:") + (group-n 3 (regexp "[0-9]+")) + (? "-" + (? (group-n 4 (regexp "[0-9]+")) ".") + (group-n 5 (regexp "[0-9]+")))))) + ":" + (| (: (* " ") + (group-n 6 (| "FutureWarning" + "RuntimeWarning" + "Warning" + "warning" + "W:"))) + (: (* " ") + (group-n 7 (| (regexp "[Ii]nfo\\(?:\\>\\|rmationa?l?\\)") + "I:" + (: "[ skipping " (+ ".") " ]") + "instantiated from" + "required from" + (regexp "[Nn]ote")))) + (: (* " ") + (regexp "[Ee]rror")) + (: (regexp "[0-9]?") + (| (regexp "[^0-9\n]") + eol)) + (regexp "[0-9][0-9][0-9]"))) 1 (2 . 4) (3 . 5) (6 . 7)) (lcc @@ -447,6 +477,8 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?" ;; "^\\([^ \t\r\n(]+\\) (\\([0-9]+\\):\\([0-9]+\\)) " 1 2 3) + (guile-file "^In \\(.+\\):\n" 1) + (guile-line "^ *\\([0-9]+\\): *\\([0-9]+\\)" nil 1 2) ) "Alist of values for `compilation-error-regexp-alist'.") @@ -937,19 +969,12 @@ POS and RES.") (cons (copy-marker pos) (if prev (copy-marker prev)))) prev) ((and prev (= prev cache)) - (if cache - (set-marker (car compilation--previous-directory-cache) pos) - (setq compilation--previous-directory-cache - (cons (copy-marker pos) nil))) + (set-marker (car compilation--previous-directory-cache) pos) (cdr compilation--previous-directory-cache)) (t - (if cache - (progn - (set-marker cache pos) - (setcdr compilation--previous-directory-cache - (copy-marker prev))) - (setq compilation--previous-directory-cache - (cons (copy-marker pos) (if prev (copy-marker prev))))) + (set-marker cache pos) + (setcdr compilation--previous-directory-cache + (copy-marker prev)) prev)))) (if (markerp res) (marker-position res) res)))) @@ -2054,8 +2079,7 @@ Optional argument MINOR indicates this is called from (if minor (progn (font-lock-add-keywords nil (compilation-mode-font-lock-keywords)) - (if font-lock-mode - (font-lock-fontify-buffer))) + (font-lock-flush)) (setq font-lock-defaults '(compilation-mode-font-lock-keywords t)))) (defun compilation--unsetup () @@ -2064,8 +2088,7 @@ Optional argument MINOR indicates this is called from (remove-hook 'before-change-functions 'compilation--flush-parse t) (kill-local-variable 'compilation--parsed) (compilation--remove-properties) - (if font-lock-mode - (font-lock-fontify-buffer))) + (font-lock-flush)) ;;;###autoload (define-minor-mode compilation-shell-minor-mode @@ -2271,6 +2294,7 @@ looking for the next message." (or (compilation-buffer-p (current-buffer)) (error "Not in a compilation buffer")) (or pt (setq pt (point))) + (compilation--ensure-parse pt) (let* ((msg (get-text-property pt 'compilation-message)) ;; `loc', `msg', and `last' are used by the compilation-loop macro. (loc (and msg (compilation--message->loc msg))) @@ -2283,7 +2307,8 @@ looking for the next message." (line-beginning-position))) (unless (setq msg (get-text-property (max (1- pt) (point-min)) 'compilation-message)) - (setq pt (next-single-property-change pt 'compilation-message nil + (setq pt (compilation-next-single-property-change + pt 'compilation-message nil (line-end-position))) (or (setq msg (get-text-property pt 'compilation-message)) (setq pt (point))))) @@ -2294,7 +2319,6 @@ looking for the next message." "No more %ss yet" "Moved past last %s") (point-max)) - (compilation--ensure-parse pt) ;; Don't move "back" to message at or before point. ;; Pass an explicit (point-min) to make sure pt is non-nil. (setq pt (previous-single-property-change diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 9942859bfbc..3b8742ee842 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -4828,9 +4828,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (and (memq (char-syntax (preceding-char)) '(?w ?_)) (progn (backward-sexp) - ;; sub {BLK}, print {BLK} $data, but NOT `bless', `return', `tr' + ;; sub {BLK}, print {BLK} $data, but NOT `bless', `return', `tr', `constant' (or (and (looking-at "[a-zA-Z0-9_:]+[ \t\n\f]*[{#]") ; Method call syntax - (not (looking-at "\\(bless\\|return\\|q[wqrx]?\\|tr\\|[smy]\\)\\>"))) + (not (looking-at "\\(bless\\|return\\|q[wqrx]?\\|tr\\|[smy]\\|constant\\)\\>"))) ;; sub bless::foo {} (progn (cperl-backward-to-noncomment (point-min)) diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el index 39cd0e1a44b..2f501f28b65 100644 --- a/lisp/progmodes/cwarn.el +++ b/lisp/progmodes/cwarn.el @@ -188,7 +188,7 @@ and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil." :group 'cwarn :lighter cwarn-mode-text (cwarn-font-lock-keywords cwarn-mode) - (if font-lock-mode (font-lock-fontify-buffer))) + (font-lock-flush)) ;;;###autoload (define-obsolete-function-alias 'turn-on-cwarn-mode 'cwarn-mode "24.1") diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el new file mode 100644 index 00000000000..b2c5fbfe60e --- /dev/null +++ b/lisp/progmodes/elisp-mode.el @@ -0,0 +1,1376 @@ +;;; elisp-mode.el --- Emacs Lisp mode -*- lexical-binding:t -*- + +;; Copyright (C) 1985-1986, 1999-2015 Free Software Foundation, Inc. + +;; Maintainer: emacs-devel@gnu.org +;; Keywords: lisp, languages +;; Package: emacs + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; The major mode for editing Emacs Lisp code. +;; This mode is documented in the Emacs manual. + +;;; Code: + +(require 'lisp-mode) + +(defvar emacs-lisp-mode-abbrev-table nil) +(define-abbrev-table 'emacs-lisp-mode-abbrev-table () + "Abbrev table for Emacs Lisp mode. +It has `lisp-mode-abbrev-table' as its parent." + :parents (list lisp-mode-abbrev-table)) + +(defvar emacs-lisp-mode-syntax-table + (let ((table (make-syntax-table lisp--mode-syntax-table))) + (modify-syntax-entry ?\[ "(] " table) + (modify-syntax-entry ?\] ")[ " table) + table) + "Syntax table used in `emacs-lisp-mode'.") + +(defvar emacs-lisp-mode-map + (let ((map (make-sparse-keymap "Emacs-Lisp")) + (menu-map (make-sparse-keymap "Emacs-Lisp")) + (lint-map (make-sparse-keymap)) + (prof-map (make-sparse-keymap)) + (tracing-map (make-sparse-keymap))) + (set-keymap-parent map lisp-mode-shared-map) + (define-key map "\e\t" 'completion-at-point) + (define-key map "\e\C-x" 'eval-defun) + (define-key map "\e\C-q" 'indent-pp-sexp) + (bindings--define-key map [menu-bar emacs-lisp] + (cons "Emacs-Lisp" menu-map)) + (bindings--define-key menu-map [eldoc] + '(menu-item "Auto-Display Documentation Strings" eldoc-mode + :button (:toggle . (bound-and-true-p eldoc-mode)) + :help "Display the documentation string for the item under cursor")) + (bindings--define-key menu-map [checkdoc] + '(menu-item "Check Documentation Strings" checkdoc + :help "Check documentation strings for style requirements")) + (bindings--define-key menu-map [re-builder] + '(menu-item "Construct Regexp" re-builder + :help "Construct a regexp interactively")) + (bindings--define-key menu-map [tracing] (cons "Tracing" tracing-map)) + (bindings--define-key tracing-map [tr-a] + '(menu-item "Untrace All" untrace-all + :help "Untrace all currently traced functions")) + (bindings--define-key tracing-map [tr-uf] + '(menu-item "Untrace Function..." untrace-function + :help "Untrace function, and possibly activate all remaining advice")) + (bindings--define-key tracing-map [tr-sep] menu-bar-separator) + (bindings--define-key tracing-map [tr-q] + '(menu-item "Trace Function Quietly..." trace-function-background + :help "Trace the function with trace output going quietly to a buffer")) + (bindings--define-key tracing-map [tr-f] + '(menu-item "Trace Function..." trace-function + :help "Trace the function given as an argument")) + (bindings--define-key menu-map [profiling] (cons "Profiling" prof-map)) + (bindings--define-key prof-map [prof-restall] + '(menu-item "Remove Instrumentation for All Functions" elp-restore-all + :help "Restore the original definitions of all functions being profiled")) + (bindings--define-key prof-map [prof-restfunc] + '(menu-item "Remove Instrumentation for Function..." elp-restore-function + :help "Restore an instrumented function to its original definition")) + + (bindings--define-key prof-map [sep-rem] menu-bar-separator) + (bindings--define-key prof-map [prof-resall] + '(menu-item "Reset Counters for All Functions" elp-reset-all + :help "Reset the profiling information for all functions being profiled")) + (bindings--define-key prof-map [prof-resfunc] + '(menu-item "Reset Counters for Function..." elp-reset-function + :help "Reset the profiling information for a function")) + (bindings--define-key prof-map [prof-res] + '(menu-item "Show Profiling Results" elp-results + :help "Display current profiling results")) + (bindings--define-key prof-map [prof-pack] + '(menu-item "Instrument Package..." elp-instrument-package + :help "Instrument for profiling all function that start with a prefix")) + (bindings--define-key prof-map [prof-func] + '(menu-item "Instrument Function..." elp-instrument-function + :help "Instrument a function for profiling")) + ;; Maybe this should be in a separate submenu from the ELP stuff? + (bindings--define-key prof-map [sep-natprof] menu-bar-separator) + (bindings--define-key prof-map [prof-natprof-stop] + '(menu-item "Stop Native Profiler" profiler-stop + :help "Stop recording profiling information" + :enable (and (featurep 'profiler) + (profiler-running-p)))) + (bindings--define-key prof-map [prof-natprof-report] + '(menu-item "Show Profiler Report" profiler-report + :help "Show the current profiler report" + :enable (and (featurep 'profiler) + (profiler-running-p)))) + (bindings--define-key prof-map [prof-natprof-start] + '(menu-item "Start Native Profiler..." profiler-start + :help "Start recording profiling information")) + + (bindings--define-key menu-map [lint] (cons "Linting" lint-map)) + (bindings--define-key lint-map [lint-di] + '(menu-item "Lint Directory..." elint-directory + :help "Lint a directory")) + (bindings--define-key lint-map [lint-f] + '(menu-item "Lint File..." elint-file + :help "Lint a file")) + (bindings--define-key lint-map [lint-b] + '(menu-item "Lint Buffer" elint-current-buffer + :help "Lint the current buffer")) + (bindings--define-key lint-map [lint-d] + '(menu-item "Lint Defun" elint-defun + :help "Lint the function at point")) + (bindings--define-key menu-map [edebug-defun] + '(menu-item "Instrument Function for Debugging" edebug-defun + :help "Evaluate the top level form point is in, stepping through with Edebug" + :keys "C-u C-M-x")) + (bindings--define-key menu-map [separator-byte] menu-bar-separator) + (bindings--define-key menu-map [disas] + '(menu-item "Disassemble Byte Compiled Object..." disassemble + :help "Print disassembled code for OBJECT in a buffer")) + (bindings--define-key menu-map [byte-recompile] + '(menu-item "Byte-recompile Directory..." byte-recompile-directory + :help "Recompile every `.el' file in DIRECTORY that needs recompilation")) + (bindings--define-key menu-map [emacs-byte-compile-and-load] + '(menu-item "Byte-compile and Load" emacs-lisp-byte-compile-and-load + :help "Byte-compile the current file (if it has changed), then load compiled code")) + (bindings--define-key menu-map [byte-compile] + '(menu-item "Byte-compile This File" emacs-lisp-byte-compile + :help "Byte compile the file containing the current buffer")) + (bindings--define-key menu-map [separator-eval] menu-bar-separator) + (bindings--define-key menu-map [ielm] + '(menu-item "Interactive Expression Evaluation" ielm + :help "Interactively evaluate Emacs Lisp expressions")) + (bindings--define-key menu-map [eval-buffer] + '(menu-item "Evaluate Buffer" eval-buffer + :help "Execute the current buffer as Lisp code")) + (bindings--define-key menu-map [eval-region] + '(menu-item "Evaluate Region" eval-region + :help "Execute the region as Lisp code" + :enable mark-active)) + (bindings--define-key menu-map [eval-sexp] + '(menu-item "Evaluate Last S-expression" eval-last-sexp + :help "Evaluate sexp before point; print value in echo area")) + (bindings--define-key menu-map [separator-format] menu-bar-separator) + (bindings--define-key menu-map [comment-region] + '(menu-item "Comment Out Region" comment-region + :help "Comment or uncomment each line in the region" + :enable mark-active)) + (bindings--define-key menu-map [indent-region] + '(menu-item "Indent Region" indent-region + :help "Indent each nonblank line in the region" + :enable mark-active)) + (bindings--define-key menu-map [indent-line] + '(menu-item "Indent Line" lisp-indent-line)) + map) + "Keymap for Emacs Lisp mode. +All commands in `lisp-mode-shared-map' are inherited by this map.") + +(defun emacs-lisp-byte-compile () + "Byte compile the file containing the current buffer." + (interactive) + (if buffer-file-name + (byte-compile-file buffer-file-name) + (error "The buffer must be saved in a file first"))) + +(defun emacs-lisp-byte-compile-and-load () + "Byte-compile the current file (if it has changed), then load compiled code." + (interactive) + (or buffer-file-name + (error "The buffer must be saved in a file first")) + (require 'bytecomp) + ;; Recompile if file or buffer has changed since last compilation. + (if (and (buffer-modified-p) + (y-or-n-p (format "Save buffer %s first? " (buffer-name)))) + (save-buffer)) + (byte-recompile-file buffer-file-name nil 0 t)) + +(defun emacs-lisp-macroexpand () + "Macroexpand the form after point. +Comments in the form will be lost." + (interactive) + (let* ((start (point)) + (exp (read (current-buffer))) + ;; Compute it before, since it may signal errors. + (new (macroexpand-1 exp))) + (if (equal exp new) + (message "Not a macro call, nothing to expand") + (delete-region start (point)) + (pp new (current-buffer)) + (if (bolp) (delete-char -1)) + (indent-region start (point))))) + +(defcustom emacs-lisp-mode-hook nil + "Hook run when entering Emacs Lisp mode." + :options '(eldoc-mode imenu-add-menubar-index checkdoc-minor-mode) + :type 'hook + :group 'lisp) + +;;;###autoload +(define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp" + "Major mode for editing Lisp code to run in Emacs. +Commands: +Delete converts tabs to spaces as it moves back. +Blank lines separate paragraphs. Semicolons start comments. + +\\{emacs-lisp-mode-map}" + :group 'lisp + (defvar xref-find-function) + (defvar xref-identifier-completion-table-function) + (lisp-mode-variables nil nil 'elisp) + (setq imenu-case-fold-search nil) + (add-function :before-until (local 'eldoc-documentation-function) + #'elisp-eldoc-documentation-function) + (setq-local xref-find-function #'elisp-xref-find) + (setq-local xref-identifier-completion-table-function + #'elisp--xref-identifier-completion-table) + (add-hook 'completion-at-point-functions + #'elisp-completion-at-point nil 'local)) + +;;; Completion at point for Elisp + +(defun elisp--local-variables-1 (vars sexp) + "Return the vars locally bound around the witness, or nil if not found." + (let (res) + (while + (unless + (setq res + (pcase sexp + (`(,(or `let `let*) ,bindings) + (let ((vars vars)) + (when (eq 'let* (car sexp)) + (dolist (binding (cdr (reverse bindings))) + (push (or (car-safe binding) binding) vars))) + (elisp--local-variables-1 + vars (car (cdr-safe (car (last bindings))))))) + (`(,(or `let `let*) ,bindings . ,body) + (let ((vars vars)) + (dolist (binding bindings) + (push (or (car-safe binding) binding) vars)) + (elisp--local-variables-1 vars (car (last body))))) + (`(lambda ,_args) + ;; FIXME: Look for the witness inside `args'. + (setq sexp nil)) + (`(lambda ,args . ,body) + (elisp--local-variables-1 + (append (remq '&optional (remq '&rest args)) vars) + (car (last body)))) + (`(condition-case ,_ ,e) (elisp--local-variables-1 vars e)) + (`(condition-case ,v ,_ . ,catches) + (elisp--local-variables-1 + (cons v vars) (cdr (car (last catches))))) + (`(quote . ,_) + ;; FIXME: Look for the witness inside sexp. + (setq sexp nil)) + ;; FIXME: Handle `cond'. + (`(,_ . ,_) + (elisp--local-variables-1 vars (car (last sexp)))) + (`elisp--witness--lisp (or vars '(nil))) + (_ nil))) + ;; We didn't find the witness in the last element so we try to + ;; backtrack to the last-but-one. + (setq sexp (ignore-errors (butlast sexp))))) + res)) + +(defun elisp--local-variables () + "Return a list of locally let-bound variables at point." + (save-excursion + (skip-syntax-backward "w_") + (let* ((ppss (syntax-ppss)) + (txt (buffer-substring-no-properties (or (car (nth 9 ppss)) (point)) + (or (nth 8 ppss) (point)))) + (closer ())) + (dolist (p (nth 9 ppss)) + (push (cdr (syntax-after p)) closer)) + (setq closer (apply #'string closer)) + (let* ((sexp (condition-case nil + (car (read-from-string + (concat txt "elisp--witness--lisp" closer))) + ((invalid-read-syntax end-of-file) nil))) + (macroexpand-advice (lambda (expander form &rest args) + (condition-case nil + (apply expander form args) + (error form)))) + (sexp + (unwind-protect + (progn + (advice-add 'macroexpand :around macroexpand-advice) + (macroexpand-all sexp)) + (advice-remove 'macroexpand macroexpand-advice))) + (vars (elisp--local-variables-1 nil sexp))) + (delq nil + (mapcar (lambda (var) + (and (symbolp var) + (not (string-match (symbol-name var) "\\`[&_]")) + ;; Eliminate uninterned vars. + (intern-soft var) + var)) + vars)))))) + +(defvar elisp--local-variables-completion-table + ;; Use `defvar' rather than `defconst' since defconst would purecopy this + ;; value, which would doubly fail: it would fail because purecopy can't + ;; handle the recursive bytecode object, and it would fail because it would + ;; move `lastpos' and `lastvars' to pure space where they'd be immutable! + (let ((lastpos nil) (lastvars nil)) + (letrec ((hookfun (lambda () + (setq lastpos nil) + (remove-hook 'post-command-hook hookfun)))) + (completion-table-dynamic + (lambda (_string) + (save-excursion + (skip-syntax-backward "_w") + (let ((newpos (cons (point) (current-buffer)))) + (unless (equal lastpos newpos) + (add-hook 'post-command-hook hookfun) + (setq lastpos newpos) + (setq lastvars + (mapcar #'symbol-name (elisp--local-variables)))))) + lastvars))))) + +(defun elisp--expect-function-p (pos) + "Return non-nil if the symbol at point is expected to be a function." + (or + (and (eq (char-before pos) ?') + (eq (char-before (1- pos)) ?#)) + (save-excursion + (let ((parent (nth 1 (syntax-ppss pos)))) + (when parent + (goto-char parent) + (and + (looking-at (concat "(\\(cl-\\)?" + (regexp-opt '("declare-function" + "function" "defadvice" + "callf" "callf2" + "defsetf")) + "[ \t\r\n]+")) + (eq (match-end 0) pos))))))) + +(defun elisp--form-quoted-p (pos) + "Return non-nil if the form at POS is not evaluated. +It can be quoted, or be inside a quoted form." + ;; FIXME: Do some macro expansion maybe. + (save-excursion + (let ((state (syntax-ppss pos))) + (or (nth 8 state) ; Code inside strings usually isn't evaluated. + ;; FIXME: The 9th element is undocumented. + (let ((nesting (cons (point) (reverse (nth 9 state)))) + res) + (while (and nesting (not res)) + (goto-char (pop nesting)) + (cond + ((or (eq (char-after) ?\[) + (progn + (skip-chars-backward " ") + (memq (char-before) '(?' ?`)))) + (setq res t)) + ((eq (char-before) ?,) + (setq nesting nil)))) + res))))) + +;; FIXME: Support for Company brings in features which straddle eldoc. +;; We should consolidate this, so that major modes can provide all that +;; data all at once: +;; - a function to extract "the reference at point" (may be more complex +;; than a mere string, to distinguish various namespaces). +;; - a function to jump to such a reference. +;; - a function to show the signature/interface of such a reference. +;; - a function to build a help-buffer about that reference. +;; FIXME: Those functions should also be used by the normal completion code in +;; the *Completions* buffer. + +(defun elisp--company-doc-buffer (str) + (let ((symbol (intern-soft str))) + ;; FIXME: we really don't want to "display-buffer and then undo it". + (save-window-excursion + ;; Make sure we don't display it in another frame, otherwise + ;; save-window-excursion won't be able to undo it. + (let ((display-buffer-overriding-action + '(nil . ((inhibit-switch-frame . t))))) + (ignore-errors + (cond + ((fboundp symbol) (describe-function symbol)) + ((boundp symbol) (describe-variable symbol)) + ((featurep symbol) (describe-package symbol)) + ((facep symbol) (describe-face symbol)) + (t (signal 'user-error nil))) + (help-buffer)))))) + +(defun elisp--company-doc-string (str) + (let* ((symbol (intern-soft str)) + (doc (if (fboundp symbol) + (documentation symbol t) + (documentation-property symbol 'variable-documentation t)))) + (and (stringp doc) + (string-match ".*$" doc) + (match-string 0 doc)))) + +(declare-function find-library-name "find-func" (library)) +(declare-function find-function-library "find-func" (function &optional l-o v)) + +(defun elisp--company-location (str) + (let ((sym (intern-soft str))) + (cond + ((fboundp sym) (find-definition-noselect sym nil)) + ((boundp sym) (find-definition-noselect sym 'defvar)) + ((featurep sym) + (require 'find-func) + (cons (find-file-noselect (find-library-name + (symbol-name sym))) + 0)) + ((facep sym) (find-definition-noselect sym 'defface))))) + +(defun elisp-completion-at-point () + "Function used for `completion-at-point-functions' in `emacs-lisp-mode'." + (with-syntax-table emacs-lisp-mode-syntax-table + (let* ((pos (point)) + (beg (condition-case nil + (save-excursion + (backward-sexp 1) + (skip-syntax-forward "'") + (point)) + (scan-error pos))) + (end + (unless (or (eq beg (point-max)) + (member (char-syntax (char-after beg)) + '(?\s ?\" ?\( ?\)))) + (condition-case nil + (save-excursion + (goto-char beg) + (forward-sexp 1) + (skip-chars-backward "'") + (when (>= (point) pos) + (point))) + (scan-error pos)))) + ;; t if in function position. + (funpos (eq (char-before beg) ?\())) + (when (and end (or (not (nth 8 (syntax-ppss))) + (eq (char-before beg) ?`))) + (let ((table-etc + (if (not funpos) + ;; FIXME: We could look at the first element of the list and + ;; use it to provide a more specific completion table in some + ;; cases. E.g. filter out keywords that are not understood by + ;; the macro/function being called. + (cond + ((elisp--expect-function-p beg) + (list nil obarray + :predicate #'fboundp + :company-doc-buffer #'elisp--company-doc-buffer + :company-docsig #'elisp--company-doc-string + :company-location #'elisp--company-location)) + ((elisp--form-quoted-p beg) + (list nil obarray + ;; Don't include all symbols (bug#16646). + :predicate (lambda (sym) + (or (boundp sym) + (fboundp sym) + (featurep sym) + (symbol-plist sym))) + :annotation-function + (lambda (str) (if (fboundp (intern-soft str)) " <f>")) + :company-doc-buffer #'elisp--company-doc-buffer + :company-docsig #'elisp--company-doc-string + :company-location #'elisp--company-location)) + (t + (list nil (completion-table-merge + elisp--local-variables-completion-table + (apply-partially #'completion-table-with-predicate + obarray + #'boundp + 'strict)) + :company-doc-buffer #'elisp--company-doc-buffer + :company-docsig #'elisp--company-doc-string + :company-location #'elisp--company-location))) + ;; Looks like a funcall position. Let's double check. + (save-excursion + (goto-char (1- beg)) + (let ((parent + (condition-case nil + (progn (up-list -1) (forward-char 1) + (let ((c (char-after))) + (if (eq c ?\() ?\( + (if (memq (char-syntax c) '(?w ?_)) + (read (current-buffer)))))) + (error nil)))) + (pcase parent + ;; FIXME: Rather than hardcode special cases here, + ;; we should use something like a symbol-property. + (`declare + (list t (mapcar (lambda (x) (symbol-name (car x))) + (delete-dups + ;; FIXME: We should include some + ;; docstring with each entry. + (append + macro-declarations-alist + defun-declarations-alist))))) + ((and (or `condition-case `condition-case-unless-debug) + (guard (save-excursion + (ignore-errors + (forward-sexp 2) + (< (point) beg))))) + (list t obarray + :predicate (lambda (sym) (get sym 'error-conditions)))) + ((and ?\( + (guard (save-excursion + (goto-char (1- beg)) + (up-list -1) + (forward-symbol -1) + (looking-at "\\_<let\\*?\\_>")))) + (list t obarray + :predicate #'boundp + :company-doc-buffer #'elisp--company-doc-buffer + :company-docsig #'elisp--company-doc-string + :company-location #'elisp--company-location)) + (_ (list nil obarray + :predicate #'fboundp + :company-doc-buffer #'elisp--company-doc-buffer + :company-docsig #'elisp--company-doc-string + :company-location #'elisp--company-location + )))))))) + (nconc (list beg end) + (if (null (car table-etc)) + (cdr table-etc) + (cons + (if (memq (char-syntax (or (char-after end) ?\s)) + '(?\s ?>)) + (cadr table-etc) + (apply-partially 'completion-table-with-terminator + " " (cadr table-etc))) + (cddr table-etc))))))))) + +(define-obsolete-function-alias + 'lisp-completion-at-point 'elisp-completion-at-point "25.1") + +;;; Xref backend + +(declare-function xref-make-elisp-location "xref" (symbol type file)) +(declare-function xref-make-bogus-location "xref" (message)) +(declare-function xref-make "xref" (description location)) + +(defun elisp-xref-find (action id) + (require 'find-func) + (pcase action + (`definitions + (let ((sym (intern-soft id))) + (when sym + (elisp--xref-find-definitions sym)))) + (`apropos + (elisp--xref-find-apropos id)))) + +(defun elisp--xref-identifier-location (type sym) + (let ((file + (pcase type + (`defun (when (fboundp sym) + (let ((fun-lib + (find-function-library sym))) + (setq sym (car fun-lib)) + (cdr fun-lib)))) + (`defvar (when (boundp sym) + (or (symbol-file sym 'defvar) + (help-C-file-name sym 'var)))) + (`feature (when (featurep sym) + (ignore-errors + (find-library-name (symbol-name sym))))) + (`defface (when (facep sym) + (symbol-file sym 'defface)))))) + (when file + (when (string-match-p "\\.elc\\'" file) + (setq file (substring file 0 -1))) + (xref-make-elisp-location sym type file)))) + +(defun elisp--xref-find-definitions (symbol) + (save-excursion + (let (lst) + (dolist (type '(feature defface defvar defun)) + (let ((loc + (condition-case err + (elisp--xref-identifier-location type symbol) + (error + (xref-make-bogus-location (error-message-string err)))))) + (when loc + (push + (xref-make (format "(%s %s)" type symbol) + loc) + lst)))) + lst))) + +(defun elisp--xref-find-apropos (regexp) + (apply #'nconc + (let (lst) + (dolist (sym (apropos-internal regexp)) + (push (elisp--xref-find-definitions sym) lst)) + (nreverse lst)))) + +(defvar elisp--xref-identifier-completion-table + (apply-partially #'completion-table-with-predicate + obarray + (lambda (sym) + (or (boundp sym) + (fboundp sym) + (featurep sym) + (facep sym))) + 'strict)) + +(defun elisp--xref-identifier-completion-table () + elisp--xref-identifier-completion-table) + +;;; Elisp Interaction mode + +(defvar lisp-interaction-mode-map + (let ((map (make-sparse-keymap)) + (menu-map (make-sparse-keymap "Lisp-Interaction"))) + (set-keymap-parent map lisp-mode-shared-map) + (define-key map "\e\C-x" 'eval-defun) + (define-key map "\e\C-q" 'indent-pp-sexp) + (define-key map "\e\t" 'completion-at-point) + (define-key map "\n" 'eval-print-last-sexp) + (bindings--define-key map [menu-bar lisp-interaction] + (cons "Lisp-Interaction" menu-map)) + (bindings--define-key menu-map [eval-defun] + '(menu-item "Evaluate Defun" eval-defun + :help "Evaluate the top-level form containing point, or after point")) + (bindings--define-key menu-map [eval-print-last-sexp] + '(menu-item "Evaluate and Print" eval-print-last-sexp + :help "Evaluate sexp before point; print value into current buffer")) + (bindings--define-key menu-map [edebug-defun-lisp-interaction] + '(menu-item "Instrument Function for Debugging" edebug-defun + :help "Evaluate the top level form point is in, stepping through with Edebug" + :keys "C-u C-M-x")) + (bindings--define-key menu-map [indent-pp-sexp] + '(menu-item "Indent or Pretty-Print" indent-pp-sexp + :help "Indent each line of the list starting just after point, or prettyprint it")) + (bindings--define-key menu-map [complete-symbol] + '(menu-item "Complete Lisp Symbol" completion-at-point + :help "Perform completion on Lisp symbol preceding point")) + map) + "Keymap for Lisp Interaction mode. +All commands in `lisp-mode-shared-map' are inherited by this map.") + +(define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction" + "Major mode for typing and evaluating Lisp forms. +Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression +before point, and prints its value into the buffer, advancing point. +Note that printing is controlled by `eval-expression-print-length' +and `eval-expression-print-level'. + +Commands: +Delete converts tabs to spaces as it moves back. +Paragraphs are separated only by blank lines. +Semicolons start comments. + +\\{lisp-interaction-mode-map}" + :abbrev-table nil) + +;;; Emacs Lisp Byte-Code mode + +(eval-and-compile + (defconst emacs-list-byte-code-comment-re + (concat "\\(#\\)@\\([0-9]+\\) " + ;; Make sure it's a docstring and not a lazy-loaded byte-code. + "\\(?:[^(]\\|([^\"]\\)"))) + +(defun elisp--byte-code-comment (end &optional _point) + "Try to syntactically mark the #@NNN ....^_ docstrings in byte-code files." + (let ((ppss (syntax-ppss))) + (when (and (nth 4 ppss) + (eq (char-after (nth 8 ppss)) ?#)) + (let* ((n (save-excursion + (goto-char (nth 8 ppss)) + (when (looking-at emacs-list-byte-code-comment-re) + (string-to-number (match-string 2))))) + ;; `maxdiff' tries to make sure the loop below terminates. + (maxdiff n)) + (when n + (let* ((bchar (match-end 2)) + (b (position-bytes bchar))) + (goto-char (+ b n)) + (while (let ((diff (- (position-bytes (point)) b n))) + (unless (zerop diff) + (when (> diff maxdiff) (setq diff maxdiff)) + (forward-char (- diff)) + (setq maxdiff (if (> diff 0) diff + (max (1- maxdiff) 1))) + t)))) + (if (<= (point) end) + (put-text-property (1- (point)) (point) + 'syntax-table + (string-to-syntax "> b")) + (goto-char end))))))) + +(defun elisp-byte-code-syntax-propertize (start end) + (elisp--byte-code-comment end (point)) + (funcall + (syntax-propertize-rules + (emacs-list-byte-code-comment-re + (1 (prog1 "< b" (elisp--byte-code-comment end (point)))))) + start end)) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.elc\\'" . elisp-byte-code-mode)) +;;;###autoload +(define-derived-mode elisp-byte-code-mode emacs-lisp-mode + "Elisp-Byte-Code" + "Major mode for *.elc files." + ;; TODO: Add way to disassemble byte-code under point. + (setq-local open-paren-in-column-0-is-defun-start nil) + (setq-local syntax-propertize-function + #'elisp-byte-code-syntax-propertize)) + + +;;; Globally accessible functionality + +(defun eval-print-last-sexp (&optional eval-last-sexp-arg-internal) + "Evaluate sexp before point; print value into current buffer. + +Normally, this function truncates long output according to the value +of the variables `eval-expression-print-length' and +`eval-expression-print-level'. With a prefix argument of zero, +however, there is no such truncation. Such a prefix argument +also causes integers to be printed in several additional formats +\(octal, hexadecimal, and character). + +If `eval-expression-debug-on-error' is non-nil, which is the default, +this command arranges for all errors to enter the debugger." + (interactive "P") + (let ((standard-output (current-buffer))) + (terpri) + (eval-last-sexp (or eval-last-sexp-arg-internal t)) + (terpri))) + + +(defun last-sexp-setup-props (beg end value alt1 alt2) + "Set up text properties for the output of `elisp--eval-last-sexp'. +BEG and END are the start and end of the output in current-buffer. +VALUE is the Lisp value printed, ALT1 and ALT2 are strings for the +alternative printed representations that can be displayed." + (let ((map (make-sparse-keymap))) + (define-key map "\C-m" 'elisp-last-sexp-toggle-display) + (define-key map [down-mouse-2] 'mouse-set-point) + (define-key map [mouse-2] 'elisp-last-sexp-toggle-display) + (add-text-properties + beg end + `(printed-value (,value ,alt1 ,alt2) + mouse-face highlight + keymap ,map + help-echo "RET, mouse-2: toggle abbreviated display" + rear-nonsticky (mouse-face keymap help-echo + printed-value))))) + + +(defun elisp-last-sexp-toggle-display (&optional _arg) + "Toggle between abbreviated and unabbreviated printed representations." + (interactive "P") + (save-restriction + (widen) + (let ((value (get-text-property (point) 'printed-value))) + (when value + (let ((beg (or (previous-single-property-change (min (point-max) (1+ (point))) + 'printed-value) + (point))) + (end (or (next-single-char-property-change (point) 'printed-value) (point))) + (standard-output (current-buffer)) + (point (point))) + (delete-region beg end) + (insert (nth 1 value)) + (or (= beg point) + (setq point (1- (point)))) + (last-sexp-setup-props beg (point) + (nth 0 value) + (nth 2 value) + (nth 1 value)) + (goto-char (min (point-max) point))))))) + +(defun prin1-char (char) ;FIXME: Move it, e.g. to simple.el. + "Return a string representing CHAR as a character rather than as an integer. +If CHAR is not a character, return nil." + (and (integerp char) + (eventp char) + (let ((c (event-basic-type char)) + (mods (event-modifiers char)) + string) + ;; Prevent ?A from turning into ?\S-a. + (if (and (memq 'shift mods) + (zerop (logand char ?\S-\^@)) + (not (let ((case-fold-search nil)) + (char-equal c (upcase c))))) + (setq c (upcase c) mods nil)) + ;; What string are we considering using? + (condition-case nil + (setq string + (concat + "?" + (mapconcat + (lambda (modif) + (cond ((eq modif 'super) "\\s-") + (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-)))) + mods "") + (cond + ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c)) + ((eq c 127) "\\C-?") + (t + (string c))))) + (error nil)) + ;; Verify the string reads a CHAR, not to some other character. + ;; If it doesn't, return nil instead. + (and string + (= (car (read-from-string string)) char) + string)))) + +(defun elisp--preceding-sexp () + "Return sexp before the point." + (let ((opoint (point)) + ignore-quotes + expr) + (save-excursion + (with-syntax-table emacs-lisp-mode-syntax-table + ;; If this sexp appears to be enclosed in `...' + ;; then ignore the surrounding quotes. + (setq ignore-quotes + (or (eq (following-char) ?\') + (eq (preceding-char) ?\'))) + (forward-sexp -1) + ;; If we were after `?\e' (or similar case), + ;; use the whole thing, not just the `e'. + (when (eq (preceding-char) ?\\) + (forward-char -1) + (when (eq (preceding-char) ??) + (forward-char -1))) + + ;; Skip over hash table read syntax. + (and (> (point) (1+ (point-min))) + (looking-back "#s" (- (point) 2)) + (forward-char -2)) + + ;; Skip over `#N='s. + (when (eq (preceding-char) ?=) + (let (labeled-p) + (save-excursion + (skip-chars-backward "0-9#=") + (setq labeled-p (looking-at "\\(#[0-9]+=\\)+"))) + (when labeled-p + (forward-sexp -1)))) + + (save-restriction + (if (and ignore-quotes (eq (following-char) ?`)) + ;; vladimir@cs.ualberta.ca 30-Jul-1997: Skip ` in `variable' so + ;; that the value is returned, not the name. + (forward-char)) + (when (looking-at ",@?") (goto-char (match-end 0))) + (narrow-to-region (point-min) opoint) + (setq expr (read (current-buffer))) + ;; If it's an (interactive ...) form, it's more useful to show how an + ;; interactive call would use it. + ;; FIXME: Is it really the right place for this? + (when (eq (car-safe expr) 'interactive) + (setq expr + `(call-interactively + (lambda (&rest args) ,expr args)))) + expr))))) +(define-obsolete-function-alias 'preceding-sexp 'elisp--preceding-sexp "25.1") + +(defun elisp--eval-last-sexp (eval-last-sexp-arg-internal) + "Evaluate sexp before point; print value in the echo area. +With argument, print output into current buffer. +With a zero prefix arg, print output with no limit on the length +and level of lists, and include additional formats for integers +\(octal, hexadecimal, and character)." + (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t))) + ;; Setup the lexical environment if lexical-binding is enabled. + (elisp--eval-last-sexp-print-value + (eval (eval-sexp-add-defvars (elisp--preceding-sexp)) lexical-binding) + eval-last-sexp-arg-internal))) + + +(defun elisp--eval-last-sexp-print-value (value &optional eval-last-sexp-arg-internal) + (let ((unabbreviated (let ((print-length nil) (print-level nil)) + (prin1-to-string value))) + (print-length (and (not (zerop (prefix-numeric-value + eval-last-sexp-arg-internal))) + eval-expression-print-length)) + (print-level (and (not (zerop (prefix-numeric-value + eval-last-sexp-arg-internal))) + eval-expression-print-level)) + (beg (point)) + end) + (prog1 + (prin1 value) + (let ((str (eval-expression-print-format value))) + (if str (princ str))) + (setq end (point)) + (when (and (bufferp standard-output) + (or (not (null print-length)) + (not (null print-level))) + (not (string= unabbreviated + (buffer-substring-no-properties beg end)))) + (last-sexp-setup-props beg end value + unabbreviated + (buffer-substring-no-properties beg end)) + )))) + + +(defvar elisp--eval-last-sexp-fake-value (make-symbol "t")) + +(defun eval-sexp-add-defvars (exp &optional pos) + "Prepend EXP with all the `defvar's that precede it in the buffer. +POS specifies the starting position where EXP was found and defaults to point." + (setq exp (macroexpand-all exp)) ;Eager macro-expansion. + (if (not lexical-binding) + exp + (save-excursion + (unless pos (setq pos (point))) + (let ((vars ())) + (goto-char (point-min)) + (while (re-search-forward + "(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)" + pos t) + (let ((var (intern (match-string 1)))) + (and (not (special-variable-p var)) + (save-excursion + (zerop (car (syntax-ppss (match-beginning 0))))) + (push var vars)))) + `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp))))) + +(defun eval-last-sexp (eval-last-sexp-arg-internal) + "Evaluate sexp before point; print value in the echo area. +Interactively, with prefix argument, print output into current buffer. + +Normally, this function truncates long output according to the value +of the variables `eval-expression-print-length' and +`eval-expression-print-level'. With a prefix argument of zero, +however, there is no such truncation. Such a prefix argument +also causes integers to be printed in several additional formats +\(octal, hexadecimal, and character). + +If `eval-expression-debug-on-error' is non-nil, which is the default, +this command arranges for all errors to enter the debugger." + (interactive "P") + (if (null eval-expression-debug-on-error) + (elisp--eval-last-sexp eval-last-sexp-arg-internal) + (let ((value + (let ((debug-on-error elisp--eval-last-sexp-fake-value)) + (cons (elisp--eval-last-sexp eval-last-sexp-arg-internal) + debug-on-error)))) + (unless (eq (cdr value) elisp--eval-last-sexp-fake-value) + (setq debug-on-error (cdr value))) + (car value)))) + +(defun elisp--eval-defun-1 (form) + "Treat some expressions specially. +Reset the `defvar' and `defcustom' variables to the initial value. +\(For `defcustom', use the :set function if there is one.) +Reinitialize the face according to the `defface' specification." + ;; The code in edebug-defun should be consistent with this, but not + ;; the same, since this gets a macroexpanded form. + (cond ((not (listp form)) + form) + ((and (eq (car form) 'defvar) + (cdr-safe (cdr-safe form)) + (boundp (cadr form))) + ;; Force variable to be re-set. + `(progn (defvar ,(nth 1 form) nil ,@(nthcdr 3 form)) + (setq-default ,(nth 1 form) ,(nth 2 form)))) + ;; `defcustom' is now macroexpanded to + ;; `custom-declare-variable' with a quoted value arg. + ((and (eq (car form) 'custom-declare-variable) + (default-boundp (eval (nth 1 form) lexical-binding))) + ;; Force variable to be bound, using :set function if specified. + (let ((setfunc (memq :set form))) + (when setfunc + (setq setfunc (car-safe (cdr-safe setfunc))) + (or (functionp setfunc) (setq setfunc nil))) + (funcall (or setfunc 'set-default) + (eval (nth 1 form) lexical-binding) + ;; The second arg is an expression that evaluates to + ;; an expression. The second evaluation is the one + ;; normally performed not by normal execution but by + ;; custom-initialize-set (for example), which does not + ;; use lexical-binding. + (eval (eval (nth 2 form) lexical-binding)))) + form) + ;; `defface' is macroexpanded to `custom-declare-face'. + ((eq (car form) 'custom-declare-face) + ;; Reset the face. + (let ((face-symbol (eval (nth 1 form) lexical-binding))) + (setq face-new-frame-defaults + (assq-delete-all face-symbol face-new-frame-defaults)) + (put face-symbol 'face-defface-spec nil) + (put face-symbol 'face-override-spec nil)) + form) + ((eq (car form) 'progn) + (cons 'progn (mapcar #'elisp--eval-defun-1 (cdr form)))) + (t form))) + +(defun elisp--eval-defun () + "Evaluate defun that point is in or before. +The value is displayed in the echo area. +If the current defun is actually a call to `defvar', +then reset the variable using the initial value expression +even if the variable already has some other value. +\(Normally `defvar' does not change the variable's value +if it already has a value.\) + +Return the result of evaluation." + ;; FIXME: the print-length/level bindings should only be applied while + ;; printing, not while evaluating. + (let ((debug-on-error eval-expression-debug-on-error) + (print-length eval-expression-print-length) + (print-level eval-expression-print-level)) + (save-excursion + ;; Arrange for eval-region to "read" the (possibly) altered form. + ;; eval-region handles recording which file defines a function or + ;; variable. + (let ((standard-output t) + beg end form) + ;; Read the form from the buffer, and record where it ends. + (save-excursion + (end-of-defun) + (beginning-of-defun) + (setq beg (point)) + (setq form (read (current-buffer))) + (setq end (point))) + ;; Alter the form if necessary. + (let ((form (eval-sexp-add-defvars + (elisp--eval-defun-1 (macroexpand form))))) + (eval-region beg end standard-output + (lambda (_ignore) + ;; Skipping to the end of the specified region + ;; will make eval-region return. + (goto-char end) + form)))))) + (let ((str (eval-expression-print-format (car values)))) + (if str (princ str))) + ;; The result of evaluation has been put onto VALUES. So return it. + (car values)) + +(defun eval-defun (edebug-it) + "Evaluate the top-level form containing point, or after point. + +If the current defun is actually a call to `defvar' or `defcustom', +evaluating it this way resets the variable using its initial value +expression (using the defcustom's :set function if there is one), even +if the variable already has some other value. \(Normally `defvar' and +`defcustom' do not alter the value if there already is one.) In an +analogous way, evaluating a `defface' overrides any customizations of +the face, so that it becomes defined exactly as the `defface' expression +says. + +If `eval-expression-debug-on-error' is non-nil, which is the default, +this command arranges for all errors to enter the debugger. + +With a prefix argument, instrument the code for Edebug. + +If acting on a `defun' for FUNCTION, and the function was +instrumented, `Edebug: FUNCTION' is printed in the echo area. If not +instrumented, just FUNCTION is printed. + +If not acting on a `defun', the result of evaluation is displayed in +the echo area. This display is controlled by the variables +`eval-expression-print-length' and `eval-expression-print-level', +which see." + (interactive "P") + (cond (edebug-it + (require 'edebug) + (eval-defun (not edebug-all-defs))) + (t + (if (null eval-expression-debug-on-error) + (elisp--eval-defun) + (let (new-value value) + (let ((debug-on-error elisp--eval-last-sexp-fake-value)) + (setq value (elisp--eval-defun)) + (setq new-value debug-on-error)) + (unless (eq elisp--eval-last-sexp-fake-value new-value) + (setq debug-on-error new-value)) + value))))) + +;;; ElDoc Support + +(defvar elisp--eldoc-last-data (make-vector 3 nil) + "Bookkeeping; elements are as follows: + 0 - contains the last symbol read from the buffer. + 1 - contains the string last displayed in the echo area for variables, + or argument string for functions. + 2 - 'function if function args, 'variable if variable documentation.") + +(defun elisp-eldoc-documentation-function () + "`eldoc-documentation-function' (which see) for Emacs Lisp." + (let ((current-symbol (elisp--current-symbol)) + (current-fnsym (elisp--fnsym-in-current-sexp))) + (cond ((null current-fnsym) + nil) + ((eq current-symbol (car current-fnsym)) + (or (apply #'elisp--get-fnsym-args-string current-fnsym) + (elisp--get-var-docstring current-symbol))) + (t + (or (elisp--get-var-docstring current-symbol) + (apply #'elisp--get-fnsym-args-string current-fnsym)))))) + +(defun elisp--get-fnsym-args-string (sym &optional index) + "Return a string containing the parameter list of the function SYM. +If SYM is a subr and no arglist is obtainable from the docstring +or elsewhere, return a 1-line docstring." + (let ((argstring + (cond + ((not (and sym (symbolp sym) (fboundp sym))) nil) + ((and (eq sym (aref elisp--eldoc-last-data 0)) + (eq 'function (aref elisp--eldoc-last-data 2))) + (aref elisp--eldoc-last-data 1)) + (t + (let* ((advertised (gethash (indirect-function sym) + advertised-signature-table t)) + doc + (args + (cond + ((listp advertised) advertised) + ((setq doc (help-split-fundoc (documentation sym t) sym)) + (car doc)) + (t (help-function-arglist sym))))) + ;; Stringify, and store before highlighting, downcasing, etc. + ;; FIXME should truncate before storing. + (elisp--last-data-store sym (elisp--function-argstring args) + 'function)))))) + ;; Highlight, truncate. + (if argstring + (elisp--highlight-function-argument sym argstring index)))) + +(defun elisp--highlight-function-argument (sym args index) + "Highlight argument INDEX in ARGS list for function SYM. +In the absence of INDEX, just call `elisp--docstring-format-sym-doc'." + ;; FIXME: This should probably work on the list representation of `args' + ;; rather than its string representation. + ;; FIXME: This function is much too long, we need to split it up! + (let ((start nil) + (end 0) + (argument-face 'eldoc-highlight-function-argument) + (args-lst (mapcar (lambda (x) + (replace-regexp-in-string + "\\`[(]\\|[)]\\'" "" x)) + (split-string args)))) + ;; Find the current argument in the argument string. We need to + ;; handle `&rest' and informal `...' properly. + ;; + ;; FIXME: What to do with optional arguments, like in + ;; (defun NAME ARGLIST [DOCSTRING] BODY...) case? + ;; The problem is there is no robust way to determine if + ;; the current argument is indeed a docstring. + + ;; When `&key' is used finding position based on `index' + ;; would be wrong, so find the arg at point and determine + ;; position in ARGS based on this current arg. + (when (string-match "&key" args) + (let* (case-fold-search + key-have-value + (sym-name (symbol-name sym)) + (cur-w (current-word)) + (args-lst-ak (cdr (member "&key" args-lst))) + (limit (save-excursion + (when (re-search-backward sym-name nil t) + (match-end 0)))) + (cur-a (if (and cur-w (string-match ":\\([^ ()]*\\)" cur-w)) + (substring cur-w 1) + (save-excursion + (let (split) + (when (re-search-backward ":\\([^()\n]*\\)" limit t) + (setq split (split-string (match-string 1) " " t)) + (prog1 (car split) + (when (cdr split) + (setq key-have-value t)))))))) + ;; If `cur-a' is not one of `args-lst-ak' + ;; assume user is entering an unknown key + ;; referenced in last position in signature. + (other-key-arg (and (stringp cur-a) + args-lst-ak + (not (member (upcase cur-a) args-lst-ak)) + (upcase (car (last args-lst-ak)))))) + (unless (string= cur-w sym-name) + ;; The last keyword have already a value + ;; i.e :foo a b and cursor is at b. + ;; If signature have also `&rest' + ;; (assume it is after the `&key' section) + ;; go to the arg after `&rest'. + (if (and key-have-value + (save-excursion + (not (re-search-forward ":.*" (point-at-eol) t))) + (string-match "&rest \\([^ ()]*\\)" args)) + (setq index nil ; Skip next block based on positional args. + start (match-beginning 1) + end (match-end 1)) + ;; If `cur-a' is nil probably cursor is on a positional arg + ;; before `&key', in this case, exit this block and determine + ;; position with `index'. + (when (and cur-a ; A keyword arg (dot removed) or nil. + (or (string-match + (concat "\\_<" (upcase cur-a) "\\_>") args) + (string-match + (concat "\\_<" other-key-arg "\\_>") args))) + (setq index nil ; Skip next block based on positional args. + start (match-beginning 0) + end (match-end 0))))))) + ;; Handle now positional arguments. + (while (and index (>= index 1)) + (if (string-match "[^ ()]+" args end) + (progn + (setq start (match-beginning 0) + end (match-end 0)) + (let ((argument (match-string 0 args))) + (cond ((string= argument "&rest") + ;; All the rest arguments are the same. + (setq index 1)) + ((string= argument "&optional")) ; Skip. + ((string= argument "&allow-other-keys")) ; Skip. + ;; Back to index 0 in ARG1 ARG2 ARG2 ARG3 etc... + ;; like in `setq'. + ((or (and (string-match-p "\\.\\.\\.$" argument) + (string= argument (car (last args-lst)))) + (and (string-match-p "\\.\\.\\.$" + (substring args 1 (1- (length args)))) + (= (length (remove "..." args-lst)) 2) + (> index 1) (eq (logand index 1) 1))) + (setq index 0)) + (t + (setq index (1- index)))))) + (setq end (length args) + start (1- end) + argument-face 'font-lock-warning-face + index 0))) + (let ((doc args)) + (when start + (setq doc (copy-sequence args)) + (add-text-properties start end (list 'face argument-face) doc)) + (setq doc (elisp--docstring-format-sym-doc + sym doc (if (functionp sym) 'font-lock-function-name-face + 'font-lock-keyword-face))) + doc))) + +;; Return a string containing a brief (one-line) documentation string for +;; the variable. +(defun elisp--get-var-docstring (sym) + (cond ((not sym) nil) + ((and (eq sym (aref elisp--eldoc-last-data 0)) + (eq 'variable (aref elisp--eldoc-last-data 2))) + (aref elisp--eldoc-last-data 1)) + (t + (let ((doc (documentation-property sym 'variable-documentation t))) + (when doc + (let ((doc (elisp--docstring-format-sym-doc + sym (elisp--docstring-first-line doc) + 'font-lock-variable-name-face))) + (elisp--last-data-store sym doc 'variable))))))) + +(defun elisp--last-data-store (symbol doc type) + (aset elisp--eldoc-last-data 0 symbol) + (aset elisp--eldoc-last-data 1 doc) + (aset elisp--eldoc-last-data 2 type) + doc) + +;; Note that any leading `*' in the docstring (which indicates the variable +;; is a user option) is removed. +(defun elisp--docstring-first-line (doc) + (and (stringp doc) + (substitute-command-keys + (save-match-data + ;; Don't use "^" in the regexp below since it may match + ;; anywhere in the doc-string. + (let ((start (if (string-match "\\`\\*" doc) (match-end 0) 0))) + (cond ((string-match "\n" doc) + (substring doc start (match-beginning 0))) + ((zerop start) doc) + (t (substring doc start)))))))) + +(defvar eldoc-echo-area-use-multiline-p) + +;; If the entire line cannot fit in the echo area, the symbol name may be +;; truncated or eliminated entirely from the output to make room for the +;; description. +(defun elisp--docstring-format-sym-doc (sym doc face) + (save-match-data + (let* ((name (symbol-name sym)) + (ea-multi eldoc-echo-area-use-multiline-p) + ;; Subtract 1 from window width since emacs will not write + ;; any chars to the last column, or in later versions, will + ;; cause a wraparound and resize of the echo area. + (ea-width (1- (window-width (minibuffer-window)))) + (strip (- (+ (length name) (length ": ") (length doc)) ea-width))) + (cond ((or (<= strip 0) + (eq ea-multi t) + (and ea-multi (> (length doc) ea-width))) + (format "%s: %s" (propertize name 'face face) doc)) + ((> (length doc) ea-width) + (substring (format "%s" doc) 0 ea-width)) + ((>= strip (length name)) + (format "%s" doc)) + (t + ;; Show the end of the partial symbol name, rather + ;; than the beginning, since the former is more likely + ;; to be unique given package namespace conventions. + (setq name (substring name strip)) + (format "%s: %s" (propertize name 'face face) doc)))))) + + +;; Return a list of current function name and argument index. +(defun elisp--fnsym-in-current-sexp () + (save-excursion + (let ((argument-index (1- (elisp--beginning-of-sexp)))) + ;; If we are at the beginning of function name, this will be -1. + (when (< argument-index 0) + (setq argument-index 0)) + ;; Don't do anything if current word is inside a string. + (if (= (or (char-after (1- (point))) 0) ?\") + nil + (list (elisp--current-symbol) argument-index))))) + +;; Move to the beginning of current sexp. Return the number of nested +;; sexp the point was over or after. +(defun elisp--beginning-of-sexp () + (let ((parse-sexp-ignore-comments t) + (num-skipped-sexps 0)) + (condition-case _ + (progn + ;; First account for the case the point is directly over a + ;; beginning of a nested sexp. + (condition-case _ + (let ((p (point))) + (forward-sexp -1) + (forward-sexp 1) + (when (< (point) p) + (setq num-skipped-sexps 1))) + (error)) + (while + (let ((p (point))) + (forward-sexp -1) + (when (< (point) p) + (setq num-skipped-sexps (1+ num-skipped-sexps)))))) + (error)) + num-skipped-sexps)) + +;; returns nil unless current word is an interned symbol. +(defun elisp--current-symbol () + (let ((c (char-after (point)))) + (and c + (memq (char-syntax c) '(?w ?_)) + (intern-soft (current-word))))) + +(defun elisp--function-argstring (arglist) + "Return ARGLIST as a string enclosed by (). +ARGLIST is either a string, or a list of strings or symbols." + (let ((str (cond ((stringp arglist) arglist) + ((not (listp arglist)) nil) + (t (format "%S" (help-make-usage 'toto arglist)))))) + (if (and str (string-match "\\`([^ )]+ ?" str)) + (replace-match "(" t t str) + str))) + +(provide 'elisp-mode) +;;; elisp-mode.el ends here diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 7d8dac48b98..b470352f8dc 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -28,6 +28,7 @@ (require 'ring) (require 'button) +(require 'xref) ;;;###autoload (defvar tags-file-name nil @@ -141,11 +142,8 @@ Otherwise, `find-tag-default' is used." :group 'etags :type '(choice (const nil) function)) -(defcustom find-tag-marker-ring-length 16 - "Length of marker rings `find-tag-marker-ring' and `tags-location-ring'." - :group 'etags - :type 'integer - :version "20.3") +(define-obsolete-variable-alias 'find-tag-marker-ring-length + 'xref-marker-ring-length "25.1") (defcustom tags-tag-face 'default "Face for tags in the output of `tags-apropos'." @@ -182,15 +180,18 @@ Example value: (sexp :tag "Tags to search"))) :version "21.1") -(defvar find-tag-marker-ring (make-ring find-tag-marker-ring-length) - "Ring of markers which are locations from which \\[find-tag] was invoked.") +(defvaralias 'find-tag-marker-ring 'xref--marker-ring) +(make-obsolete-variable + 'find-tag-marker-ring + "use `xref-push-marker-stack' or `xref-pop-marker-stack' instead." + "25.1") (defvar default-tags-table-function nil "If non-nil, a function to choose a default tags file for a buffer. This function receives no arguments and should return the default tags table file to use for the current buffer.") -(defvar tags-location-ring (make-ring find-tag-marker-ring-length) +(defvar tags-location-ring (make-ring xref-marker-ring-length) "Ring of markers which are locations visited by \\[find-tag]. Pop back to the last location with \\[negative-argument] \\[find-tag].") @@ -307,7 +308,7 @@ file the tag was in." (save-excursion (or (visit-tags-table-buffer file) (signal 'file-error (list "Visiting tags table" - "file does not exist" + "No such file or directory" file))) ;; Set FILE to the expanded name. (setq file tags-file-name))) @@ -713,15 +714,13 @@ Returns t if it visits a tags table, or nil if there are no more in the list." (interactive) ;; Clear out the markers we are throwing away. (let ((i 0)) - (while (< i find-tag-marker-ring-length) + (while (< i xref-marker-ring-length) (if (aref (cddr tags-location-ring) i) (set-marker (aref (cddr tags-location-ring) i) nil)) - (if (aref (cddr find-tag-marker-ring) i) - (set-marker (aref (cddr find-tag-marker-ring) i) nil)) (setq i (1+ i)))) + (xref-clear-marker-stack) (setq tags-file-name nil - tags-location-ring (make-ring find-tag-marker-ring-length) - find-tag-marker-ring (make-ring find-tag-marker-ring-length) + tags-location-ring (make-ring xref-marker-ring-length) tags-table-list nil tags-table-computed-list nil tags-table-computed-list-for nil @@ -780,6 +779,7 @@ tags table and its (recursively) included tags tables." (quit (message "Tags completion table construction aborted.") (setq tags-completion-table nil))))) +;;;###autoload (defun tags-lazy-completion-table () (let ((buf (current-buffer))) (lambda (string pred action) @@ -898,7 +898,7 @@ See documentation of variable `tags-file-name'." ;; Run the user's hook. Do we really want to do this for pop? (run-hooks 'local-find-tag-hook)))) ;; Record whence we came. - (ring-insert find-tag-marker-ring (point-marker)) + (xref-push-marker-stack) (if (and next-p last-tag) ;; Find the same table we last used. (visit-tags-table-buffer 'same) @@ -954,7 +954,6 @@ See documentation of variable `tags-file-name'." (switch-to-buffer buf) (error (pop-to-buffer buf))) (goto-char pos))) -;;;###autoload (define-key esc-map "." 'find-tag) ;;;###autoload (defun find-tag-other-window (tagname &optional next-p regexp-p) @@ -976,6 +975,7 @@ onto a ring and may be popped back to with \\[pop-tag-mark]. Contrast this with the ring of marks gone to by the command. See documentation of variable `tags-file-name'." + (declare (obsolete xref-find-definitions-other-window "25.1")) (interactive (find-tag-interactive "Find tag other window: ")) ;; This hair is to deal with the case where the tag is found in the @@ -995,7 +995,6 @@ See documentation of variable `tags-file-name'." ;; the window's point from the buffer. (set-window-point (selected-window) tagpoint)) window-point))) -;;;###autoload (define-key ctl-x-4-map "." 'find-tag-other-window) ;;;###autoload (defun find-tag-other-frame (tagname &optional next-p) @@ -1017,10 +1016,10 @@ onto a ring and may be popped back to with \\[pop-tag-mark]. Contrast this with the ring of marks gone to by the command. See documentation of variable `tags-file-name'." + (declare (obsolete xref-find-definitions-other-frame "25.1")) (interactive (find-tag-interactive "Find tag other frame: ")) (let ((pop-up-frames t)) (find-tag-other-window tagname next-p))) -;;;###autoload (define-key ctl-x-5-map "." 'find-tag-other-frame) ;;;###autoload (defun find-tag-regexp (regexp &optional next-p other-window) @@ -1040,29 +1039,15 @@ onto a ring and may be popped back to with \\[pop-tag-mark]. Contrast this with the ring of marks gone to by the command. See documentation of variable `tags-file-name'." + (declare (obsolete xref-find-apropos "25.1")) (interactive (find-tag-interactive "Find tag regexp: " t)) ;; We go through find-tag-other-window to do all the display hair there. (funcall (if other-window 'find-tag-other-window 'find-tag) regexp next-p t)) -;;;###autoload (define-key esc-map [?\C-.] 'find-tag-regexp) - -;;;###autoload (define-key esc-map "*" 'pop-tag-mark) ;;;###autoload -(defun pop-tag-mark () - "Pop back to where \\[find-tag] was last invoked. +(defalias 'pop-tag-mark 'xref-pop-marker-stack) -This is distinct from invoking \\[find-tag] with a negative argument -since that pops a stack of markers at which tags were found, not from -where they were found." - (interactive) - (if (ring-empty-p find-tag-marker-ring) - (error "No previous locations for find-tag invocation")) - (let ((marker (ring-remove find-tag-marker-ring 0))) - (switch-to-buffer (or (marker-buffer marker) - (error "The marked buffer has been deleted"))) - (goto-char (marker-position marker)) - (set-marker marker nil nil))) (defvar tag-lines-already-matched nil "Matches remembered between calls.") ; Doc string: calls to what? @@ -1804,6 +1789,7 @@ Two variables control the processing we do on each file: the value of interesting (it returns non-nil if so) and `tags-loop-operate' is a form to evaluate to operate on an interesting file. If the latter evaluates to nil, we exit; otherwise we scan the next file." + (declare (obsolete "use `xref-find-definitions' interface instead." "25.1")) (interactive) (let (new ;; Non-nil means we have finished one file @@ -1859,7 +1845,6 @@ nil, we exit; otherwise we scan the next file." (and messaged (null tags-loop-operate) (message "Scanning file %s...found" buffer-file-name)))) -;;;###autoload (define-key esc-map "," 'tags-loop-continue) ;;;###autoload (defun tags-search (regexp &optional file-list-form) @@ -1948,6 +1933,7 @@ directory specification." ;;;###autoload (defun tags-apropos (regexp) "Display list of all tags in tags table REGEXP matches." + (declare (obsolete xref-find-apropos "25.1")) (interactive "sTags apropos (regexp): ") (with-output-to-temp-buffer "*Tags List*" (princ "Click mouse-2 to follow tags.\n\nTags matching regexp `") @@ -2077,6 +2063,72 @@ for \\[find-tag] (which see)." (completion-in-region (car comp-data) (cadr comp-data) (nth 2 comp-data) (plist-get (nthcdr 3 comp-data) :predicate))))) + + +;;; Xref backend + +;; Stop searching if we find more than xref-limit matches, as the xref +;; infrastructure is not designed to handle very long lists. +;; Switching to some kind of lazy list might be better, but hopefully +;; we hit the limit rarely. +(defconst etags--xref-limit 1000) + +;;;###autoload +(defun etags-xref-find (action id) + (pcase action + (`definitions (etags--xref-find-definitions id)) + (`apropos (etags--xref-find-definitions id t)))) + +(defun etags--xref-find-definitions (pattern &optional regexp?) + ;; This emulates the behaviour of `find-tag-in-order' but instead of + ;; returning one match at a time all matches are returned as list. + ;; NOTE: find-tag-tag-order is typically a buffer-local variable. + (let* ((xrefs '()) + (first-time t) + (search-fun (if regexp? #'re-search-forward #'search-forward)) + (marks (make-hash-table :test 'equal)) + (case-fold-search (if (memq tags-case-fold-search '(nil t)) + tags-case-fold-search + case-fold-search))) + (save-excursion + (while (visit-tags-table-buffer (not first-time)) + (setq first-time nil) + (dolist (order-fun (cond (regexp? find-tag-regexp-tag-order) + (t find-tag-tag-order))) + (goto-char (point-min)) + (while (and (funcall search-fun pattern nil t) + (< (hash-table-count marks) etags--xref-limit)) + (when (funcall order-fun pattern) + (beginning-of-line) + (pcase-let* ((tag-info (etags-snarf-tag)) + (`(,hint ,line . _) tag-info)) + (unless (eq hint t) ; hint==t if we are in a filename line + (let* ((file (file-of-tag)) + (mark-key (cons file line))) + (unless (gethash mark-key marks) + (let ((loc (xref-make-etags-location + tag-info (expand-file-name file)))) + (push (xref-make hint loc) xrefs) + (puthash mark-key t marks))))))))))) + (nreverse xrefs))) + +(defclass xref-etags-location (xref-location) + ((tag-info :type list :initarg :tag-info) + (file :type string :initarg :file + :reader xref-location-group)) + :documentation "Location of an etags tag.") + +(defun xref-make-etags-location (tag-info file) + (make-instance 'xref-etags-location :tag-info tag-info + :file (expand-file-name file))) + +(cl-defmethod xref-location-marker ((l xref-etags-location)) + (with-slots (tag-info file) l + (let ((buffer (find-file-noselect file))) + (with-current-buffer buffer + (etags-goto-tag-location tag-info) + (point-marker))))) + (provide 'etags) diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index 592f24dd2f8..aeb4ddee9ef 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -830,7 +830,7 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") (font-lock-mode 1) (setq font-lock-keywords (symbol-value (intern-soft (format "f90-font-lock-keywords-%d" n)))) - (font-lock-fontify-buffer)) + (font-lock-flush)) (defun f90-font-lock-1 () "Set `font-lock-keywords' to `f90-font-lock-keywords-1'." diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index d4caf48e089..048fa1180a9 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -1,4 +1,4 @@ -;;; grep.el --- run `grep' and display the results +;;; grep.el --- run `grep' and display the results -*- lexical-binding:t -*- ;; Copyright (C) 1985-1987, 1993-1999, 2001-2015 Free Software ;; Foundation, Inc. @@ -77,11 +77,10 @@ in grep buffers, so if you have globally disabled font-lock-mode, you will not get highlighting. This option sets the environment variable GREP_COLORS to specify -markers for highlighting and GREP_OPTIONS to add the --color -option in front of any explicit grep options before starting -the grep. +markers for highlighting and adds the --color option in front of +any explicit grep options before starting the grep. -When this option is `auto', grep uses `--color=auto' to highlight +When this option is `auto', grep uses `--color' to highlight matches only when it outputs to a terminal (when `grep' is the last command in the pipe), thus avoiding the use of any potentially-harmful escape sequences when standard output goes to a file or pipe. @@ -97,7 +96,7 @@ To change the default value, use Customize or call the function :type '(choice (const :tag "Do not highlight matches with grep markers" nil) (const :tag "Highlight matches with grep markers" t) (const :tag "Use --color=always" always) - (const :tag "Use --color=auto" auto) + (const :tag "Use --color" auto) (other :tag "Not Set" auto-detect)) :set 'grep-apply-setting :version "22.1" @@ -345,16 +344,11 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies ;;;###autoload (defconst grep-regexp-alist '( - ;; Rule to match column numbers is commented out since no known grep - ;; produces them - ;; ("^\\(.+?\\)\\(:[ \t]*\\)\\([1-9][0-9]*\\)\\2\\(?:\\([1-9][0-9]*\\)\\(?:-\\([1-9][0-9]*\\)\\)?\\2\\)?" - ;; 1 3 (4 . 5)) - ;; Note that we want to use as tight a regexp as we can to try and - ;; handle weird file names (with colons in them) as well as possible. - ;; E.g. we use [1-9][0-9]* rather than [0-9]+ so as to accept ":034:" - ;; in file names. - ("^\\(.+?\\)\\(:[ \t]*\\)\\([1-9][0-9]*\\)\\2" - 1 3 + ;; Use a tight regexp to handle weird file names (with colons + ;; in them) as well as possible. E.g., use [1-9][0-9]* rather + ;; than [0-9]+ so as to accept ":034:" in file names. + ("^\\(.*?[^/\n]\\):[ \t]*\\([1-9][0-9]*\\)[ \t]*:" + 1 2 ;; Calculate column positions (col . end-col) of first grep match on a line ((lambda () (when grep-highlight-matches @@ -467,10 +461,6 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'." ;; `setenv' modifies `process-environment' let-bound in `compilation-start' ;; Any TERM except "dumb" allows GNU grep to use `--color=auto' (setenv "TERM" "emacs-grep") - (setenv "GREP_OPTIONS" - (concat (getenv "GREP_OPTIONS") - " --color=" (if (eq grep-highlight-matches 'always) - "always" "auto"))) ;; GREP_COLOR is used in GNU grep 2.5.1, but deprecated in later versions (setenv "GREP_COLOR" "01;31") ;; GREP_COLORS is used in GNU grep 2.5.2 and later versions @@ -567,10 +557,28 @@ This function is called from `compilation-filter-hook'." (looking-at (concat (regexp-quote hello-file) ":[0-9]+:English"))))))))) + + (when (eq grep-highlight-matches 'auto-detect) + (setq grep-highlight-matches + (with-temp-buffer + (and (grep-probe grep-program '(nil t nil "--help")) + (progn + (goto-char (point-min)) + (search-forward "--color" nil t)) + ;; Windows and DOS pipes fail `isatty' detection in Grep. + (if (memq system-type '(windows-nt ms-dos)) + 'always 'auto))))) + (unless (and grep-command grep-find-command grep-template grep-find-template) (let ((grep-options - (concat (if grep-use-null-device "-n" "-nH") + (concat (and grep-highlight-matches + (grep-probe grep-program + `(nil nil nil "--color" "x" ,null-device) + nil 1) + (if (eq grep-highlight-matches 'always) + "--color=always " "--color ")) + (if grep-use-null-device "-n" "-nH") (if (grep-probe grep-program `(nil nil nil "-e" "foo" ,null-device) nil 1) @@ -637,16 +645,6 @@ This function is called from `compilation-filter-hook'." (t (format "%s . <X> -type f <F> -print | \"%s\" %s" find-program xargs-program gcmd)))))))) - (when (eq grep-highlight-matches 'auto-detect) - (setq grep-highlight-matches - (with-temp-buffer - (and (grep-probe grep-program '(nil t nil "--help")) - (progn - (goto-char (point-min)) - (search-forward "--color" nil t)) - ;; Windows and DOS pipes fail `isatty' detection in Grep. - (if (memq system-type '(windows-nt ms-dos)) - 'always 'auto))))) ;; Save defaults for this host. (setq grep-host-defaults-alist @@ -805,16 +803,20 @@ substitution string. Note dynamic scoping of variables.") (defun grep-expand-template (template &optional regexp files dir excl) "Patch grep COMMAND string replacing <C>, <D>, <F>, <R>, and <X>." - (let ((command template) - (cf case-fold-search) - (case-fold-search nil)) + (let* ((command template) + (env `((cf . ,case-fold-search) + (excl . ,excl) + (dir . ,dir) + (files . ,files) + (regexp . ,regexp))) + (case-fold-search nil)) (dolist (kw grep-expand-keywords command) (if (string-match (car kw) command) (setq command (replace-match (or (if (symbolp (cdr kw)) - (symbol-value (cdr kw)) - (save-match-data (eval (cdr kw)))) + (eval (cdr kw) env) + (save-match-data (eval (cdr kw) env))) "") t t command)))))) @@ -901,7 +903,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (confirm (equal current-prefix-arg '(4)))) (list regexp files dir confirm)))))) (when (and (stringp regexp) (> (length regexp) 0)) - (unless (and dir (file-directory-p dir) (file-readable-p dir)) + (unless (and dir (file-accessible-directory-p dir)) (setq dir default-directory)) (let ((command regexp)) (if (null files) @@ -982,7 +984,7 @@ to specify a command to run." (confirm (equal current-prefix-arg '(4)))) (list regexp files dir confirm)))))) (when (and (stringp regexp) (> (length regexp) 0)) - (unless (and dir (file-directory-p dir) (file-readable-p dir)) + (unless (and dir (file-accessible-directory-p dir)) (setq dir default-directory)) (if (null files) (if (not (string= regexp (if (consp grep-find-command) @@ -1055,7 +1057,7 @@ to specify a command to run." (setq default-directory dir))))))) ;;;###autoload -(defun zrgrep (regexp &optional files dir confirm grep-find-template) +(defun zrgrep (regexp &optional files dir confirm template) "Recursively grep for REGEXP in gzipped FILES in tree rooted at DIR. Like `rgrep' but uses `zgrep' for `grep-program', sets the default file name to `*.gz', and sets `grep-highlight-matches' to `always'." @@ -1090,10 +1092,8 @@ file name to `*.gz', and sets `grep-highlight-matches' to `always'." (list regexp files dir confirm grep-find-template))))))) ;; Set `grep-highlight-matches' to `always' ;; since `zgrep' puts filters in the grep output. - (let ((grep-highlight-matches 'always)) - ;; `rgrep' uses the dynamically bound value `grep-find-template' - ;; from the argument `grep-find-template' whose value is computed - ;; in the `interactive' spec. + (let ((grep-find-template template) + (grep-highlight-matches 'always)) (rgrep regexp files dir confirm))) ;;;###autoload diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index e2d996fa13f..42c5b20a7b8 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -34,7 +34,8 @@ ;; and added a menu. Brian D. Carlstrom <bdc@ai.mit.edu> combined the IRIX ;; kluge with the gud-xdb-directories hack producing gud-dbx-directories. ;; Derek L. Davies <ddavies@world.std.com> added support for jdb (Java -;; debugger.) +;; debugger.) Jan Nieuwenhuizen added support for the Guile REPL (Guile +;; debugger). ;;; Code: @@ -140,7 +141,7 @@ Used to gray out relevant toolbar icons.") (display-graphic-p) (fboundp 'x-show-tip)) :visible (memq gud-minor-mode - '(gdbmi dbx sdb xdb pdb)) + '(gdbmi guiler dbx sdb xdb pdb)) :button (:toggle . gud-tooltip-mode)) ([refresh] "Refresh" . gud-refresh) ([run] menu-item "Run" gud-run @@ -170,11 +171,11 @@ Used to gray out relevant toolbar icons.") ([up] menu-item "Up Stack" gud-up :enable (not gud-running) :visible (memq gud-minor-mode - '(gdbmi gdb dbx xdb jdb pdb))) + '(gdbmi gdb guiler dbx xdb jdb pdb))) ([down] menu-item "Down Stack" gud-down :enable (not gud-running) :visible (memq gud-minor-mode - '(gdbmi gdb dbx xdb jdb pdb))) + '(gdbmi gdb guiler dbx xdb jdb pdb))) ([pp] menu-item "Print S-expression" gud-pp :enable (and (not gud-running) (bound-and-true-p gdb-active-process)) @@ -195,7 +196,7 @@ Used to gray out relevant toolbar icons.") ([finish] menu-item "Finish Function" gud-finish :enable (not gud-running) :visible (memq gud-minor-mode - '(gdbmi gdb xdb jdb pdb))) + '(gdbmi gdb guiler xdb jdb pdb))) ([stepi] menu-item "Step Instruction" gud-stepi :enable (not gud-running) :visible (memq gud-minor-mode '(gdbmi gdb dbx))) @@ -255,9 +256,8 @@ Used to gray out relevant toolbar icons.") ([menu-bar file] . undefined)))) "Map used in visited files.") -(let ((m (assq 'gud-minor-mode minor-mode-map-alist))) - (if m (setcdr m gud-minor-mode-map) - (push (cons 'gud-minor-mode gud-minor-mode-map) minor-mode-map-alist))) +(setf (alist-get 'gud-minor-mode minor-mode-map-alist) + gud-minor-mode-map) (defvar gud-mode-map ;; Will inherit from comint-mode via define-derived-mode. @@ -803,8 +803,7 @@ directory and source-file directory for your debugger." "Completion table for GDB commands. COMMAND is the prefix for which we seek completion. CONTEXT is the text before COMMAND on the line." - (let* ((start (- (point) (field-beginning))) - (complete-list + (let* ((complete-list (gud-gdb-run-command-fetch-lines (concat "complete " context command) (current-buffer) ;; From string-match above. @@ -1699,6 +1698,83 @@ and source-file directory for your debugger." (run-hooks 'pdb-mode-hook)) ;; ====================================================================== +;; Guile REPL (guiler) functions + +;; History of argument lists passed to guiler. +(defvar gud-guiler-history nil) + +(defvar gud-guiler-lastfile nil) + +(defun gud-guiler-marker-filter (string) + (setq gud-marker-acc (if gud-marker-acc (concat gud-marker-acc string) string)) + + (let ((start 0)) + (while + (cond + ((string-match "^In \\(.*\\):" gud-marker-acc start) + (setq gud-guiler-lastfile (match-string 1 gud-marker-acc))) + ((string-match "^\\([^:\n]+\\):\\([0-9]+\\):\\([0-9]+\\):[^\n]*" + gud-marker-acc start) + (setq gud-guiler-lastfile (match-string 1 gud-marker-acc)) + (setq gud-last-frame + (cons gud-guiler-lastfile + (string-to-number (match-string 2 gud-marker-acc))))) + ((string-match "^[ ]*\\([0-9]+\\):\\([0-9]+\\) [^\n]*" + gud-marker-acc start) + (if gud-guiler-lastfile + (setq gud-last-frame + (cons gud-guiler-lastfile + (string-to-number (match-string 1 gud-marker-acc)))))) + ((string-match comint-prompt-regexp gud-marker-acc start) t) + ((string= (substring gud-marker-acc start) "") nil) + (t nil)) + (setq start (match-end 0))) + + ;; Search for the last incomplete line in this chunk + (while (string-match "\n" gud-marker-acc start) + (setq start (match-end 0))) + + ;; If we have an incomplete line, store it in gud-marker-acc. + (setq gud-marker-acc (substring gud-marker-acc (or start 0)))) + string) + + +(defcustom gud-guiler-command-name "guile" + "File name for executing the Guile debugger. +This should be an executable on your path, or an absolute file name." + :type 'string + :group 'gud) + +;;;###autoload +(defun guiler (command-line) + "Run guiler on program FILE in buffer `*gud-FILE*'. +The directory containing FILE becomes the initial working directory +and source-file directory for your debugger." + (interactive + (list (gud-query-cmdline 'guiler))) + + (gud-common-init command-line nil 'gud-guiler-marker-filter) + (setq-local gud-minor-mode 'guiler) + +;; FIXME: absolute file-names are not grokked yet by Guile's ,break-at-source +;; and relative file names only when relative to %load-path. +;; (gud-def gud-break ",break-at-source %d%f %l" "\C-b" "Set breakpoint at current line.") + (gud-def gud-break ",break-at-source %f %l" "\C-b" "Set breakpoint at current line.") +;; FIXME: remove breakpoint with file-line not yet supported by Guile +;; (gud-def gud-remove ",delete ---> %d%f:%l" "\C-d" "Remove breakpoint at current line") + (gud-def gud-step ",step" "\C-s" "Step one source line with display.") + (gud-def gud-next ",next" "\C-n" "Step one line (skip functions).") +;; (gud-def gud-cont "continue" "\C-r" "Continue with display.") + (gud-def gud-finish ",finish" "\C-f" "Finish executing current function.") + (gud-def gud-up ",up" "<" "Up one stack frame.") + (gud-def gud-down ",down" ">" "Down one stack frame.") + (gud-def gud-print "%e" "\C-p" "Evaluate Guile expression at point.") + + (setq comint-prompt-regexp "^scheme@([^>]+> ") + (setq paragraph-start comint-prompt-regexp) + (run-hooks 'guiler-mode-hook)) + +;; ====================================================================== ;; ;; JDB support. ;; @@ -3445,6 +3521,7 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference." "Return a suitable command to print the expression EXPR." (pcase gud-minor-mode (`gdbmi (concat "-data-evaluate-expression \"" expr "\"")) + (`guiler expr) (`dbx (concat "print " expr)) ((or `xdb `pdb) (concat "p " expr)) (`sdb (concat expr "/")))) diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index e582569a024..7f2fd9274f7 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -1,10 +1,10 @@ -;;; hideif.el --- hides selected code within ifdef +;;; hideif.el --- hides selected code within ifdef -*- lexical-binding:t -*- ;; Copyright (C) 1988, 1994, 2001-2015 Free Software Foundation, Inc. ;; Author: Brian Marick ;; Daniel LaLiberte <liberte@holonexus.org> -;; Maintainer: emacs-devel@gnu.org +;; Maintainer: Luke Lee <luke.yx.lee@gmail.com> ;; Keywords: c, outlines ;; This file is part of GNU Emacs. @@ -36,6 +36,8 @@ ;; ;; Hide-ifdef suppresses the display of code that the preprocessor wouldn't ;; pass through. Support complete C/C++ expression and precedence. +;; It will automatically scan for new #define symbols and macros on the way +;; parsing. ;; ;; The hidden code is marked by ellipses (...). Be ;; cautious when editing near ellipses, since the hidden text is @@ -97,11 +99,12 @@ ;; Extensively modified by Daniel LaLiberte (while at Gould). ;; ;; Extensively modified by Luke Lee in 2013 to support complete C expression -;; evaluation. +;; evaluation and argumented macro expansion. ;;; Code: (require 'cc-mode) +(require 'cl-lib) (defgroup hide-ifdef nil "Hide selected code within `ifdef'." @@ -133,6 +136,40 @@ :group 'hide-ifdef :version "23.1") +(defcustom hide-ifdef-exclude-define-regexp nil + "Ignore #define names if those names match this exclusion pattern." + :type 'string + :version "25.1") + +(defcustom hide-ifdef-expand-reinclusion-protection t + "Non-nil means don't hide an entire header file enclosed by #ifndef...#endif. +Most C/C++ headers are usually wrapped with ifdefs to prevent re-inclusion: + + ----- beginning of file ----- + #ifndef _XXX_HEADER_FILE_INCLUDED_ + #define _XXX_HEADER_FILE_INCLUDED_ + xxx + xxx + xxx... + #endif + ----- end of file ----- + +The first time we visit such a file, _XXX_HEADER_FILE_INCLUDED_ is +undefined, and so nothing is hidden. The next time we visit it, everything will +be hidden. + +This behavior is generally undesirable. If this option is non-nil, the outermost +#if is always visible." + :type 'boolean + :version "25.1") + +(defcustom hide-ifdef-header-regexp + "\\.h\\(h\\|xx\\|pp\\)?\\'" + "C/C++ header file name patterns to determine if current buffer is a header. +Effective only if `hide-ifdef-expand-reinclusion-protection' is t." + :type 'string + :group 'hide-ifdef + :version "25.1") (defvar hide-ifdef-mode-submap ;; Set up the submap that goes after the prefix key. @@ -146,6 +183,8 @@ (define-key map "s" 'show-ifdefs) (define-key map "\C-d" 'hide-ifdef-block) (define-key map "\C-s" 'show-ifdef-block) + (define-key map "e" 'hif-evaluate-macro) + (define-key map "C" 'hif-clear-all-ifdef-defined) (define-key map "\C-q" 'hide-ifdef-toggle-read-only) (define-key map "\C-w" 'hide-ifdef-toggle-shadowing) @@ -201,7 +240,7 @@ (cons '(hide-ifdef-hiding " Hiding") minor-mode-alist))) -;; fix c-mode syntax table so we can recognize whole symbols. +;; Fix c-mode syntax table so we can recognize whole symbols. (defvar hide-ifdef-syntax-table (let ((st (copy-syntax-table c-mode-syntax-table))) (modify-syntax-entry ?_ "w" st) @@ -213,6 +252,11 @@ (defvar hide-ifdef-env nil "An alist of defined symbols and their values.") +(defvar hide-ifdef-env-backup nil + "This variable is a backup of the previously cleared `hide-ifdef-env'. +This backup prevents any accidental clearance of `hide-fidef-env' by +`hif-clear-all-ifdef-defined'.") + (defvar hif-outside-read-only nil "Internal variable. Saves the value of `buffer-read-only' while hiding.") @@ -229,53 +273,75 @@ that the C preprocessor would eliminate may be hidden from view. Several variables affect how the hiding is done: `hide-ifdef-env' - An association list of defined and undefined symbols for the - current buffer. Initially, the global value of `hide-ifdef-env' - is used. + An association list of defined and undefined symbols for the + current project. Initially, the global value of `hide-ifdef-env' + is used. This variable was a buffer-local variable, which limits + hideif to parse only one C/C++ file at a time. We've extended + hideif to support parsing a C/C++ project containing multiple C/C++ + source files opened simultaneously in different buffers. Therefore + `hide-ifdef-env' can no longer be buffer local but must be global. `hide-ifdef-define-alist' - An association list of defined symbol lists. + An association list of defined symbol lists. Use `hide-ifdef-set-define-alist' to save the current `hide-ifdef-env' and `hide-ifdef-use-define-alist' to set the current `hide-ifdef-env' from one of the lists in `hide-ifdef-define-alist'. `hide-ifdef-lines' - Set to non-nil to not show #if, #ifdef, #ifndef, #else, and - #endif lines when hiding. + Set to non-nil to not show #if, #ifdef, #ifndef, #else, and + #endif lines when hiding. `hide-ifdef-initially' - Indicates whether `hide-ifdefs' should be called when Hide-Ifdef mode - is activated. + Indicates whether `hide-ifdefs' should be called when Hide-Ifdef mode + is activated. `hide-ifdef-read-only' - Set to non-nil if you want to make buffers read only while hiding. - After `show-ifdefs', read-only status is restored to previous value. + Set to non-nil if you want to make buffers read only while hiding. + After `show-ifdefs', read-only status is restored to previous value. \\{hide-ifdef-mode-map}" :group 'hide-ifdef :lighter " Ifdef" (if hide-ifdef-mode (progn - ;; inherit global values - (set (make-local-variable 'hide-ifdef-env) - (default-value 'hide-ifdef-env)) - (set (make-local-variable 'hide-ifdef-hiding) - (default-value 'hide-ifdef-hiding)) - (set (make-local-variable 'hif-outside-read-only) buffer-read-only) - (set (make-local-variable 'line-move-ignore-invisible) t) - (add-hook 'change-major-mode-hook - (lambda () (hide-ifdef-mode -1)) nil t) - - (add-to-invisibility-spec '(hide-ifdef . t)) - - (if hide-ifdef-initially - (hide-ifdefs) - (show-ifdefs))) + ;; inherit global values + + ;; `hide-ifdef-env' is now a global variable. + ;; We can still simulate the behavior of older hideif versions (i.e. + ;; `hide-ifdef-env' being buffer local) by clearing this variable + ;; (C-c @ C) everytime before hiding current buffer. +;; (set (make-local-variable 'hide-ifdef-env) +;; (default-value 'hide-ifdef-env)) + (set 'hide-ifdef-env (default-value 'hide-ifdef-env)) + ;; Some C/C++ headers might have other ways to prevent reinclusion and + ;; thus would like `hide-ifdef-expand-reinclusion-protection' to be nil. + (set (make-local-variable 'hide-ifdef-expand-reinclusion-protection) + (default-value 'hide-ifdef-expand-reinclusion-protection)) + (set (make-local-variable 'hide-ifdef-hiding) + (default-value 'hide-ifdef-hiding)) + (set (make-local-variable 'hif-outside-read-only) buffer-read-only) + (set (make-local-variable 'line-move-ignore-invisible) t) + (add-hook 'change-major-mode-hook + (lambda () (hide-ifdef-mode -1)) nil t) + + (add-to-invisibility-spec '(hide-ifdef . t)) + + (if hide-ifdef-initially + (hide-ifdefs) + (show-ifdefs))) ;; else end hide-ifdef-mode (kill-local-variable 'line-move-ignore-invisible) (remove-from-invisibility-spec '(hide-ifdef . t)) (when hide-ifdef-hiding (show-ifdefs)))) +(defun hif-clear-all-ifdef-defined () + "Clears all symbols defined in `hide-ifdef-env'. +It will backup this variable to `hide-ifdef-env-backup' before clearing to +prevent accidental clearance." + (interactive) + (when (y-or-n-p "Clear all #defined symbols? ") + (setq hide-ifdef-env-backup hide-ifdef-env) + (setq hide-ifdef-env nil))) (defun hif-show-all () "Show all of the text in the current buffer." @@ -295,16 +361,64 @@ Several variables affect how the hiding is done: (while (= (logand 1 (skip-chars-backward "\\\\")) 1) (end-of-line 2))) +(defun hif-merge-ifdef-region (start end) + "This function merges nearby ifdef regions to form a bigger overlay. +The region is defined by START and END. This will decrease the number of +overlays created." + ;; Generally there is no need to call itself recursively since there should + ;; originally exists no un-merged regions; however, if a part of the file is + ;; hidden with `hide-ifdef-lines' equals to nil while another part with 't, + ;; this case happens. + ;; TODO: Should we merge? or just create a container overlay? -- this can + ;; prevent `hideif-show-ifdef' expanding too many hidden contents since there + ;; is only a big overlay exists there without any smaller overlays. + (save-restriction + (widen) ; Otherwise `point-min' and `point-max' will be restricted and thus + ; fail to find neighbor overlays + (let ((begovrs (overlays-in + (max (- start 2) (point-min)) + (max (- start 1) (point-min)))) + (endovrs (overlays-in + (min (+ end 1) (point-max)) + (min (+ end 2) (point-max)))) + (ob nil) + (oe nil) + b e) + ;; Merge overlays before START + (dolist (o begovrs) + (when (overlay-get o 'hide-ifdef) + (setq b (min start (overlay-start o)) + e (max end (overlay-end o))) + (move-overlay o b e) + (hif-merge-ifdef-region b e) + (setq ob o))) + ;; Merge overlays after END + (dolist (o endovrs) + (when (overlay-get o 'hide-ifdef) + (setq b (min start (overlay-start o)) + e (max end (overlay-end o))) + (move-overlay o b e) + (hif-merge-ifdef-region b e) + (setf oe o))) + ;; If both START and END merging happens, merge into bigger one + (when (and ob oe) + (let ((b (min (overlay-start ob) (overlay-start oe))) + (e (max (overlay-end ob) (overlay-end oe)))) + (delete-overlay oe) + (move-overlay ob b e) + (hif-merge-ifdef-region b e))) + (or ob oe)))) + (defun hide-ifdef-region-internal (start end) - (remove-overlays start end 'hide-ifdef t) + (unless (hif-merge-ifdef-region start end) (let ((o (make-overlay start end))) (overlay-put o 'hide-ifdef t) (if hide-ifdef-shadow - (overlay-put o 'face 'hide-ifdef-shadow) - (overlay-put o 'invisible 'hide-ifdef)))) + (overlay-put o 'face 'hide-ifdef-shadow) + (overlay-put o 'invisible 'hide-ifdef))))) (defun hide-ifdef-region (start end) - "START is the start of a #if or #else form. END is the ending part. + "START is the start of a #if, #elif, or #else form. END is the ending part. Everything including these lines is made invisible." (save-excursion (goto-char start) (hif-end-of-line) (setq start (point)) @@ -313,7 +427,9 @@ Everything including these lines is made invisible." (defun hif-show-ifdef-region (start end) "Everything between START and END is made visible." - (remove-overlays start end 'hide-ifdef t)) + (let ((onum (length (overlays-in start end)))) + (remove-overlays start end 'hide-ifdef t) + (/= onum (length (overlays-in start end))))) ;;===%%SF%% evaluation (Start) === @@ -330,7 +446,7 @@ that form should be displayed.") (defun hif-set-var (var value) - "Prepend (var value) pair to `hide-ifdef-env'." + "Prepend (VAR VALUE) pair to `hide-ifdef-env'." (setq hide-ifdef-env (cons (cons var value) hide-ifdef-env))) (declare-function semantic-c-hideif-lookup "semantic/bovine/c" (var)) @@ -338,11 +454,11 @@ that form should be displayed.") (defun hif-lookup (var) (or (when (bound-and-true-p semantic-c-takeover-hideif) - (semantic-c-hideif-lookup var)) + (semantic-c-hideif-lookup var)) (let ((val (assoc var hide-ifdef-env))) - (if val - (cdr val) - hif-undefined-symbol)))) + (if val + (cdr val) + hif-undefined-symbol)))) (defun hif-defined (var) (cond @@ -358,25 +474,43 @@ that form should be displayed.") ;;===%%SF%% parsing (Start) === ;;; The code that understands what ifs and ifdef in files look like. -(defconst hif-cpp-prefix "\\(^\\|\r\\)[ \t]*#[ \t]*") -(defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef")) -(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\(n?def\\)?[ \t]+")) -(defconst hif-else-regexp (concat hif-cpp-prefix "else")) -(defconst hif-endif-regexp (concat hif-cpp-prefix "endif")) +(defconst hif-cpp-prefix "\\(^\\|\r\\)[ \t]*#[ \t]*") +(defconst hif-ifxdef-regexp (concat hif-cpp-prefix "if\\(n\\)?def")) +(defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef")) +(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\(n?def\\)?[ \t]+")) +(defconst hif-elif-regexp (concat hif-cpp-prefix "elif")) +(defconst hif-else-regexp (concat hif-cpp-prefix "else")) +(defconst hif-endif-regexp (concat hif-cpp-prefix "endif")) (defconst hif-ifx-else-endif-regexp - (concat hif-ifx-regexp "\\|" hif-else-regexp "\\|" hif-endif-regexp)) - -;; Used to store the current token and the whole token list during parsing. -;; Only bound dynamically. + (concat hif-ifx-regexp "\\|" hif-elif-regexp "\\|" hif-else-regexp "\\|" + hif-endif-regexp)) +(defconst hif-macro-expr-prefix-regexp + (concat hif-cpp-prefix "\\(if\\(n?def\\)?\\|elif\\|define\\)[ \t]+")) + +(defconst hif-white-regexp "[ \t]*") +(defconst hif-define-regexp (concat hif-cpp-prefix "\\(define\\|undef\\)")) +(defconst hif-id-regexp (concat "[[:alpha:]_][[:alnum:]_]*")) +(defconst hif-macroref-regexp + (concat hif-white-regexp "\\(" hif-id-regexp "\\)" hif-white-regexp + "\\(" + "(" hif-white-regexp + "\\(" hif-id-regexp "\\)?" hif-white-regexp + "\\(" "," hif-white-regexp hif-id-regexp hif-white-regexp "\\)*" + "\\(\\.\\.\\.\\)?" hif-white-regexp + ")" + "\\)?" )) + +;; Store the current token and the whole token list during parsing. +;; Bound dynamically. (defvar hif-token) (defvar hif-token-list) (defconst hif-token-alist '(("||" . hif-or) ("&&" . hif-and) - ("|" . hif-logior) + ("|" . hif-logior) ("^" . hif-logxor) - ("&" . hif-logand) + ("&" . hif-logand) ("<<" . hif-shiftleft) (">>" . hif-shiftright) ("==" . hif-equal) @@ -384,23 +518,28 @@ that form should be displayed.") ;; expression syntax, because they are still relevant for the tokenizer, ;; especially in conjunction with ##. ("=" . hif-assign) - ("!=" . hif-notequal) + ("!=" . hif-notequal) ("##" . hif-token-concat) ("!" . hif-not) ("~" . hif-lognot) ("(" . hif-lparen) (")" . hif-rparen) - (">" . hif-greater) - ("<" . hif-less) - (">=" . hif-greater-equal) - ("<=" . hif-less-equal) - ("+" . hif-plus) - ("-" . hif-minus) + (">" . hif-greater) + ("<" . hif-less) + (">=" . hif-greater-equal) + ("<=" . hif-less-equal) + ("+" . hif-plus) + ("-" . hif-minus) ("*" . hif-multiply) ("/" . hif-divide) ("%" . hif-modulo) - ("?" . hif-conditional) - (":" . hif-colon))) + ("?" . hif-conditional) + (":" . hif-colon) + ("," . hif-comma) + ("#" . hif-stringify) + ("..." . hif-etc))) + +(defconst hif-valid-token-list (mapcar 'cdr hif-token-alist)) (defconst hif-token-regexp (concat (regexp-opt (mapcar 'car hif-token-alist)) @@ -410,47 +549,71 @@ that form should be displayed.") (defconst hif-string-literal-regexp "\\(\"\\(?:[^\"\\]\\|\\\\.\\)*\"\\)") +(defun hif-string-to-number (string &optional base) + "Like `string-to-number', but it understands non-decimal floats." + (if (or (not base) (= base 10)) + (string-to-number string base) + (let* ((parts (split-string string "\\." t "[ \t]+")) + (frac (cadr parts)) + (fraclen (length frac)) + (quot (expt (if (zerop fraclen) + base + (* base 1.0)) fraclen))) + (/ (string-to-number (concat (car parts) frac) base) quot)))) + +;; The dynamic binding variable `hif-simple-token-only' is shared only by +;; `hif-tokenize' and `hif-find-define'. The purpose is to prevent `hif-tokenize' +;; from returning one more value to indicate a simple token is scanned. This help +;; speeding up macro evaluation on those very simple cases like integers or +;; literals. +;; Check the long comments before `hif-find-define' for more details. [lukelee] +(defvar hif-simple-token-only) (defun hif-tokenize (start end) "Separate string between START and END into a list of tokens." (let ((token-list nil)) + (setq hif-simple-token-only t) (with-syntax-table hide-ifdef-syntax-table (save-excursion - (goto-char start) - (while (progn (forward-comment (point-max)) (< (point) end)) - ;; (message "expr-start = %d" expr-start) (sit-for 1) - (cond - ((looking-at "\\\\\n") - (forward-char 2)) + (goto-char start) + (while (progn (forward-comment (point-max)) (< (point) end)) + ;; (message "expr-start = %d" expr-start) (sit-for 1) + (cond + ((looking-at "\\\\\n") + (forward-char 2)) ((looking-at hif-string-literal-regexp) (push (substring-no-properties (match-string 1)) token-list) (goto-char (match-end 0))) - ((looking-at hif-token-regexp) - (let ((token (buffer-substring (point) (match-end 0)))) - (goto-char (match-end 0)) - ;; (message "token: %s" token) (sit-for 1) - (push + + ((looking-at hif-token-regexp) + (let ((token (buffer-substring-no-properties + (point) (match-end 0)))) + (goto-char (match-end 0)) + ;; (message "token: %s" token) (sit-for 1) + (push (or (cdr (assoc token hif-token-alist)) (if (string-equal token "defined") 'hif-defined) ;; TODO: ;; 1. postfix 'l', 'll', 'ul' and 'ull' - ;; 2. floating number formats - ;; 3. hexadecimal/octal floats - ;; 4. 098 is interpreted as octal conversion error - ;; FIXME: string-to-number does not convert hex floats + ;; 2. floating number formats (like 1.23e4) + ;; 3. 098 is interpreted as octal conversion error (if (string-match "0x\\([0-9a-fA-F]+\\.?[0-9a-fA-F]*\\)" token) - (string-to-number (match-string 1 token) 16)) ;; hex - ;; FIXME: string-to-number does not convert octal floats + (hif-string-to-number (match-string 1 token) 16)) ;; hex (if (string-match "\\`0[0-9]+\\(\\.[0-9]+\\)?\\'" token) - (string-to-number token 8)) ;; octal + (hif-string-to-number token 8)) ;; octal (if (string-match "\\`[1-9][0-9]*\\(\\.[0-9]+\\)?\\'" token) (string-to-number token)) ;; decimal - (intern token)) + (prog1 (intern token) + (setq hif-simple-token-only nil))) token-list))) - (t (error "Bad #if expression: %s" (buffer-string))))))) + + ((looking-at "\r") ; Sometimes MS-Windows user will leave CR in + (forward-char 1)) ; the source code. Let's not get stuck here. + (t (error "Bad #if expression: %s" (buffer-string))))))) + (nreverse token-list))) ;;------------------------------------------------------------------------ @@ -485,9 +648,116 @@ that form should be displayed.") "Pop the next token from token-list into the let variable `hif-token'." (setq hif-token (pop hif-token-list))) -(defun hif-parse-if-exp (token-list) - "Parse the TOKEN-LIST. Return translated list in prefix form." - (let ((hif-token-list token-list)) +(defsubst hif-if-valid-identifier-p (id) + (not (or (numberp id) + (stringp id)))) + +(defun hif-define-operator (tokens) + "`Upgrade' hif-define xxx to '(hif-define xxx)' so it won't be substituted." + (let ((result nil) + (tok nil)) + (while (setq tok (pop tokens)) + (push + (if (eq tok 'hif-defined) + (progn + (setq tok (cadr tokens)) + (if (eq (car tokens) 'hif-lparen) + (if (and (hif-if-valid-identifier-p tok) + (eq (cl-caddr tokens) 'hif-rparen)) + (setq tokens (cl-cdddr tokens)) + (error "#define followed by non-identifier: %S" tok)) + (setq tok (car tokens) + tokens (cdr tokens)) + (unless (hif-if-valid-identifier-p tok) + (error "#define followed by non-identifier: %S" tok))) + (list 'hif-defined 'hif-lparen tok 'hif-rparen)) + tok) + result)) + (nreverse result))) + +(defun hif-flatten (l) + "Flatten a tree." + (apply #'nconc + (mapcar (lambda (x) (if (listp x) + (hif-flatten x) + (list x))) l))) + +(defun hif-expand-token-list (tokens &optional macroname expand_list) + "Perform expansion on TOKENS till everything expanded. +Self-reference (directly or indirectly) tokens are not expanded. +EXPAND_LIST is the list of macro names currently being expanded, used for +detecting self-reference." + (catch 'self-referencing + (let ((expanded nil) + (remains (hif-define-operator + (hif-token-concatenation + (hif-token-stringification tokens)))) + tok rep) + (if macroname + (setq expand_list (cons macroname expand_list))) + ;; Expanding all tokens till list exhausted + (while (setq tok (pop remains)) + (if (memq tok expand_list) + ;; For self-referencing tokens, don't expand it + (throw 'self-referencing tokens)) + (push + (cond + ((or (memq tok hif-valid-token-list) + (numberp tok) + (stringp tok)) + tok) + + ((setq rep (hif-lookup tok)) + (if (and (listp rep) + (eq (car rep) 'hif-define-macro)) ; A defined macro + ;; Recursively expand it + (if (cadr rep) ; Argument list is not nil + (if (not (eq (car remains) 'hif-lparen)) + ;; No argument, no invocation + tok + ;; Argumented macro, get arguments and invoke it. + ;; Dynamically bind hif-token-list and hif-token + ;; for hif-macro-supply-arguments + (let* ((hif-token-list (cdr remains)) + (hif-token nil) + (parmlist (mapcar #'hif-expand-token-list + (hif-get-argument-list))) + (result + (hif-expand-token-list + (hif-macro-supply-arguments tok parmlist) + tok expand_list))) + (setq remains (cons hif-token hif-token-list)) + result)) + ;; Argument list is nil, direct expansion + (setq rep (hif-expand-token-list + (cl-caddr rep) ; Macro's token list + tok expand_list)) + ;; Replace all remaining references immediately + (setq remains (cl-substitute tok rep remains)) + rep) + ;; Lookup tok returns an atom + rep)) + + ;;[2013-10-22 16:06:12 +0800] Must keep the token, removing + ;; this token might results in an incomplete expression that + ;; cannot be parsed further. + ;;((= 1 (hif-defined tok)) ; defined (hif-defined tok)=1, + ;; ;;but empty (hif-lookup tok)=nil, thus remove this token + ;; (setq remains (delete tok remains)) + ;; nil) + + (t ; Usual IDs + tok)) + + expanded)) + + (hif-flatten (nreverse expanded))))) + +(defun hif-parse-exp (token-list &optional macroname) + "Parse the TOKEN-LIST. +Return translated list in prefix form. MACRONAME is applied when invoking +macros to prevent self-reference." + (let ((hif-token-list (hif-expand-token-list token-list macroname))) (hif-nexttoken) (prog1 (and hif-token @@ -496,31 +766,31 @@ that form should be displayed.") (error "Error: unexpected token: %s" hif-token))))) (defun hif-exprlist () - "Parse an exprlist: expr { ',' expr}" + "Parse an exprlist: expr { ',' expr}." (let ((result (hif-expr))) (if (eq hif-token 'hif-comma) - (let ((temp (list result))) - (while - (progn - (hif-nexttoken) - (push (hif-expr) temp) - (eq hif-token 'hif-comma))) - (cons 'hif-comma (nreverse temp))) + (let ((temp (list result))) + (while + (progn + (hif-nexttoken) + (push (hif-expr) temp) + (eq hif-token 'hif-comma))) + (cons 'hif-comma (nreverse temp))) result))) (defun hif-expr () "Parse an expression as found in #if. - expr : or-expr | or-expr '?' expr ':' expr." +expr : or-expr | or-expr '?' expr ':' expr." (let ((result (hif-or-expr)) - middle) + middle) (while (eq hif-token 'hif-conditional) (hif-nexttoken) (setq middle (hif-expr)) (if (eq hif-token 'hif-colon) - (progn - (hif-nexttoken) - (setq result (list 'hif-conditional result middle (hif-expr)))) - (error "Error: unexpected token: %s" hif-token))) + (progn + (hif-nexttoken) + (setq result (list 'hif-conditional result middle (hif-expr)))) + (error "Error: unexpected token: %s" hif-token))) result)) (defun hif-or-expr () @@ -577,7 +847,8 @@ that form should be displayed.") "Parse a comp-expr : logshift | comp-expr `<'|`>'|`>='|`<=' logshift." (let ((result (hif-logshift-expr)) (comp-token nil)) - (while (memq hif-token '(hif-greater hif-less hif-greater-equal hif-less-equal)) + (while (memq hif-token '(hif-greater hif-less hif-greater-equal + hif-less-equal)) (setq comp-token hif-token) (hif-nexttoken) (setq result (list comp-token result (hif-logshift-expr)))) @@ -608,7 +879,7 @@ that form should be displayed.") "Parse an expression with *,/,%. muldiv : factor | muldiv '*|/|%' factor." (let ((result (hif-factor)) - (math-op nil)) + (math-op nil)) (while (memq hif-token '(hif-multiply hif-divide hif-modulo)) (setq math-op hif-token) (hif-nexttoken) @@ -616,7 +887,9 @@ that form should be displayed.") result)) (defun hif-factor () - "Parse a factor: '!' factor | '~' factor | '(' expr ')' | 'defined(' id ')' | 'id(parmlist)' | strings | id." + "Parse a factor. +factor : '!' factor | '~' factor | '(' expr ')' | 'defined(' id ')' | + 'id(parmlist)' | strings | id." (cond ((eq hif-token 'hif-not) (hif-nexttoken) @@ -630,36 +903,119 @@ that form should be displayed.") (hif-nexttoken) (let ((result (hif-exprlist))) (if (not (eq hif-token 'hif-rparen)) - (error "Bad token in parenthesized expression: %s" hif-token) - (hif-nexttoken) - result))) + (error "Bad token in parenthesized expression: %s" hif-token) + (hif-nexttoken) + result))) ((eq hif-token 'hif-defined) (hif-nexttoken) (let ((paren (when (eq hif-token 'hif-lparen) (hif-nexttoken) t)) - (ident hif-token)) + (ident hif-token)) (if (memq hif-token '(or and not hif-defined hif-lparen hif-rparen)) - (error "Error: unexpected token: %s" hif-token)) + (error "Error: unexpected token: %s" hif-token)) (when paren - (hif-nexttoken) + (hif-nexttoken) (unless (eq hif-token 'hif-rparen) - (error "Error: expected \")\" after identifier"))) + (error "Error: expected \")\" after identifier"))) (hif-nexttoken) `(hif-defined (quote ,ident)))) ((numberp hif-token) (prog1 hif-token (hif-nexttoken))) + ((stringp hif-token) + (hif-string-concatenation)) ;; Unary plus/minus. ((memq hif-token '(hif-minus hif-plus)) (list (prog1 hif-token (hif-nexttoken)) 0 (hif-factor))) - (t ; identifier + (t ; identifier (let ((ident hif-token)) - (if (memq ident '(or and)) - (error "Error: missing identifier")) (hif-nexttoken) - `(hif-lookup (quote ,ident)))))) + (if (eq hif-token 'hif-lparen) + (hif-place-macro-invocation ident) + `(hif-lookup (quote ,ident))))))) + +(defun hif-get-argument-list () + (let ((nest 0) + (parmlist nil) ; A "token" list of parameters, will later be parsed + (parm nil)) + + (while (or (not (eq (hif-nexttoken) 'hif-rparen)) + (/= nest 0)) + (if (eq (car (last parm)) 'hif-comma) + (setq parm nil)) + (cond + ((eq hif-token 'hif-lparen) + (setq nest (1+ nest))) + ((eq hif-token 'hif-rparen) + (setq nest (1- nest))) + ((and (eq hif-token 'hif-comma) + (= nest 0)) + (push (nreverse parm) parmlist) + (setq parm nil))) + (push hif-token parm)) + + (push (nreverse parm) parmlist) ; Okay even if PARM is nil + (hif-nexttoken) ; Drop the `hif-rparen', get next token + (nreverse parmlist))) + +(defun hif-place-macro-invocation (ident) + (let ((parmlist (hif-get-argument-list))) + `(hif-invoke (quote ,ident) (quote ,parmlist)))) + +(defun hif-string-concatenation () + "Parse concatenated strings: string | strings string." + (let ((result (substring-no-properties hif-token))) + (while (stringp (hif-nexttoken)) + (setq result (concat + (substring result 0 -1) ; remove trailing '"' + (substring hif-token 1)))) ; remove leading '"' + result)) + +(defun hif-define-macro (_parmlist _token-body) + "A marker for defined macro with arguments. +This macro cannot be evaluated alone without parameters input." + ;;TODO: input arguments at run time, use minibuffer to query all arguments + (error + "Argumented macro cannot be evaluated without passing any parameter")) + +(defun hif-stringify (a) + "Stringify a number, string or symbol." + (cond + ((numberp a) + (number-to-string a)) + ((atom a) + (symbol-name a)) + ((stringp a) + (concat "\"" a "\"")) + (t + (error "Invalid token to stringify")))) + +(defun intern-safe (str) + (if (stringp str) + (intern str))) + +(defun hif-token-concat (a b) + "Concatenate two tokens into a longer token. +Currently support only simple token concatenation. Also support weird (but +valid) token concatenation like '>' ## '>' becomes '>>'. Here we take care only +those that can be evaluated during preprocessing time and ignore all those that +can only be evaluated at C(++) runtime (like '++', '--' and '+='...)." + (if (or (memq a hif-valid-token-list) + (memq b hif-valid-token-list)) + (let* ((ra (car (rassq a hif-token-alist))) + (rb (car (rassq b hif-token-alist))) + (result (and ra rb + (cdr (assoc (concat ra rb) hif-token-alist))))) + (or result + ;;(error "Invalid token to concatenate") + (error "Concatenating \"%s\" and \"%s\" does not give a valid \ +preprocessing token" + (or ra (symbol-name a)) + (or rb (symbol-name b))))) + (intern-safe (concat (hif-stringify a) + (hif-stringify b))))) (defun hif-mathify (val) "Treat VAL as a number: if it's t or nil, use 1 or 0." @@ -715,30 +1071,159 @@ that form should be displayed.") (defun hif-comma (&rest expr) - "Evaluate a list of expr, return the result of the last item." + "Evaluate a list of EXPR, return the result of the last item." (let ((result nil)) (dolist (e expr) (ignore-errors (setq result (funcall hide-ifdef-evaluator e)))) result)) +(defun hif-token-stringification (l) + "Scan token list for `hif-stringify' ('#') token and stringify the next token." + (let (result) + (while l + (push (if (eq (car l) 'hif-stringify) + (prog1 + (if (cadr l) + (hif-stringify (cadr l)) + (error "No token to stringify")) + (setq l (cdr l))) + (car l)) + result) + (setq l (cdr l))) + (nreverse result))) + +(defun hif-token-concatenation (l) + "Scan token list for `hif-token-concat' ('##') token and concatenate two tokens." + (let ((prev nil) + result) + (while l + (while (eq (car l) 'hif-token-concat) + (unless prev + (error "No token before ## to concatenate")) + (unless (cdr l) + (error "No token after ## to concatenate")) + (setq prev (hif-token-concat prev (cadr l))) + (setq l (cddr l))) + (if prev + (setq result (append result (list prev)))) + (setq prev (car l) + l (cdr l))) + (if prev + (append result (list prev)) + result))) + +(defun hif-delimit (lis atom) + (nconc (cl-mapcan (lambda (l) (list l atom)) + (butlast lis)) + (last lis))) + +;; Perform token replacement: +(defun hif-macro-supply-arguments (macro-name actual-parms) + "Expand a macro call, replace ACTUAL-PARMS in the macro body." + (let* ((SA (assoc macro-name hide-ifdef-env)) + (macro (and SA + (cdr SA) + (eq (cadr SA) 'hif-define-macro) + (cddr SA))) + (formal-parms (and macro (car macro))) + (macro-body (and macro (cadr macro))) + actual-count + formal-count + formal + etc) + + (when (and actual-parms formal-parms macro-body) + ;; For each actual parameter, evaluate each one and associate it + ;; with an actual parameter, put it into local table and finally + ;; evaluate the macro body. + (if (setq etc (eq (car formal-parms) 'hif-etc)) + ;; Take care of `hif-etc' first. Prefix `hif-comma' back if needed. + (setq formal-parms (cdr formal-parms))) + (setq formal-count (length formal-parms) + actual-count (length actual-parms)) + + (if (> formal-count actual-count) + (error "Too few parameters for macro %S" macro-name) + (if (< formal-count actual-count) + (or etc + (error "Too many parameters for macro %S" macro-name)))) + + ;; Perform token replacement on the MACRO-BODY with the parameters + (while (setq formal (pop formal-parms)) + ;; Prevent repetitive substitution, thus cannot use `subst' + ;; for example: + ;; #define mac(a,b) (a+b) + ;; #define testmac mac(b,y) + ;; testmac should expand to (b+y): replace of argument a and b + ;; occurs simultaneously, not sequentially. If sequentially, + ;; according to the argument order, it will become: + ;; 1. formal parm #1 'a' replaced by actual parm 'b', thus (a+b) + ;; becomes (b+b) + ;; 2. formal parm #2 'b' replaced by actual parm 'y', thus (b+b) + ;; becomes (y+y). + (setq macro-body + ;; Unlike `subst', `substitute' replace only the top level + ;; instead of the whole tree; more importantly, it's not + ;; destructive. + (cl-substitute (if (and etc (null formal-parms)) + (hif-delimit actual-parms 'hif-comma) + (car actual-parms)) + formal macro-body)) + (setq actual-parms (cdr actual-parms))) + + ;; Replacement completed, flatten the whole token list + (setq macro-body (hif-flatten macro-body)) + + ;; Stringification and token concatenation happens here + (hif-token-concatenation (hif-token-stringification macro-body))))) + +(defun hif-invoke (macro-name actual-parms) + "Invoke a macro by expanding it, reparse macro-body and finally invoke it." + ;; Reparse the macro body and evaluate it + (funcall hide-ifdef-evaluator + (hif-parse-exp + (hif-macro-supply-arguments macro-name actual-parms) + macro-name))) ;;;----------- end of parser ----------------------- -(defun hif-canonicalize () - "When at beginning of #ifX, return a Lisp expression for its condition." +(defun hif-canonicalize-tokens (regexp) ; For debugging + "Return the expanded result of the scanned tokens." (save-excursion - (let ((negate (looking-at hif-ifndef-regexp))) - (re-search-forward hif-ifx-regexp) - (let* ((tokens (hif-tokenize (point) - (progn (hif-end-of-line) (point)))) - (expr (hif-parse-if-exp tokens))) - ;; (message "hif-canonicalized: %s" expr) - (if negate - (list 'hif-not expr) - expr))))) - + (re-search-forward regexp) + (let* ((curr-regexp (match-string 0)) + (defined (string-match hif-ifxdef-regexp curr-regexp)) + (negate (and defined + (string= (match-string 2 curr-regexp) "n"))) + (hif-simple-token-only nil) ;; Dynamic binding var for `hif-tokenize' + (tokens (hif-tokenize (point) + (progn (hif-end-of-line) (point))))) + (if defined + (setq tokens (list 'hif-defined tokens))) + (if negate + (setq tokens (list 'hif-not tokens))) + tokens))) + +(defun hif-canonicalize (regexp) + "Return a Lisp expression for its condition by scanning current buffer. +Do this when cursor is at the beginning of `regexp' (i.e. #ifX)." + (let ((case-fold-search nil)) + (save-excursion + (re-search-forward regexp) + (let* ((curr-regexp (match-string 0)) + (defined (string-match hif-ifxdef-regexp curr-regexp)) + (negate (and defined + (string= (match-string 2 curr-regexp) "n"))) + (hif-simple-token-only nil) ; Dynamic binding for `hif-tokenize' + (tokens (hif-tokenize (point) + (progn (hif-end-of-line) (point))))) + (if defined + (setq tokens (list 'hif-defined tokens))) + (if negate + (setq tokens (list 'hif-not tokens))) + (hif-parse-exp tokens))))) (defun hif-find-any-ifX () "Move to next #if..., or #ifndef, at point or after." @@ -749,10 +1234,10 @@ that form should be displayed.") (defun hif-find-next-relevant () - "Move to next #if..., #else, or #endif, after the current line." + "Move to next #if..., #elif..., #else, or #endif, after the current line." ;; (message "hif-find-next-relevant at %d" (point)) (end-of-line) - ;; avoid infinite recursion by only going to beginning of line if match found + ;; Avoid infinite recursion by only going to line-beginning if match found (if (re-search-forward hif-ifx-else-endif-regexp (point-max) t) (beginning-of-line))) @@ -760,33 +1245,37 @@ that form should be displayed.") "Move to previous #if..., #else, or #endif, before the current line." ;; (message "hif-find-previous-relevant at %d" (point)) (beginning-of-line) - ;; avoid infinite recursion by only going to beginning of line if match found + ;; Avoid infinite recursion by only going to line-beginning if match found (if (re-search-backward hif-ifx-else-endif-regexp (point-min) t) (beginning-of-line))) -(defun hif-looking-at-ifX () ;; Should eventually see #if - (looking-at hif-ifx-regexp)) +(defun hif-looking-at-ifX () + (looking-at hif-ifx-regexp)) ; Should eventually see #if (defun hif-looking-at-endif () (looking-at hif-endif-regexp)) (defun hif-looking-at-else () (looking-at hif-else-regexp)) +(defun hif-looking-at-elif () + (looking-at hif-elif-regexp)) (defun hif-ifdef-to-endif () - "If positioned at #ifX or #else form, skip to corresponding #endif." + "If positioned at #ifX, #elif, or #else form, skip to corresponding #endif." ;; (message "hif-ifdef-to-endif at %d" (point)) (sit-for 1) (hif-find-next-relevant) (cond ((hif-looking-at-ifX) - (hif-ifdef-to-endif) ; find endif of nested if - (hif-ifdef-to-endif)) ; find outer endif or else - ((hif-looking-at-else) - (hif-ifdef-to-endif)) ; find endif following else - ((hif-looking-at-endif) - 'done) - (t - (error "Mismatched #ifdef #endif pair")))) + (hif-ifdef-to-endif) ; Find endif of nested if + (hif-ifdef-to-endif)) ; Find outer endif or else + ((hif-looking-at-elif) + (hif-ifdef-to-endif)) + ((hif-looking-at-else) + (hif-ifdef-to-endif)) ; Find endif following else + ((hif-looking-at-endif) + 'done) + (t + (error "Mismatched #ifdef #endif pair")))) (defun hif-endif-to-ifdef () @@ -795,15 +1284,18 @@ that form should be displayed.") (let ((start (point))) (hif-find-previous-relevant) (if (= start (point)) - (error "Mismatched #ifdef #endif pair"))) + (error "Mismatched #ifdef #endif pair"))) (cond ((hif-looking-at-endif) - (hif-endif-to-ifdef) ; find beginning of nested if - (hif-endif-to-ifdef)) ; find beginning of outer if or else - ((hif-looking-at-else) - (hif-endif-to-ifdef)) - ((hif-looking-at-ifX) - 'done) - (t))) ; never gets here + (hif-endif-to-ifdef) ; Find beginning of nested if + (hif-endif-to-ifdef)) ; Find beginning of outer if or else + ((hif-looking-at-elif) + (hif-endif-to-ifdef)) + ((hif-looking-at-else) + (hif-endif-to-ifdef)) + ((hif-looking-at-ifX) + 'done) + (t + (error "Mismatched #endif")))) ; never gets here (defun forward-ifdef (&optional arg) @@ -897,26 +1389,25 @@ With argument, do this that many times." ;;===%%SF%% hide-ifdef-hiding (Start) === -;;; A range is a structure with four components: -;;; ELSE-P True if there was an else clause for the ifdef. -;;; START The start of the range. (beginning of line) -;;; ELSE The else marker (beginning of line) -;;; Only valid if ELSE-P is true. -;;; END The end of the range. (beginning of line) +;; A range is a structure with four components: +;; START The start of the range. (beginning of line) +;; ELSE The else marker (beginning of line) +;; END The end of the range. (beginning of line) +;; ELIF A sequence of #elif markers (beginning of line) -(defsubst hif-make-range (start end &optional else) - (list start else end)) +(defsubst hif-make-range (start end &optional else elif) + (list start else end elif)) (defsubst hif-range-start (range) (elt range 0)) (defsubst hif-range-else (range) (elt range 1)) (defsubst hif-range-end (range) (elt range 2)) +(defsubst hif-range-elif (range) (elt range 3)) - -;;; Find-Range -;;; The workhorse, it delimits the #if region. Reasonably simple: -;;; Skip until an #else or #endif is found, remembering positions. If -;;; an #else was found, skip some more, looking for the true #endif. +;; Find-Range +;; The workhorse, it delimits the #if region. Reasonably simple: +;; Skip until an #else or #endif is found, remembering positions. If +;; an #else was found, skip some more, looking for the true #endif. (defun hif-find-range () "Return a Range structure describing the current #if region. @@ -925,35 +1416,40 @@ Point is left unchanged." (save-excursion (beginning-of-line) (let ((start (point)) - (else nil) - (end nil)) - ;; Part one. Look for either #endif or #else. + (elif nil) + (else nil) + (end nil)) + ;; Part one. Look for either #elif, #else or #endif. ;; This loop-and-a-half dedicated to E. Dijkstra. - (while (progn - (hif-find-next-relevant) - (hif-looking-at-ifX)) ; Skip nested ifdef - (hif-ifdef-to-endif)) - ;; Found either a #else or an #endif. - (cond ((hif-looking-at-else) - (setq else (point))) - (t - (setq end (point)))) ; (line-end-position) + (while (and (not else) (not end)) + (while (progn + (hif-find-next-relevant) + (hif-looking-at-ifX)) ; Skip nested ifdef + (hif-ifdef-to-endif)) + ;; Found either a #else, #elif, or an #endif. + (cond ((hif-looking-at-elif) + (setq elif (nconc elif (list (point))))) + ((hif-looking-at-else) + (setq else (point))) + (t + (setq end (point))))) ;; If found #else, look for #endif. (when else - (while (progn - (hif-find-next-relevant) - (hif-looking-at-ifX)) ; Skip nested ifdef - (hif-ifdef-to-endif)) - (if (hif-looking-at-else) - (error "Found two elses in a row? Broken!")) - (setq end (point))) ; (line-end-position) - (hif-make-range start end else)))) + (while (progn + (hif-find-next-relevant) + (hif-looking-at-ifX)) ; Skip nested ifdef + (hif-ifdef-to-endif)) + (if (hif-looking-at-else) + (error "Found two elses in a row? Broken!")) + (setq end (point))) ; (line-end-position) + (hif-make-range start end else elif)))) -;;; A bit slimy. +;; A bit slimy. (defun hif-hide-line (point) - "Hide the line containing point. Does nothing if `hide-ifdef-lines' is nil." + "Hide the line containing point. +Does nothing if `hide-ifdef-lines' is nil." (when hide-ifdef-lines (save-excursion (goto-char point) @@ -961,80 +1457,323 @@ Point is left unchanged." (line-beginning-position) (progn (hif-end-of-line) (point)))))) -;;; Hif-Possibly-Hide -;;; There are four cases. The #ifX expression is "taken" if it -;;; the hide-ifdef-evaluator returns T. Presumably, this means the code -;;; inside the #ifdef would be included when the program was -;;; compiled. -;;; -;;; Case 1: #ifX taken, and there's an #else. -;;; The #else part must be hidden. The #if (then) part must be -;;; processed for nested #ifX's. -;;; Case 2: #ifX taken, and there's no #else. -;;; The #if part must be processed for nested #ifX's. -;;; Case 3: #ifX not taken, and there's an #else. -;;; The #if part must be hidden. The #else part must be processed -;;; for nested #ifs. -;;; Case 4: #ifX not taken, and there's no #else. -;;; The #ifX part must be hidden. -;;; -;;; Further processing is done by narrowing to the relevant region -;;; and just recursively calling hide-ifdef-guts. -;;; -;;; When hif-possibly-hide returns, point is at the end of the -;;; possibly-hidden range. - -(defun hif-recurse-on (start end) +;; Hif-Possibly-Hide +;; There are four cases. The #ifX expression is "taken" if it +;; the hide-ifdef-evaluator returns T. Presumably, this means the code +;; inside the #ifdef would be included when the program was +;; compiled. +;; +;; Case 1: #ifX taken, and there's an #else. +;; The #else part must be hidden. The #if (then) part must be +;; processed for nested #ifX's. +;; Case 2: #ifX taken, and there's no #else. +;; The #if part must be processed for nested #ifX's. +;; Case 3: #ifX not taken, and there's an #elif +;; The #if part must be hidden, and then evaluate +;; the #elif condition like a new #ifX. +;; Case 4: #ifX not taken, and there's just an #else. +;; The #if part must be hidden. The #else part must be processed +;; for nested #ifs. +;; Case 5: #ifX not taken, and there's no #else. +;; The #ifX part must be hidden. +;; +;; Further processing is done by narrowing to the relevant region +;; and just recursively calling hide-ifdef-guts. +;; +;; When hif-possibly-hide returns, point is at the end of the +;; possibly-hidden range. + +(defvar hif-recurse-level 0) + +(defun hif-recurse-on (start end &optional dont-go-eol) "Call `hide-ifdef-guts' after narrowing to end of START line and END line." (save-excursion (save-restriction (goto-char start) - (end-of-line) + (unless dont-go-eol + (end-of-line)) (narrow-to-region (point) end) - (hide-ifdef-guts)))) + (let ((hif-recurse-level (1+ hif-recurse-level))) + (hide-ifdef-guts))))) -(defun hif-possibly-hide () +(defun hif-possibly-hide (expand-reinclusion) "Called at #ifX expression, this hides those parts that should be hidden. -It uses the judgment of `hide-ifdef-evaluator'." +It uses the judgment of `hide-ifdef-evaluator'. EXPAND-REINCLUSION is a flag +indicating that we should expand the #ifdef even if it should be hidden. +Refer to `hide-ifdef-expand-reinclusion-protection' for more details." ;; (message "hif-possibly-hide") (sit-for 1) - (let ((test (hif-canonicalize)) - (range (hif-find-range))) + (let* ((case-fold-search nil) + (test (hif-canonicalize hif-ifx-regexp)) + (range (hif-find-range)) + (elifs (hif-range-elif range)) + (if-part t) ; Everytime we start from if-part + (complete nil)) ;; (message "test = %s" test) (sit-for 1) (hif-hide-line (hif-range-end range)) - (if (not (hif-not (funcall hide-ifdef-evaluator test))) - (cond ((hif-range-else range) ; case 1 - (hif-hide-line (hif-range-else range)) - (hide-ifdef-region (hif-range-else range) - (1- (hif-range-end range))) - (hif-recurse-on (hif-range-start range) - (hif-range-else range))) - (t ; case 2 - (hif-recurse-on (hif-range-start range) - (hif-range-end range)))) - (cond ((hif-range-else range) ; case 3 - (hif-hide-line (hif-range-else range)) - (hide-ifdef-region (hif-range-start range) - (1- (hif-range-else range))) - (hif-recurse-on (hif-range-else range) - (hif-range-end range))) - (t ; case 4 - (hide-ifdef-region (point) - (1- (hif-range-end range)))))) + (while (not complete) + (if (and (not (and expand-reinclusion if-part)) + (hif-not (funcall hide-ifdef-evaluator test))) + ;; ifX/elif is FALSE + (if elifs + ;; Case 3 - Hide the #ifX and eval #elif + (let ((newstart (car elifs))) + (hif-hide-line (hif-range-start range)) + (hide-ifdef-region (hif-range-start range) + (1- newstart)) + (setcar range newstart) + (goto-char newstart) + (setq elifs (cdr elifs)) + (setq test (hif-canonicalize hif-elif-regexp))) + + ;; Check for #else + (cond ((hif-range-else range) + ;; Case 4 - #else block visible + (hif-hide-line (hif-range-else range)) + (hide-ifdef-region (hif-range-start range) + (1- (hif-range-else range))) + (hif-recurse-on (hif-range-else range) + (hif-range-end range))) + (t + ;; Case 5 - No #else block, hide #ifX + (hide-ifdef-region (point) + (1- (hif-range-end range))))) + (setq complete t)) + + ;; ifX/elif is TRUE + (cond (elifs + ;; Luke fix: distinguish from #elif..#elif to #elif..#else + (let ((elif (car elifs))) + ;; hide all elifs + (hif-hide-line elif) + (hide-ifdef-region elif (1- (hif-range-end range))) + (hif-recurse-on (hif-range-start range) + elif))) + ((hif-range-else range) + ;; Case 1 - Hide #elif and #else blocks, recurse #ifX + (hif-hide-line (hif-range-else range)) + (hide-ifdef-region (hif-range-else range) + (1- (hif-range-end range))) + (hif-recurse-on (hif-range-start range) + (hif-range-else range))) + (t + ;; Case 2 - No #else, just recurse #ifX + (hif-recurse-on (hif-range-start range) + (hif-range-end range)))) + (setq complete t)) + (setq if-part nil)) + + ;; complete = t (hif-hide-line (hif-range-start range)) ; Always hide start. (goto-char (hif-range-end range)) (end-of-line))) +(defun hif-evaluate-region (start end) + (let* ((tokens (ignore-errors ; Prevent C statement things like + ; 'do { ... } while (0)' + (hif-tokenize start end))) + (expr (and tokens + (condition-case nil + (hif-parse-exp tokens) + (error + tokens)))) + (result (funcall hide-ifdef-evaluator expr))) + result)) +(defun hif-evaluate-macro (rstart rend) + "Evaluate the macro expansion result for a region. +If no region active, find the current #ifdefs and evaluate the result. +Currently it supports only math calculations, strings or argumented macros can +not be expanded." + (interactive "r") + (let ((case-fold-search nil)) + (save-excursion + (unless mark-active + (setq rstart nil rend nil) + (beginning-of-line) + (when (and (re-search-forward hif-macro-expr-prefix-regexp nil t) + (string= "define" (match-string 2))) + (re-search-forward hif-macroref-regexp nil t))) + (let* ((start (or rstart (point))) + (end (or rend (progn (hif-end-of-line) (point)))) + (defined nil) + (simple 't) + (tokens (ignore-errors ; Prevent C statement things like + ; 'do { ... } while (0)' + (hif-tokenize start end))) + (expr (or (and (<= (length tokens) 1) ; Simple token + (setq defined (assoc (car tokens) hide-ifdef-env)) + (setq simple (atom (hif-lookup (car tokens)))) + (hif-lookup (car tokens))) + (and tokens + (condition-case nil + (hif-parse-exp tokens) + (error + nil))))) + (result (funcall hide-ifdef-evaluator expr)) + (exprstring (replace-regexp-in-string + ;; Trim off leading/trailing whites + "^[ \t]*\\([^ \t]+\\)[ \t]*" "\\1" + (replace-regexp-in-string + "\\(//.*\\)" "" ; Trim off end-of-line comments + (buffer-substring-no-properties start end))))) + (cond + ((and (<= (length tokens) 1) simple) ; Simple token + (if defined + (message "%S <= `%s'" result exprstring) + (message "`%s' is not defined" exprstring))) + ((integerp result) + (if (or (= 0 result) (= 1 result)) + (message "%S <= `%s'" result exprstring) + (message "%S (0x%x) <= `%s'" result result exprstring))) + ((null result) (message "%S <= `%s'" 'false exprstring)) + ((eq t result) (message "%S <= `%s'" 'true exprstring)) + (t (message "%S <= `%s'" result exprstring))) + result)))) + +(defun hif-parse-macro-arglist (str) + "Parse argument list formatted as '( arg1 [ , argn] [...] )'. +The '...' is also included. Return a list of the arguments, if '...' exists the +first arg will be `hif-etc'." + (let* ((hif-simple-token-only nil) ; Dynamic binding var for `hif-tokenize' + (tokenlist + (cdr (hif-tokenize + (- (point) (length str)) (point)))) ; Remove `hif-lparen' + etc result token) + (while (not (eq (setq token (pop tokenlist)) 'hif-rparen)) + (cond + ((eq token 'hif-etc) + (setq etc t)) + ((eq token 'hif-comma) + t) + (t + (push token result)))) + (if etc + (cons 'hif-etc (nreverse result)) + (nreverse result)))) + +;; The original version of hideif evaluates the macro early and store the +;; final values for the defined macro into the symbol database (aka +;; `hide-ifdef-env'). The evaluation process is "strings -> tokens -> parsed +;; tree -> [value]". (The square bracket refers to what's stored in in our +;; `hide-ifdef-env'.) +;; +;; This forbids the evaluation of an argumented macro since the parameters +;; are applied at run time. In order to support argumented macro I then +;; postponed the evaluation process one stage and store the "parsed tree" +;; into symbol database. The evaluation process was then "strings -> tokens +;; -> [parsed tree] -> value". Hideif therefore run slower since it need to +;; evaluate the parsed tree everytime when trying to expand the symbol. These +;; temporarily code changes are obsolete and not in Emacs source repository. +;; +;; Furthermore, CPP did allow partial expression to be defined in several +;; macros and later got concatenated into a complete expression and then +;; evaluate it. In order to match this behavior I had to postpone one stage +;; further, otherwise those partial expression will be fail on parsing and +;; we'll miss all macros that reference it. The evaluation process thus +;; became "strings -> [tokens] -> parsed tree -> value." This degraded the +;; performance since we need to parse tokens and evaluate them everytime +;; when that symbol is referenced. +;; +;; In real cases I found a lot portion of macros are "simple macros" that +;; expand to literals like integers or other symbols. In order to enhance +;; the performance I use this `hif-simple-token-only' to notify my code and +;; save the final [value] into symbol database. [lukelee] + +(defun hif-find-define (&optional min max) + "Parse texts and retrieve all defines within the region MIN and MAX." + (interactive) + (and min (goto-char min)) + (and (re-search-forward hif-define-regexp max t) + (or + (let* ((defining (string= "define" (match-string 2))) + (name (and (re-search-forward hif-macroref-regexp max t) + (match-string 1))) + (parmlist (and (match-string 3) ; First arg id found + (hif-parse-macro-arglist (match-string 2))))) + (if defining + ;; Ignore name (still need to return 't), or define the name + (or (and hide-ifdef-exclude-define-regexp + (string-match hide-ifdef-exclude-define-regexp + name)) + + (let* ((start (point)) + (end (progn (hif-end-of-line) (point))) + (hif-simple-token-only nil) ; Dynamic binding + (tokens + (and name + ;; `hif-simple-token-only' is set/clear + ;; only in this block + (condition-case nil + ;; Prevent C statements like + ;; 'do { ... } while (0)' + (hif-tokenize start end) + (error + ;; We can't just return nil here since + ;; this will stop hideif from searching + ;; for more #defines. + (setq hif-simple-token-only t) + (buffer-substring-no-properties + start end))))) + ;; For simple tokens we save only the parsed result; + ;; otherwise we save the tokens and parse it after + ;; parameter replacement + (expr (and tokens + ;; `hif-simple-token-only' is checked only + ;; here. + (or (and hif-simple-token-only + (listp tokens) + (= (length tokens) 1) + (hif-parse-exp tokens)) + `(hif-define-macro ,parmlist + ,tokens)))) + (SA (and name + (assoc (intern name) hide-ifdef-env)))) + (and name + (if SA + (or (setcdr SA expr) t) + ;; Lazy evaluation, eval only if hif-lookup find it. + ;; Define it anyway, even if nil it's still in list + ;; and therefore considered defined. + (push (cons (intern name) expr) hide-ifdef-env))))) + ;; #undef + (and name + (hif-undefine-symbol (intern name)))))) + t)) + + +(defun hif-add-new-defines (&optional min max) + "Scan and add all #define macros between MIN and MAX." + (interactive) + (save-excursion + (save-restriction + ;; (mark-region min max) ;; for debugging + (while (hif-find-define min max) + (setf min (point))) + (if max (goto-char max) + (goto-char (point-max)))))) (defun hide-ifdef-guts () "Does most of the work of `hide-ifdefs'. It does not do the work that's pointless to redo on a recursive entry." ;; (message "hide-ifdef-guts") (save-excursion - (goto-char (point-min)) - (while (hif-find-any-ifX) - (hif-possibly-hide)))) + (let* ((case-fold-search t) ; Ignore case for `hide-ifdef-header-regexp' + (expand-header (and hide-ifdef-expand-reinclusion-protection + (string-match hide-ifdef-header-regexp + (buffer-file-name)) + (zerop hif-recurse-level))) + (case-fold-search nil) + min max) + (goto-char (point-min)) + (setf min (point)) + (cl-loop do + (setf max (hif-find-any-ifX)) + (hif-add-new-defines min max) + (if max + (hif-possibly-hide expand-header)) + (setf min (point)) + while max)))) ;;===%%SF%% hide-ifdef-hiding (End) === @@ -1048,7 +1787,8 @@ It does not do the work that's pointless to redo on a recursive entry." (message "Hide-Read-Only %s" (if hide-ifdef-read-only "ON" "OFF")) (if hide-ifdef-hiding - (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only))) + (setq buffer-read-only (or hide-ifdef-read-only + hif-outside-read-only))) (force-mode-line-update)) (defun hide-ifdef-toggle-outside-read-only () @@ -1078,38 +1818,67 @@ It does not do the work that's pointless to redo on a recursive entry." (overlay-put overlay 'face nil) (overlay-put overlay 'invisible 'hide-ifdef)))))) -(defun hide-ifdef-define (var) - "Define a VAR so that #ifdef VAR would be included." - (interactive "SDefine what? ") - (hif-set-var var 1) +(defun hide-ifdef-define (var &optional val) + "Define a VAR to VAL (default 1) in `hide-ifdef-env'. +This allows #ifdef VAR to be hidden." + (interactive + (let* ((default (save-excursion + (beginning-of-line) + (cond ((looking-at hif-ifx-else-endif-regexp) + (forward-word 2) + (current-word 'strict)) + (t + nil)))) + (var (read-minibuffer "Define what? " default)) + (val (read-from-minibuffer (format "Set %s to? (default 1): " var) + nil nil t nil "1"))) + (list var val))) + (hif-set-var var (or val 1)) + (message "%s set to %s" var (or val 1)) + (sleep-for 1) (if hide-ifdef-hiding (hide-ifdefs))) -(defun hide-ifdef-undef (var) - "Undefine a VAR so that #ifdef VAR would not be included." - (interactive "SUndefine what? ") - (hif-set-var var nil) - (if hide-ifdef-hiding (hide-ifdefs))) +(defun hif-undefine-symbol (var) + (setq hide-ifdef-env + (delete (assoc var hide-ifdef-env) hide-ifdef-env))) +(defun hide-ifdef-undef (start end) + "Undefine a VAR so that #ifdef VAR would not be included." + (interactive "r") + (let* ((symstr + (or (and mark-active + (buffer-substring-no-properties start end)) + (read-string "Undefine what? " (current-word)))) + (sym (and symstr + (intern symstr)))) + (if (zerop (hif-defined sym)) + (message "`%s' not defined, no need to undefine it" symstr) + (hif-undefine-symbol sym) + (if hide-ifdef-hiding (hide-ifdefs)) + (message "`%S' undefined" sym)))) (defun hide-ifdefs (&optional nomsg) "Hide the contents of some #ifdefs. Assume that defined symbols have been added to `hide-ifdef-env'. The text hidden is the text that would not be included by the C preprocessor if it were given the file with those symbols defined. +With prefix command presents it will also hide the #ifdefs themselves. Turn off hiding by calling `show-ifdefs'." (interactive) - (message "Hiding...") - (setq hif-outside-read-only buffer-read-only) - (unless hide-ifdef-mode (hide-ifdef-mode 1)) ; turn on hide-ifdef-mode - (if hide-ifdef-hiding - (show-ifdefs)) ; Otherwise, deep confusion. - (setq hide-ifdef-hiding t) - (hide-ifdef-guts) - (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only)) - (or nomsg - (message "Hiding done"))) + (let ((hide-ifdef-lines current-prefix-arg)) + (or nomsg + (message "Hiding...")) + (setq hif-outside-read-only buffer-read-only) + (unless hide-ifdef-mode (hide-ifdef-mode 1)) ; Turn on hide-ifdef-mode + (if hide-ifdef-hiding + (show-ifdefs)) ; Otherwise, deep confusion. + (setq hide-ifdef-hiding t) + (hide-ifdef-guts) + (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only)) + (or nomsg + (message "Hiding done")))) (defun show-ifdefs () @@ -1125,46 +1894,74 @@ Turn off hiding by calling `show-ifdefs'." Return as (TOP . BOTTOM) the extent of ifdef block." (let (max-bottom) (cons (save-excursion - (beginning-of-line) - (unless (or (hif-looking-at-else) (hif-looking-at-ifX)) - (up-ifdef)) - (prog1 (point) - (hif-ifdef-to-endif) - (setq max-bottom (1- (point))))) - (save-excursion - (beginning-of-line) - (unless (hif-looking-at-endif) - (hif-find-next-relevant)) - (while (hif-looking-at-ifX) - (hif-ifdef-to-endif) - (hif-find-next-relevant)) - (min max-bottom (1- (point))))))) - - -(defun hide-ifdef-block () - "Hide the ifdef block (true or false part) enclosing or before the cursor." - (interactive) - (unless hide-ifdef-mode (hide-ifdef-mode 1)) - (let ((top-bottom (hif-find-ifdef-block))) - (hide-ifdef-region (car top-bottom) (cdr top-bottom)) - (when hide-ifdef-lines - (hif-hide-line (car top-bottom)) - (hif-hide-line (1+ (cdr top-bottom)))) - (setq hide-ifdef-hiding t)) - (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only))) - -(defun show-ifdef-block () + (beginning-of-line) + (unless (or (hif-looking-at-else) (hif-looking-at-ifX)) + (up-ifdef)) + (prog1 (point) + (hif-ifdef-to-endif) + (setq max-bottom (1- (point))))) + (save-excursion + (beginning-of-line) + (unless (hif-looking-at-endif) + (hif-find-next-relevant)) + (while (hif-looking-at-ifX) + (hif-ifdef-to-endif) + (hif-find-next-relevant)) + (min max-bottom (1- (point))))))) + + +(defun hide-ifdef-block (&optional arg start end) + "Hide the ifdef block (true or false part) enclosing or before the cursor. +With optional prefix argument ARG, also hide the #ifdefs themselves." + (interactive "P\nr") + (let ((hide-ifdef-lines arg)) + (if mark-active + (let ((hif-recurse-level (1+ hif-recurse-level))) + (hif-recurse-on start end t) + (setq mark-active nil)) + (unless hide-ifdef-mode (hide-ifdef-mode 1)) + (let ((top-bottom (hif-find-ifdef-block))) + (hide-ifdef-region (car top-bottom) (cdr top-bottom)) + (when hide-ifdef-lines + (hif-hide-line (car top-bottom)) + (hif-hide-line (1+ (cdr top-bottom)))) + (setq hide-ifdef-hiding t)) + (setq buffer-read-only + (or hide-ifdef-read-only hif-outside-read-only))))) + +(defun show-ifdef-block (&optional start end) "Show the ifdef block (true or false part) enclosing or before the cursor." - (interactive) - (let ((top-bottom (hif-find-ifdef-block))) + (interactive "r") + (if mark-active + (progn + (dolist (o (overlays-in start end)) + (if (overlay-get o 'hide-ifdef) + (delete-overlay o))) + (setq mark-active nil)) + (let ((top-bottom (condition-case nil + (hif-find-ifdef-block) + (error + nil))) + (ovrs (overlays-in (max (point-min) (1- (point))) + (min (point-max) (1+ (point))))) + (del nil)) + (if top-bottom (if hide-ifdef-lines - (hif-show-ifdef-region - (save-excursion - (goto-char (car top-bottom)) (line-beginning-position)) - (save-excursion - (goto-char (1+ (cdr top-bottom))) - (hif-end-of-line) (point))) - (hif-show-ifdef-region (1- (car top-bottom)) (cdr top-bottom))))) + (hif-show-ifdef-region + (save-excursion + (goto-char (car top-bottom)) (line-beginning-position)) + (save-excursion + (goto-char (1+ (cdr top-bottom))) + (hif-end-of-line) (point))) + (setf del (hif-show-ifdef-region + (1- (car top-bottom)) (cdr top-bottom))))) + (if (not (and top-bottom + del)) + (dolist (o ovrs) + ;;(dolist (o (overlays-in (1- (point)) (1+ (point)))) + ;; (if (overlay-get o 'hide-ifdef) (message "%S" o))) + (if (overlay-get o 'hide-ifdef) + (delete-overlay o))))))) ;;; definition alist support diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 3f191532c62..fb4d445b595 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -390,37 +390,31 @@ Use the command `hs-minor-mode' to toggle or set this variable.") :help "Do not hidden code or comment blocks when isearch matches inside them" :active t :style radio :selected (eq hs-isearch-open nil)]))) -(defvar hs-c-start-regexp nil +(defvar-local hs-c-start-regexp nil "Regexp for beginning of comments. Differs from mode-specific comment regexps in that surrounding whitespace is stripped.") -(make-variable-buffer-local 'hs-c-start-regexp) -(defvar hs-block-start-regexp nil +(defvar-local hs-block-start-regexp nil "Regexp for beginning of block.") -(make-variable-buffer-local 'hs-block-start-regexp) -(defvar hs-block-start-mdata-select nil +(defvar-local hs-block-start-mdata-select nil "Element in `hs-block-start-regexp' match data to consider as block start. The internal function `hs-forward-sexp' moves point to the beginning of this element (using `match-beginning') before calling `hs-forward-sexp-func'.") -(make-variable-buffer-local 'hs-block-start-mdata-select) -(defvar hs-block-end-regexp nil +(defvar-local hs-block-end-regexp nil "Regexp for end of block.") -(make-variable-buffer-local 'hs-block-end-regexp) - -(defvar hs-forward-sexp-func 'forward-sexp +(defvar-local hs-forward-sexp-func 'forward-sexp "Function used to do a `forward-sexp'. Should change for Algol-ish modes. For single-character block delimiters -- ie, the syntax table regexp for the character is either `(' or `)' -- `hs-forward-sexp-func' would just be `forward-sexp'. For other modes such as simula, a more specialized function is necessary.") -(make-variable-buffer-local 'hs-forward-sexp-func) -(defvar hs-adjust-block-beginning nil +(defvar-local hs-adjust-block-beginning nil "Function used to tweak the block beginning. The block is hidden from the position returned by this function, as opposed to hiding it from the position returned when searching @@ -439,7 +433,6 @@ It should return the position from where we should start hiding. It should not move the point. See `hs-c-like-adjust-block-beginning' for an example of using this.") -(make-variable-buffer-local 'hs-adjust-block-beginning) (defvar hs-headline nil "Text of the line where a hidden block begins, set during isearch. @@ -789,6 +782,7 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments." (unless hs-allow-nesting (hs-discard-overlays (point-min) (point-max))) (goto-char (point-min)) + (syntax-propertize (point-max)) (let ((spew (make-progress-reporter "Hiding all blocks..." (point-min) (point-max))) (re (concat "\\(" diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index 3b87ff874a5..c4111398f54 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -1177,15 +1177,13 @@ Useful when source code is displayed as help. See the option (if (featurep 'font-lock) (let ((major-mode 'idlwave-mode) (font-lock-verbose - (if (called-interactively-p 'interactive) font-lock-verbose nil)) - (syntax-table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table idlwave-mode-syntax-table) - (set (make-local-variable 'font-lock-defaults) - idlwave-font-lock-defaults) - (font-lock-fontify-buffer)) - (set-syntax-table syntax-table))))) + (if (called-interactively-p 'interactive) font-lock-verbose nil))) + (with-syntax-table idlwave-mode-syntax-table + (set (make-local-variable 'font-lock-defaults) + idlwave-font-lock-defaults) + (if (fboundp 'font-lock-ensure) + (font-lock-ensure) + (font-lock-fontify-buffer)))))) (defun idlwave-help-error (name type class keyword) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 157e875fe6b..40c40eef302 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -590,27 +590,28 @@ TYPE is either 'pro' or 'rinfo', and `idlwave-shell-temp-pro-file' or (defun idlwave-shell-make-temp-file (prefix) "Create a temporary file." - ; Hard coded make-temp-file for Emacs<21 - (if (fboundp 'make-temp-file) + (if (featurep 'emacs) (make-temp-file prefix) - (let (file - (temp-file-dir (if (boundp 'temporary-file-directory) - temporary-file-directory - "/tmp"))) - (while (condition-case () - (progn - (setq file - (make-temp-name - (expand-file-name prefix temp-file-dir))) - (if (featurep 'xemacs) - (write-region "" nil file nil 'silent nil) - (write-region "" nil file nil 'silent nil 'excl)) - nil) - (file-already-exists t)) - ;; the file was somehow created by someone else between - ;; `make-temp-name' and `write-region', let's try again. - nil) - file))) + (if (fboundp 'make-temp-file) + (make-temp-file prefix) + (let (file + (temp-file-dir (if (boundp 'temporary-file-directory) + temporary-file-directory + "/tmp"))) + (while (condition-case () + (progn + (setq file + (make-temp-name + (expand-file-name prefix temp-file-dir))) + (if (featurep 'xemacs) + (write-region "" nil file nil 'silent nil) + (write-region "" nil file nil 'silent nil 'excl)) + nil) + (file-already-exists t)) + ;; the file was somehow created by someone else between + ;; `make-temp-name' and `write-region', let's try again. + nil) + file)))) (defvar idlwave-shell-dirstack-query "cd,current=___cur & print,___cur" diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index b2858c06f43..7e269cb60f0 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -3713,7 +3713,7 @@ expression to enter. The lines containing S1 and S2 are reindented using `indent-region' unless the optional second argument NOINDENT is non-nil." (if (derived-mode-p 'idlwave-shell-mode) - ;; This is a gross hack to avoit template abbrev expansion + ;; This is a gross hack to avoid template abbrev expansion ;; in the shell. FIXME: This is a dirty hack. (if (and (eq this-command 'self-insert-command) (equal last-abbrev-location (point))) diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el index b1e2b39e0c7..cdedbce9cbf 100644 --- a/lisp/progmodes/inf-lisp.el +++ b/lisp/progmodes/inf-lisp.el @@ -112,6 +112,8 @@ mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword (define-key lisp-mode-map "\C-x\C-e" 'lisp-eval-last-sexp) ; Gnu convention (define-key lisp-mode-map "\C-c\C-e" 'lisp-eval-defun) (define-key lisp-mode-map "\C-c\C-r" 'lisp-eval-region) +(define-key lisp-mode-map "\C-c\C-n" 'lisp-eval-form-and-next) +(define-key lisp-mode-map "\C-c\C-p" 'lisp-eval-paragraph) (define-key lisp-mode-map "\C-c\C-c" 'lisp-compile-defun) (define-key lisp-mode-map "\C-c\C-z" 'switch-to-lisp) (define-key lisp-mode-map "\C-c\C-l" 'lisp-load-file) @@ -311,6 +313,14 @@ of `inferior-lisp-program'). Runs the hooks from ;;;###autoload (defalias 'run-lisp 'inferior-lisp) +(defun lisp-eval-paragraph (&optional and-go) + "Send the current paragraph to the inferior Lisp process. +Prefix argument means switch to the Lisp buffer afterwards." + (interactive "P") + (save-excursion + (mark-paragraph) + (lisp-eval-region (point) (mark) and-go))) + (defun lisp-eval-region (start end &optional and-go) "Send the current region to the inferior Lisp process. Prefix argument means switch to the Lisp buffer afterwards." @@ -361,6 +371,14 @@ Prefix argument means switch to the Lisp buffer afterwards." (interactive "P") (lisp-eval-region (save-excursion (backward-sexp) (point)) (point) and-go)) +(defun lisp-eval-form-and-next () + "Send the previous sexp to the inferior Lisp process and move to the next one." + (interactive "") + (while (not (zerop (car (syntax-ppss)))) + (up-list)) + (lisp-eval-last-sexp) + (forward-sexp)) + (defun lisp-compile-region (start end &optional and-go) "Compile the current region in the inferior Lisp process. Prefix argument means switch to the Lisp buffer afterwards." diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 5ec6da48d95..c25e52cdc6a 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -248,7 +248,7 @@ name as matched contains (defconst js--function-heading-1-re (concat - "^\\s-*function\\s-+\\(" js--name-re "\\)") + "^\\s-*function\\(?:\\s-\\|\\*\\)+\\(" js--name-re "\\)") "Regexp matching the start of a JavaScript function header. Match group 1 is the name of the function.") @@ -796,6 +796,9 @@ determined. Otherwise, return nil." (let ((name t)) (forward-word) (forward-comment most-positive-fixnum) + (when (eq (char-after) ?*) + (forward-char) + (forward-comment most-positive-fixnum)) (when (looking-at js--name-re) (setq name (match-string-no-properties 0)) (goto-char (match-end 0))) @@ -1637,12 +1640,29 @@ This performs fontification according to `js--class-styles'." js--font-lock-keywords-3) "Font lock keywords for `js-mode'. See `font-lock-keywords'.") +(defconst js--syntax-propertize-regexp-syntax-table + (let ((st (make-char-table 'syntax-table (string-to-syntax ".")))) + (modify-syntax-entry ?\[ "(]" st) + (modify-syntax-entry ?\] ")[" st) + (modify-syntax-entry ?\\ "\\" st) + st)) + (defun js-syntax-propertize-regexp (end) - (when (eq (nth 3 (syntax-ppss)) ?/) - ;; A /.../ regexp. - (when (re-search-forward "\\(?:\\=\\|[^\\]\\)\\(?:\\\\\\\\\\)*/" end 'move) - (put-text-property (1- (point)) (point) - 'syntax-table (string-to-syntax "\"/"))))) + (let ((ppss (syntax-ppss))) + (when (eq (nth 3 ppss) ?/) + ;; A /.../ regexp. + (while + (when (re-search-forward "\\(?:\\=\\|[^\\]\\)\\(?:\\\\\\\\\\)*/" + end 'move) + (if (nth 1 (with-syntax-table + js--syntax-propertize-regexp-syntax-table + (let ((parse-sexp-lookup-properties nil)) + (parse-partial-sexp (nth 8 ppss) (point))))) + ;; A / within a character class is not the end of a regexp. + t + (put-text-property (1- (point)) (point) + 'syntax-table (string-to-syntax "\"/")) + nil)))))) (defun js-syntax-propertize (start end) ;; Javascript allows immediate regular expression objects, written /.../. @@ -3479,6 +3499,10 @@ If one hasn't been set, or if it's stale, prompt for a new one." '(when (fboundp 'folding-add-to-marks-list) (folding-add-to-marks-list 'js-mode "// {{{" "// }}}" ))) +;;;###autoload +(dolist (name (list "node" "nodejs" "gjs" "rhino")) + (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'js-mode))) + (provide 'js) ;; js.el ends here diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el index 1aa83da87bb..511b25486a2 100644 --- a/lisp/progmodes/m4-mode.el +++ b/lisp/progmodes/m4-mode.el @@ -65,14 +65,13 @@ If m4 is not in your PATH, set this to an absolute file name." (defvar m4-font-lock-keywords `( - ("\\(\\b\\(m4_\\)?dnl\\b\\|^\\#\\).*$" . font-lock-comment-face) -; ("\\(\\bdnl\\b\\|\\bm4_dnl\\b\\|^\\#\\).*$" . font-lock-comment-face) + ("\\(\\_<\\(m4_\\)?dnl\\_>\\).*$" . font-lock-comment-face) ("\\$[*#@0-9]" . font-lock-variable-name-face) ("\\\$\\\@" . font-lock-variable-name-face) ("\\\$\\\*" . font-lock-variable-name-face) ("\\b\\(builtin\\|change\\(com\\|quote\\|word\\)\\|d\\(e\\(bug\\(file\\|mode\\)\\|cr\\|f\\(ine\\|n\\)\\)\\|iv\\(ert\\|num\\)\\|nl\\|umpdef\\)\\|e\\(rrprint\\|syscmd\\|val\\)\\|f\\(ile\\|ormat\\)\\|gnu\\|i\\(f\\(def\\|else\\)\\|n\\(c\\(lude\\|r\\)\\|d\\(ex\\|ir\\)\\)\\)\\|l\\(en\\|ine\\)\\|m\\(4\\(exit\\|wrap\\)\\|aketemp\\)\\|p\\(atsubst\\|opdef\\|ushdef\\)\\|regexp\\|s\\(hift\\|include\\|ubstr\\|ys\\(cmd\\|val\\)\\)\\|tra\\(ceo\\(ff\\|n\\)\\|nslit\\)\\|un\\(d\\(efine\\|ivert\\)\\|ix\\)\\)\\b" . font-lock-keyword-face) ("\\b\\(m4_\\(builtin\\|change\\(com\\|quote\\|word\\)\\|d\\(e\\(bug\\(file\\|mode\\)\\|cr\\|f\\(ine\\|n\\)\\)\\|iv\\(ert\\|num\\)\\|nl\\|umpdef\\)\\|e\\(rrprint\\|syscmd\\|val\\)\\|f\\(ile\\|ormat\\)\\|i\\(f\\(def\\|else\\)\\|n\\(c\\(lude\\|r\\)\\|d\\(ex\\|ir\\)\\)\\)\\|l\\(en\\|ine\\)\\|m\\(4\\(_undefine\\|exit\\|wrap\\)\\|aketemp\\)\\|p\\(atsubst\\|opdef\\|ushdef\\)\\|regexp\\|s\\(hift\\|include\\|ubstr\\|ys\\(cmd\\|val\\)\\)\\|tra\\(ceo\\(ff\\|n\\)\\|nslit\\)\\|undivert\\)\\)\\b" . font-lock-keyword-face)) - "Default font-lock-keywords for `m4 mode'.") + "Default `font-lock-keywords' for M4 mode.") (defcustom m4-mode-hook nil "Hook called by `m4-mode'." @@ -86,19 +85,26 @@ If m4 is not in your PATH, set this to an absolute file name." (modify-syntax-entry ?' ")`" table) (modify-syntax-entry ?# "<\n" table) (modify-syntax-entry ?\n ">#" table) - (modify-syntax-entry ?{ "_" table) - (modify-syntax-entry ?} "_" table) - ;; FIXME: This symbol syntax for underscore looks OK on its own, but it's - ;; odd that it should have the same syntax as { and } are these really - ;; valid in m4 symbols? + (modify-syntax-entry ?{ "." table) + (modify-syntax-entry ?} "." table) (modify-syntax-entry ?_ "_" table) - ;; FIXME: These three chars with word syntax look wrong. - (modify-syntax-entry ?* "w" table) - (modify-syntax-entry ?\" "w" table) - (modify-syntax-entry ?\" "w" table) + (modify-syntax-entry ?* "." table) + (modify-syntax-entry ?\" "." table) table) "Syntax table used while in `m4-mode'.") +(defun m4--quoted-p (pos) + "Return non-nil if POS is inside a quoted string." + (let ((quoted nil)) + (dolist (o (nth 9 (save-excursion (syntax-ppss pos)))) + (if (eq (char-after o) ?\`) (setq quoted t))) + quoted)) + +(defconst m4-syntax-propertize + (syntax-propertize-rules + ("#" (0 (when (m4--quoted-p (match-beginning 0)) + (string-to-syntax ".")))))) + (defvar m4-mode-map (let ((map (make-sparse-keymap)) (menu-map (make-sparse-keymap))) @@ -148,7 +154,8 @@ If m4 is not in your PATH, set this to an absolute file name." (setq-local comment-start "#") (setq-local parse-sexp-ignore-comments t) (setq-local add-log-current-defun-function #'m4-current-defun-name) - (setq font-lock-defaults '(m4-font-lock-keywords nil))) + (setq-local syntax-propertize-function m4-syntax-propertize) + (setq-local font-lock-defaults '(m4-font-lock-keywords nil))) (provide 'm4-mode) ;;stuff to play with for debugging diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index 66272ce0d13..8541cced3a5 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -45,13 +45,13 @@ (defun completion-table-with-cache (fun &optional ignore-case) ;; See eg bug#11906. (let* (last-arg last-result - (new-fun - (lambda (arg) - (if (and last-arg (string-prefix-p last-arg arg ignore-case)) - last-result - (prog1 - (setq last-result (funcall fun arg)) - (setq last-arg arg)))))) + (new-fun + (lambda (arg) + (if (and last-arg (string-prefix-p last-arg arg ignore-case)) + last-result + (prog1 + (setq last-result (funcall fun arg)) + (setq last-arg arg)))))) (completion-table-dynamic new-fun))))) (eval-when-compile (unless (fboundp 'setq-local) @@ -601,7 +601,8 @@ Key bindings: (add-hook 'before-save-hook 'octave-sync-function-file-names nil t) (setq-local beginning-of-defun-function 'octave-beginning-of-defun) (and octave-font-lock-texinfo-comment (octave-font-lock-texinfo-comment)) - (setq-local eldoc-documentation-function 'octave-eldoc-function) + (add-function :before-until (local 'eldoc-documentation-function) + 'octave-eldoc-function) (easy-menu-add octave-mode-menu)) diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el index e2b1623d3f9..2eba620ceb2 100644 --- a/lisp/progmodes/opascal.el +++ b/lisp/progmodes/opascal.el @@ -1397,7 +1397,7 @@ If before the indent, the point is moved to the indent." (when opascal-debug (opascal-ensure-buffer opascal-debug-buffer "*OPascal Debug Log*") (opascal-log-msg opascal-debug-buffer - (concat (format-time-string "%H:%M:%S " (current-time)) + (concat (format-time-string "%H:%M:%S ") (apply #'format (cons format-string args)) "\n")))) diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 01fa5da96c1..a64944f0dc5 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -66,22 +66,7 @@ ;; a rich language; writing a more suitable parser would be a big job): ;; 2) The globbing syntax <pattern> is not recognized, so special ;; characters in the pattern string must be backslashed. -;; 3) The << quoting operators are not recognized; see below. -;; 5) To make '$' work correctly, $' is not recognized as a variable. -;; Use "$'" or $POSTMATCH instead. ;; -;; If you don't use font-lock, additional problems will appear: -;; 1) Regular expression delimiters do not act as quotes, so special -;; characters such as `'"#:;[](){} may need to be backslashed -;; in regular expressions and in both parts of s/// and tr///. -;; 4) The q and qq quoting operators are not recognized; see below. -;; 5) To make variables such a $' and $#array work, perl-mode treats -;; $ just like backslash, so '$' is not treated correctly. -;; 6) Unfortunately, treating $ like \ makes ${var} be treated as an -;; unmatched }. See below. -;; 7) When ' (quote) is used as a package name separator, perl-mode -;; doesn't understand, and thinks it is seeing a quoted string. - ;; Here are some ugly tricks to bypass some of these problems: the perl ;; expression /`/ (that's a back-tick) usually evaluates harmlessly, ;; but will trick perl-mode into starting a quoted string, which @@ -218,6 +203,13 @@ (defvar perl-quote-like-pairs '((?\( . ?\)) (?\[ . ?\]) (?\{ . ?\}) (?\< . ?\>))) +(eval-and-compile + (defconst perl--syntax-exp-intro-regexp + (concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)" + (regexp-opt '("split" "if" "unless" "until" "while" "print" + "grep" "map" "not" "or" "and" "for" "foreach")) + "\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*"))) + ;; FIXME: handle here-docs and regexps. ;; <<EOF <<"EOF" <<'EOF' (no space) ;; see `man perlop' @@ -262,7 +254,7 @@ (1 (prog1 "\"" (perl-syntax-propertize-special-constructs end)))) ;; Funny things in `sub' arg-specs like `sub myfun ($)' or `sub ($)'. ;; Be careful not to match "sub { (...) ... }". - ("\\<sub\\(?:[[:space:]]+[^{}[:punct:][:space:]]+\\)?[[:space:]]*(\\([^)]+\\))" + ("\\<sub\\(?:[\s\t\n]+\\(?:\\sw\\|\\s_\\)+\\)?[\s\t\n]*(\\([^)]+\\))" (1 ".")) ;; Turn __DATA__ trailer into a comment. ("^\\(_\\)_\\(?:DATA\\|END\\)__[ \t]*\\(?:\\(\n\\)#.-\\*-.*perl.*-\\*-\\|\n.*\\)" @@ -278,10 +270,7 @@ ;; *opening* slash. We can afford to mis-match the closing ones ;; here, because they will be re-treated separately later in ;; perl-font-lock-special-syntactic-constructs. - ((concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)" - (regexp-opt '("split" "if" "unless" "until" "while" "split" - "grep" "map" "not" "or" "and" "for" "foreach")) - "\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)") + ((concat perl--syntax-exp-intro-regexp "\\(/\\)") (2 (ignore (if (and (match-end 1) ; / at BOL. (save-excursion @@ -316,10 +305,15 @@ (string-to-syntax "\""))) (perl-syntax-propertize-special-constructs end))))) ;; Here documents. - ;; TODO: Handle <<WORD. These are trickier because you need to - ;; disambiguate with the shift operator. - ("<<[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\).*\\(\n\\)" - (2 (let* ((st (get-text-property (match-beginning 2) 'syntax-table)) + ((concat + "\\(?:" + ;; << "EOF", << 'EOF', or << \EOF + "<<[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\)" + ;; The <<EOF case which needs perl--syntax-exp-intro-regexp, to + ;; disambiguate with the left-bitshift operator. + "\\|" perl--syntax-exp-intro-regexp "<<\\(?1:\\sw+\\)\\)" + ".*\\(\n\\)") + (3 (let* ((st (get-text-property (match-beginning 3) 'syntax-table)) (name (match-string 1))) (goto-char (match-end 1)) (if (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) @@ -329,7 +323,8 @@ ;; Remember the names of heredocs found on this line. (cons (pcase (aref name 0) (`?\\ (substring name 1)) - (_ (substring name 1 -1))) + ((or `?\" `?\' `?\`) (substring name 1 -1)) + (_ name)) (cdr st))))))) ;; We don't call perl-syntax-propertize-special-constructs directly ;; from the << rule, because there might be other elements (between @@ -753,7 +748,7 @@ following list: (bof (perl-beginning-of-function)) (delta (progn (goto-char oldpnt) - (perl-indent-line "\f\\|;?#" bof)))) + (perl-indent-line "\f\\|;?#")))) (and perl-tab-to-comment (= oldpnt (point)) ; done if point moved (if (listp delta) ; if line starts in a quoted string @@ -791,28 +786,23 @@ following list: (ding t))))))))) (make-obsolete 'perl-indent-command 'indent-according-to-mode "24.4") -(defun perl-indent-line (&optional nochange parse-start) +(defun perl-indent-line (&optional nochange) "Indent current line as Perl code. Return the amount the indentation changed by, or (parse-state) if line starts in a quoted string." (let ((case-fold-search nil) (pos (- (point-max) (point))) - (bof (or parse-start (save-excursion - ;; Don't consider text on this line as a - ;; valid BOF from which to indent. - (goto-char (line-end-position 0)) - (perl-beginning-of-function)))) beg indent shift-amt) (beginning-of-line) (setq beg (point)) (setq shift-amt - (cond ((eq (char-after bof) ?=) 0) - ((listp (setq indent (perl-calculate-indent bof))) indent) + (cond ((eq 1 (nth 7 (syntax-ppss))) 0) ;For doc sections! + ((listp (setq indent (perl-calculate-indent))) indent) ((eq 'noindent indent) indent) ((looking-at (or nochange perl-nochange)) 0) (t (skip-chars-forward " \t\f") - (setq indent (perl-indent-new-calculate nil indent bof)) + (setq indent (perl-indent-new-calculate nil indent)) (- indent (current-column))))) (skip-chars-forward " \t\f") (if (and (numberp shift-amt) (/= 0 shift-amt)) @@ -824,23 +814,21 @@ changed by, or (parse-state) if line starts in a quoted string." (goto-char (- (point-max) pos))) shift-amt)) -(defun perl-continuation-line-p (limit) +(defun perl-continuation-line-p () "Move to end of previous line and return non-nil if continued." ;; Statement level. Is it a continuation or a new statement? ;; Find previous non-comment character. (perl-backward-to-noncomment) ;; Back up over label lines, since they don't ;; affect whether our line is a continuation. - (while (or (eq (preceding-char) ?\,) - (and (eq (preceding-char) ?:) - (memq (char-syntax (char-after (- (point) 2))) - '(?w ?_)))) - (if (eq (preceding-char) ?\,) - (perl-backward-to-start-of-continued-exp limit) - (beginning-of-line)) + (while (and (eq (preceding-char) ?:) + (memq (char-syntax (char-after (- (point) 2))) + '(?w ?_))) + (beginning-of-line) (perl-backward-to-noncomment)) ;; Now we get the answer. - (not (memq (preceding-char) '(?\; ?\} ?\{)))) + (unless (memq (preceding-char) '(?\; ?\} ?\{)) + (preceding-char))) (defun perl-hanging-paren-p () "Non-nil if we are right after a hanging parenthesis-like char." @@ -848,173 +836,151 @@ changed by, or (parse-state) if line starts in a quoted string." (save-excursion (skip-syntax-backward " (") (not (bolp))))) -(defun perl-indent-new-calculate (&optional virtual default parse-start) +(defun perl-indent-new-calculate (&optional virtual default) (or (and virtual (save-excursion (skip-chars-backward " \t") (bolp)) (current-column)) (and (looking-at "\\(\\w\\|\\s_\\)+:[^:]") - (max 1 (+ (or default (perl-calculate-indent parse-start)) + (max 1 (+ (or default (perl-calculate-indent)) perl-label-offset))) (and (= (char-syntax (following-char)) ?\)) (save-excursion (forward-char 1) (when (condition-case nil (progn (forward-sexp -1) t) (scan-error nil)) - (perl-indent-new-calculate - ;; Recalculate the parsing-start, since we may have jumped - ;; dangerously close (typically in the case of nested functions). - 'virtual nil (save-excursion (perl-beginning-of-function)))))) + (perl-indent-new-calculate 'virtual)))) (and (and (= (following-char) ?{) (save-excursion (forward-char) (perl-hanging-paren-p))) - (+ (or default (perl-calculate-indent parse-start)) + (+ (or default (perl-calculate-indent)) perl-brace-offset)) - (or default (perl-calculate-indent parse-start)))) + (or default (perl-calculate-indent)))) -(defun perl-calculate-indent (&optional parse-start) +(defun perl-calculate-indent () "Return appropriate indentation for current line as Perl code. In usual case returns an integer: the column to indent to. -Returns (parse-state) if line starts inside a string. -Optional argument PARSE-START should be the position of `beginning-of-defun'." +Returns (parse-state) if line starts inside a string." (save-excursion (let ((indent-point (point)) (case-fold-search nil) (colon-line-end 0) + prev-char state containing-sexp) - (if parse-start ;used to avoid searching - (goto-char parse-start) - (perl-beginning-of-function)) - ;; We might be now looking at a local function that has nothing to - ;; do with us because `indent-point' is past it. In this case - ;; look further back up for another `perl-beginning-of-function'. - (while (and (looking-at "{") - (save-excursion - (beginning-of-line) - (looking-at "\\s-+sub\\>")) - (> indent-point (save-excursion - (condition-case nil - (forward-sexp 1) - (scan-error nil)) - (point)))) - (perl-beginning-of-function)) - (while (< (point) indent-point) ;repeat until right sexp - (setq state (parse-partial-sexp (point) indent-point 0)) - ;; state = (depth_in_parens innermost_containing_list - ;; last_complete_sexp string_terminator_or_nil inside_commentp - ;; following_quotep minimum_paren-depth_this_scan) - ;; Parsing stops if depth in parentheses becomes equal to third arg. - (setq containing-sexp (nth 1 state))) + (setq containing-sexp (nth 1 (syntax-ppss indent-point))) (cond ;; Don't auto-indent in a quoted string or a here-document. ((or (nth 3 state) (eq 2 (nth 7 state))) 'noindent) - ((null containing-sexp) ; Line is at top level. - (skip-chars-forward " \t\f") - (if (memq (following-char) - (if perl-indent-parens-as-block '(?\{ ?\( ?\[) '(?\{))) - 0 ; move to beginning of line if it starts a function body - ;; indent a little if this is a continuation line - (perl-backward-to-noncomment) - (if (or (bobp) - (memq (preceding-char) '(?\; ?\}))) - 0 perl-continued-statement-offset))) - ((/= (char-after containing-sexp) ?{) - ;; line is expression, not statement: - ;; indent to just after the surrounding open. - (goto-char (1+ containing-sexp)) - (if (perl-hanging-paren-p) - ;; We're indenting an arg of a call like: - ;; $a = foobarlongnamefun ( - ;; arg1 - ;; arg2 - ;; ); - (progn - (skip-syntax-backward "(") - (condition-case nil - (while (save-excursion - (skip-syntax-backward " ") (not (bolp))) - (forward-sexp -1)) - (scan-error nil)) - (+ (current-column) perl-indent-level)) - (if perl-indent-continued-arguments - (+ perl-indent-continued-arguments (current-indentation)) - (skip-chars-forward " \t") - (current-column)))) - (t - ;; Statement level. Is it a continuation or a new statement? - (if (perl-continuation-line-p containing-sexp) - ;; This line is continuation of preceding line's statement; - ;; indent perl-continued-statement-offset more than the - ;; previous line of the statement. - (progn - (perl-backward-to-start-of-continued-exp containing-sexp) - (+ (if (save-excursion - (perl-continuation-line-p containing-sexp)) - ;; If the continued line is itself a continuation - ;; line, then align, otherwise add an offset. - 0 perl-continued-statement-offset) - (current-column) - (if (save-excursion (goto-char indent-point) - (looking-at - (if perl-indent-parens-as-block - "[ \t]*[{(\[]" "[ \t]*{"))) - perl-continued-brace-offset 0))) - ;; This line starts a new statement. - ;; Position at last unclosed open. - (goto-char containing-sexp) - (or - ;; Is line first statement after an open-brace? - ;; If no, find that first statement and indent like it. - (save-excursion - (forward-char 1) - ;; Skip over comments and labels following openbrace. - (while (progn - (skip-chars-forward " \t\f\n") - (cond ((looking-at ";?#") - (forward-line 1) t) - ((looking-at "\\(\\w\\|\\s_\\)+:[^:]") - (setq colon-line-end (line-end-position)) - (search-forward ":"))))) - ;; The first following code counts - ;; if it is before the line we want to indent. - (and (< (point) indent-point) - (if (> colon-line-end (point)) - (- (current-indentation) perl-label-offset) - (current-column)))) - ;; If no previous statement, - ;; indent it relative to line brace is on. - ;; For open paren in column zero, don't let statement - ;; start there too. If perl-indent-level is zero, - ;; use perl-brace-offset + perl-continued-statement-offset - ;; For open-braces not the first thing in a line, - ;; add in perl-brace-imaginary-offset. - (+ (if (and (bolp) (zerop perl-indent-level)) - (+ perl-brace-offset perl-continued-statement-offset) - perl-indent-level) - ;; Move back over whitespace before the openbrace. - ;; If openbrace is not first nonwhite thing on the line, - ;; add the perl-brace-imaginary-offset. - (progn (skip-chars-backward " \t") - (if (bolp) 0 perl-brace-imaginary-offset)) - ;; If the openbrace is preceded by a parenthesized exp, - ;; move to the beginning of that; - ;; possibly a different line - (progn - (if (eq (preceding-char) ?\)) - (forward-sexp -1)) - ;; Get initial indentation of the line we are on. - (current-indentation)))))))))) + ((null containing-sexp) ; Line is at top level. + (skip-chars-forward " \t\f") + (if (memq (following-char) + (if perl-indent-parens-as-block '(?\{ ?\( ?\[) '(?\{))) + 0 ; move to beginning of line if it starts a function body + ;; indent a little if this is a continuation line + (perl-backward-to-noncomment) + (if (or (bobp) + (memq (preceding-char) '(?\; ?\}))) + 0 perl-continued-statement-offset))) + ((/= (char-after containing-sexp) ?{) + ;; line is expression, not statement: + ;; indent to just after the surrounding open. + (goto-char (1+ containing-sexp)) + (if (perl-hanging-paren-p) + ;; We're indenting an arg of a call like: + ;; $a = foobarlongnamefun ( + ;; arg1 + ;; arg2 + ;; ); + (progn + (skip-syntax-backward "(") + (condition-case nil + (while (save-excursion + (skip-syntax-backward " ") (not (bolp))) + (forward-sexp -1)) + (scan-error nil)) + (+ (current-column) perl-indent-level)) + (if perl-indent-continued-arguments + (+ perl-indent-continued-arguments (current-indentation)) + (skip-chars-forward " \t") + (current-column)))) + ;; Statement level. Is it a continuation or a new statement? + ((setq prev-char (perl-continuation-line-p)) + ;; This line is continuation of preceding line's statement; + ;; indent perl-continued-statement-offset more than the + ;; previous line of the statement. + (perl-backward-to-start-of-continued-exp) + (+ (if (or (save-excursion + (perl-continuation-line-p)) + (and (eq prev-char ?\,) + (looking-at "[[:alnum:]_]+[ \t\n]*=>"))) + ;; If the continued line is itself a continuation + ;; line, then align, otherwise add an offset. + 0 perl-continued-statement-offset) + (current-column) + (if (save-excursion (goto-char indent-point) + (looking-at + (if perl-indent-parens-as-block + "[ \t]*[{(\[]" "[ \t]*{"))) + perl-continued-brace-offset 0))) + (t + ;; This line starts a new statement. + ;; Position at last unclosed open. + (goto-char containing-sexp) + (or + ;; Is line first statement after an open-brace? + ;; If no, find that first statement and indent like it. + (save-excursion + (forward-char 1) + ;; Skip over comments and labels following openbrace. + (while (progn + (skip-chars-forward " \t\f\n") + (cond ((looking-at ";?#") + (forward-line 1) t) + ((looking-at "\\(\\w\\|\\s_\\)+:[^:]") + (setq colon-line-end (line-end-position)) + (search-forward ":"))))) + ;; The first following code counts + ;; if it is before the line we want to indent. + (and (< (point) indent-point) + (if (> colon-line-end (point)) + (- (current-indentation) perl-label-offset) + (current-column)))) + ;; If no previous statement, + ;; indent it relative to line brace is on. + ;; For open paren in column zero, don't let statement + ;; start there too. If perl-indent-level is zero, + ;; use perl-brace-offset + perl-continued-statement-offset + ;; For open-braces not the first thing in a line, + ;; add in perl-brace-imaginary-offset. + (+ (if (and (bolp) (zerop perl-indent-level)) + (+ perl-brace-offset perl-continued-statement-offset) + perl-indent-level) + ;; Move back over whitespace before the openbrace. + ;; If openbrace is not first nonwhite thing on the line, + ;; add the perl-brace-imaginary-offset. + (progn (skip-chars-backward " \t") + (if (bolp) 0 perl-brace-imaginary-offset)) + ;; If the openbrace is preceded by a parenthesized exp, + ;; move to the beginning of that; + ;; possibly a different line + (progn + (if (eq (preceding-char) ?\)) + (forward-sexp -1)) + ;; Get initial indentation of the line we are on. + (current-indentation))))))))) (defun perl-backward-to-noncomment () "Move point backward to after the first non-white-space, skipping comments." - (interactive) (forward-comment (- (point-max)))) -(defun perl-backward-to-start-of-continued-exp (lim) - (if (= (preceding-char) ?\)) - (forward-sexp -1)) - (beginning-of-line) - (if (<= (point) lim) - (goto-char (1+ lim))) - (skip-chars-forward " \t\f")) +(defun perl-backward-to-start-of-continued-exp () + (while + (let ((c (preceding-char))) + (cond + ((memq c '(?\; ?\{ ?\[ ?\()) (forward-comment (point-max)) nil) + ((memq c '(?\) ?\] ?\} ?\")) + (forward-sexp -1) (forward-comment (- (point))) t) + ((eq ?w (char-syntax c)) + (forward-word -1) (forward-comment (- (point))) t) + (t (forward-char -1) (forward-comment (- (point))) t))))) ;; note: this may be slower than the c-mode version, but I can understand it. (defalias 'indent-perl-exp 'perl-indent-exp) @@ -1039,7 +1005,7 @@ Optional argument PARSE-START should be the position of `beginning-of-defun'." (setq lsexp-mark bof-mark) (beginning-of-line) (while (< (point) (marker-position last-mark)) - (setq delta (perl-indent-line nil (marker-position bof-mark))) + (setq delta (perl-indent-line nil)) (if (numberp delta) ; unquoted start-of-line? (progn (if (eolp) diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el index e364c8335aa..0d9fabd2057 100644 --- a/lisp/progmodes/prog-mode.el +++ b/lisp/progmodes/prog-mode.el @@ -35,6 +35,13 @@ "Generic programming mode, from which others derive." :group 'languages) +(defcustom prog-mode-hook nil + "Normal hook run when entering programming modes." + :type 'hook + :options '(flyspell-prog-mode abbrev-mode flymake-mode linum-mode + prettify-symbols-mode) + :group 'prog-mode) + (defvar prog-mode-map (let ((map (make-sparse-keymap))) (define-key map [?\C-\M-q] 'prog-indent-sexp) @@ -118,7 +125,7 @@ support it." (font-lock-add-keywords nil prettify-symbols--keywords) (setq-local font-lock-extra-managed-props (cons 'composition font-lock-extra-managed-props)) - (font-lock-fontify-buffer)) + (font-lock-flush)) ;; Turn off (when prettify-symbols--keywords (font-lock-remove-keywords nil prettify-symbols--keywords) diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index d2a1f0b92a1..2d95345b531 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -3342,8 +3342,6 @@ PREFIX is the prefix of the search regexp." ["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 () diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el index 6084068dc5c..077be53e2fb 100644 --- a/lisp/progmodes/ps-mode.el +++ b/lisp/progmodes/ps-mode.el @@ -41,6 +41,7 @@ (require 'comint) (require 'easymenu) +(require 'smie) ;; Define core `PostScript' group. (defgroup PostScript nil @@ -60,10 +61,7 @@ ;; User variables. -(defcustom ps-mode-auto-indent t - "Should we use autoindent?" - :group 'PostScript-edit - :type 'boolean) +(make-obsolete-variable 'ps-mode-auto-indent 'electric-indent-mode "25.1") (defcustom ps-mode-tab 4 "Number of spaces to use when indenting." @@ -204,7 +202,7 @@ If nil, use `temporary-file-directory'." "bind" "null" "gsave" "grestore" "grestoreall" "showpage"))) - (concat "\\<" (regexp-opt ops t) "\\>")) + (concat "\\_<" (regexp-opt ops t) "\\_>")) "Regexp of PostScript operators that will be fontified.") ;; Level 1 font-lock: @@ -214,13 +212,9 @@ If nil, use `temporary-file-directory'." ;; - 8bit characters (warning face) ;; Multiline strings are not supported. Strings with nested brackets are. (defconst ps-mode-font-lock-keywords-1 - '(("\\`%!PS.*" . font-lock-constant-face) + '(("\\`%!PS.*" (0 font-lock-constant-face t)) ("^%%BoundingBox:[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]*$" - . font-lock-constant-face) - (ps-mode-match-string-or-comment - (1 font-lock-comment-face nil t) - (2 font-lock-string-face nil t)) - ("([^()\n%]*\\|[^()\n]*)" . font-lock-warning-face) + (0 font-lock-constant-face t)) ("[\200-\377]+" (0 font-lock-warning-face prepend nil))) "Subdued level highlighting for PostScript mode.") @@ -255,19 +249,17 @@ If nil, use `temporary-file-directory'." ;; Names are fontified before PostScript operators, allowing the use of ;; a more simple (efficient) regexp than the one used in level 2. (defconst ps-mode-font-lock-keywords-3 - (append - ps-mode-font-lock-keywords-1 - (list - '("//\\w+" . font-lock-type-face) - `(,(concat - "^\\(/\\w+\\)\\>" - "\\([[ \t]*\\(%.*\\)?\r?$" ; Nothing but `[' or comment after the name. - "\\|[ \t]*\\({\\|<<\\)" ; `{' or `<<' following the name. - "\\|[ \t]+[0-9]+[ \t]+dict\\>" ; `[0-9]+ dict' following the name. - "\\|.*\\<def\\>\\)") ; `def' somewhere on the same line. - . (1 font-lock-function-name-face)) - '("/\\w+" . font-lock-variable-name-face) - (cons ps-mode-operators 'font-lock-keyword-face))) + `(,@ps-mode-font-lock-keywords-1 + ("//\\(?:\\sw\\|\\s_\\)+" . font-lock-type-face) + (,(concat + "^\\(/\\(?:\\sw\\|\\s_\\)+\\)\\_>" + "\\([[ \t]*\\(%.*\\)?\r?$" ; Nothing but `[' or comment after the name. + "\\|[ \t]*\\({\\|<<\\)" ; `{' or `<<' following the name. + "\\|[ \t]+[0-9]+[ \t]+dict\\_>" ; `[0-9]+ dict' following the name. + "\\|.*\\_<def\\_>\\)") ; `def' somewhere on the same line. + . (1 font-lock-function-name-face)) + ("/\\(?:\\sw\\|\\s_\\)+" . font-lock-variable-name-face) + (,ps-mode-operators . font-lock-keyword-face)) "High level highlighting for PostScript mode.") (defconst ps-mode-font-lock-keywords ps-mode-font-lock-keywords-1 @@ -289,13 +281,68 @@ If nil, use `temporary-file-directory'." ;; Variables. -(defvar ps-mode-map nil +(defvar ps-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-v" 'ps-run-boundingbox) + (define-key map "\C-c\C-u" 'ps-mode-uncomment-region) + (define-key map "\C-c\C-t" 'ps-mode-epsf-rich) + (define-key map "\C-c\C-s" 'ps-run-start) + (define-key map "\C-c\C-r" 'ps-run-region) + (define-key map "\C-c\C-q" 'ps-run-quit) + (define-key map "\C-c\C-p" 'ps-mode-print-buffer) + (define-key map "\C-c\C-o" 'ps-mode-comment-out-region) + (define-key map "\C-c\C-k" 'ps-run-kill) + (define-key map "\C-c\C-j" 'ps-mode-other-newline) + (define-key map "\C-c\C-l" 'ps-run-clear) + (define-key map "\C-c\C-b" 'ps-run-buffer) + ;; FIXME: Add `indent' to backward-delete-char-untabify-method instead? + (define-key map "\177" 'ps-mode-backward-delete-char) + map) "Local keymap to use in PostScript mode.") -(defvar ps-mode-syntax-table nil +(defvar ps-mode-syntax-table + (let ((st (make-syntax-table))) + + (modify-syntax-entry ?\% "< " st) + (modify-syntax-entry ?\n "> " st) + (modify-syntax-entry ?\r "> " st) + (modify-syntax-entry ?\f "> " 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) + (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) + (modify-syntax-entry ?\= "_ " st) + (modify-syntax-entry ?\? "_ " st) + (modify-syntax-entry ?\@ "_ " st) + (modify-syntax-entry ?\\ "\\" st) + (modify-syntax-entry ?^ "_ " st) ; NOT: ?\^ + (modify-syntax-entry ?\_ "_ " st) + (modify-syntax-entry ?\` "_ " st) + (modify-syntax-entry ?\| "_ " st) + (modify-syntax-entry ?\~ "_ " st) + st) "Syntax table used while in PostScript mode.") -(defvar ps-run-mode-map nil +(defvar ps-run-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map comint-mode-map) + (define-key map "\C-c\C-q" 'ps-run-quit) + (define-key map "\C-c\C-k" 'ps-run-kill) + (define-key map "\C-c\C-e" 'ps-run-goto-error) + (define-key map [mouse-2] 'ps-run-mouse-goto-error) + map) "Local keymap to use in PostScript run mode.") (defvar ps-mode-tmp-file nil @@ -365,9 +412,6 @@ If nil, use `temporary-file-directory'." ["8-bit to Octal Buffer" ps-mode-octal-buffer t] ["8-bit to Octal Region" ps-mode-octal-region (mark t)] "---" - ["Auto Indent" (setq ps-mode-auto-indent (not ps-mode-auto-indent)) - :style toggle :selected ps-mode-auto-indent] - "---" ["Start PostScript" ps-run-start t] @@ -404,79 +448,7 @@ If nil, use `temporary-file-directory'." ps-mode-submit-bug-report t])) - -;; Mode maps for PostScript edit mode and PostScript interaction mode. - -(unless ps-mode-map - (setq ps-mode-map (make-sparse-keymap)) - (define-key ps-mode-map "\C-c\C-v" 'ps-run-boundingbox) - (define-key ps-mode-map "\C-c\C-u" 'ps-mode-uncomment-region) - (define-key ps-mode-map "\C-c\C-t" 'ps-mode-epsf-rich) - (define-key ps-mode-map "\C-c\C-s" 'ps-run-start) - (define-key ps-mode-map "\C-c\C-r" 'ps-run-region) - (define-key ps-mode-map "\C-c\C-q" 'ps-run-quit) - (define-key ps-mode-map "\C-c\C-p" 'ps-mode-print-buffer) - (define-key ps-mode-map "\C-c\C-o" 'ps-mode-comment-out-region) - (define-key ps-mode-map "\C-c\C-k" 'ps-run-kill) - (define-key ps-mode-map "\C-c\C-j" 'ps-mode-other-newline) - (define-key ps-mode-map "\C-c\C-l" 'ps-run-clear) - (define-key ps-mode-map "\C-c\C-b" 'ps-run-buffer) - (define-key ps-mode-map ">" 'ps-mode-r-gt) - (define-key ps-mode-map "]" 'ps-mode-r-angle) - (define-key ps-mode-map "}" 'ps-mode-r-brace) - (define-key ps-mode-map "\177" 'ps-mode-backward-delete-char) - (define-key ps-mode-map "\t" 'ps-mode-tabkey) - (define-key ps-mode-map "\r" 'ps-mode-newline) - (easy-menu-define ps-mode-main ps-mode-map "PostScript" ps-mode-menu-main)) - -(unless ps-run-mode-map - (setq ps-run-mode-map (make-sparse-keymap)) - (set-keymap-parent ps-run-mode-map comint-mode-map) - (define-key ps-run-mode-map "\C-c\C-q" 'ps-run-quit) - (define-key ps-run-mode-map "\C-c\C-k" 'ps-run-kill) - (define-key ps-run-mode-map "\C-c\C-e" 'ps-run-goto-error) - (define-key ps-run-mode-map [mouse-2] 'ps-run-mouse-goto-error)) - - -;; Syntax table. - -(unless ps-mode-syntax-table - (setq ps-mode-syntax-table (make-syntax-table)) - - (modify-syntax-entry ?\% "< " ps-mode-syntax-table) - (modify-syntax-entry ?\n "> " ps-mode-syntax-table) - (modify-syntax-entry ?\r "> " ps-mode-syntax-table) - (modify-syntax-entry ?\f "> " ps-mode-syntax-table) - (modify-syntax-entry ?\< "(>" ps-mode-syntax-table) - (modify-syntax-entry ?\> ")<" ps-mode-syntax-table) - - (modify-syntax-entry ?\! "w " ps-mode-syntax-table) - (modify-syntax-entry ?\" "w " ps-mode-syntax-table) - (modify-syntax-entry ?\# "w " ps-mode-syntax-table) - (modify-syntax-entry ?\$ "w " ps-mode-syntax-table) - (modify-syntax-entry ?\& "w " ps-mode-syntax-table) - (modify-syntax-entry ?\' "w " ps-mode-syntax-table) - (modify-syntax-entry ?\* "w " ps-mode-syntax-table) - (modify-syntax-entry ?\+ "w " ps-mode-syntax-table) - (modify-syntax-entry ?\, "w " ps-mode-syntax-table) - (modify-syntax-entry ?\- "w " ps-mode-syntax-table) - (modify-syntax-entry ?\. "w " ps-mode-syntax-table) - (modify-syntax-entry ?\: "w " ps-mode-syntax-table) - (modify-syntax-entry ?\; "w " ps-mode-syntax-table) - (modify-syntax-entry ?\= "w " ps-mode-syntax-table) - (modify-syntax-entry ?\? "w " ps-mode-syntax-table) - (modify-syntax-entry ?\@ "w " ps-mode-syntax-table) - (modify-syntax-entry ?\\ "w " ps-mode-syntax-table) - (modify-syntax-entry ?^ "w " ps-mode-syntax-table) ; NOT: ?\^ - (modify-syntax-entry ?\_ "w " ps-mode-syntax-table) - (modify-syntax-entry ?\` "w " ps-mode-syntax-table) - (modify-syntax-entry ?\| "w " ps-mode-syntax-table) - (modify-syntax-entry ?\~ "w " ps-mode-syntax-table) - - (let ((i 128)) - (while (< i 256) - (modify-syntax-entry i "w " ps-mode-syntax-table) - (setq i (1+ i))))) +(easy-menu-define ps-mode-main ps-mode-map "PostScript" ps-mode-menu-main) @@ -484,6 +456,13 @@ If nil, use `temporary-file-directory'." ;; PostScript mode. +(defun ps-mode-smie-rules (kind token) + (pcase (cons kind token) + (`(:after . "<") (when (smie-rule-next-p "<") 0)) + (`(:elem . basic) ps-mode-tab) + (`(:close-all . ">") t) + (`(:list-intro . ,_) t))) + ;;;###autoload (define-derived-mode ps-mode prog-mode "PostScript" "Major mode for editing PostScript with GNU Emacs. @@ -493,7 +472,6 @@ Entry to this mode calls `ps-mode-hook'. The following variables hold user options, and can be set through the `customize' command: - `ps-mode-auto-indent' `ps-mode-tab' `ps-mode-paper-size' `ps-mode-print-function' @@ -523,12 +501,16 @@ with a file position. Clicking mouse-2 on this number will bring point to the corresponding spot in the PostScript window, if input to the interpreter was sent from that window. Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number has the same effect." + (setq-local syntax-propertize-function #'ps-mode-syntax-propertize) (set (make-local-variable 'font-lock-defaults) '((ps-mode-font-lock-keywords ps-mode-font-lock-keywords-1 ps-mode-font-lock-keywords-2 ps-mode-font-lock-keywords-3) - t)) + nil)) + (smie-setup nil #'ps-mode-smie-rules) + (setq-local electric-indent-chars + (append '(?> ?\] ?\}) electric-indent-chars)) (set (make-local-variable 'comment-start) "%") ;; NOTE: `\' has a special meaning in strings only (set (make-local-variable 'comment-start-skip) "%+[ \t]*") @@ -555,8 +537,7 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number (reporter-submit-bug-report ps-mode-maintainer-address (format "ps-mode.el %s [%s]" ps-mode-version system-type) - '(ps-mode-auto-indent - ps-mode-tab + '(ps-mode-tab ps-mode-paper-size ps-mode-print-function ps-run-prompt @@ -570,53 +551,54 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number ;; Helper functions for font-lock. -;; When this function is called, point is at an opening bracket. -;; This function should test if point is at the start of a string -;; with nested brackets. -;; If true: move point to end of string -;; set string to match data nr 2 -;; return new point -;; If false: return nil -(defun ps-mode-looking-at-nested (limit) - (let ((first (point)) - (level 1) - pos) - ;; Move past opening bracket. - (forward-char 1) - (setq pos (point)) - (while (and (> level 0) (< pos limit)) - ;; Search next bracket, stepping over escaped brackets. - (if (not (looking-at "\\([^()\\\n]\\|\\\\.\\)*\\([()]\\)")) - (setq level -1) - (setq level (+ level (if (string= "(" (match-string 2)) 1 -1))) - (goto-char (setq pos (match-end 0))))) - (if (not (= level 0)) - nil - ;; Found string with nested brackets, now set match data nr 2. - (set-match-data (list first pos nil nil first pos)) - pos))) - -;; This function should search for a string or comment -;; If comment, return as match data nr 1 -;; If string, return as match data nr 2 -(defun ps-mode-match-string-or-comment (limit) - ;; Find the first potential match. - (if (not (re-search-forward "[%(]" limit t)) - ;; Nothing found: return failure. - nil - (let ((end (match-end 0))) - (goto-char (match-beginning 0)) - (cond ((looking-at "\\(%.*\\)\\|\\((\\([^()\\\n]\\|\\\\.\\)*)\\)") - ;; It's a comment or string without nested, unescaped brackets. - (goto-char (match-end 0)) - (point)) - ((ps-mode-looking-at-nested limit) - ;; It's a string with nested brackets. - (point)) - (t - ;; Try next match. - (goto-char end) - (ps-mode-match-string-or-comment limit)))))) +(defconst ps-mode--string-syntax-table + (let ((st (make-syntax-table ps-mode-syntax-table))) + (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)) + +(defun ps-mode--syntax-propertize-special (end) + (let ((ppss (syntax-ppss)) + char) + (cond + ((not (nth 3 ppss))) ;Not in (...), <~..base85..~>, or <..hex..>. + ((eq ?\( (setq char (char-after (nth 8 ppss)))) + (save-restriction + (narrow-to-region (point-min) end) + (goto-char (nth 8 ppss)) + (condition-case nil + (with-syntax-table ps-mode--string-syntax-table + (let ((parse-sexp-lookup-properties nil)) + (forward-sexp 1)) + (put-text-property (1- (point)) (point) + 'syntax-table (string-to-syntax "|"))) + (scan-error (goto-char end))))) + ((eq char ?<) + (when (re-search-forward (if (eq ?~ (char-after (1+ (nth 8 ppss)))) + "~>" ">") + end 'move) + (put-text-property (1- (point)) (point) + 'syntax-table (string-to-syntax "|"))))))) + +(defun ps-mode-syntax-propertize (start end) + (goto-char start) + (ps-mode--syntax-propertize-special end) + (funcall + (syntax-propertize-rules + ("\\(<\\)\\(?:~\\|[ \n\t]*[[:xdigit:]]\\)\\|\\(?1:(\\)" + (1 (unless (or (eq (char-after (match-beginning 0)) + (char-before (match-beginning 0))) ;Avoid "<<". + (nth 8 (save-excursion (syntax-ppss (match-beginning 1))))) + (put-text-property (match-beginning 1) (match-end 1) + 'syntax-table (string-to-syntax "|")) + (ps-mode--syntax-propertize-special end) + nil)))) + (point) end)) ;; Key-handlers. @@ -654,34 +636,12 @@ defines the beginning of a group. These tokens are: { [ <<" (setq target (+ target ps-mode-tab))) target))))) -(defun ps-mode-newline () - "Insert newline with proper indentation." - (interactive) - (delete-horizontal-space) - (insert "\n") - (if ps-mode-auto-indent - (indent-to (ps-mode-target-column)))) - -(defun ps-mode-tabkey () - "Indent/reindent current line, or insert tab." - (interactive) - (let ((column (current-column)) - target) - (if (or (not ps-mode-auto-indent) - (< ps-mode-tab 1) - (not (re-search-backward "^[ \t]*\\=" nil t))) - (insert "\t") - (setq target (ps-mode-target-column)) - (while (<= target column) - (setq target (+ target ps-mode-tab))) - (indent-line-to target)))) - (defun ps-mode-backward-delete-char () "Delete backward indentation, or delete backward character." (interactive) (let ((column (current-column)) target) - (if (or (not ps-mode-auto-indent) + (if (or (not electric-indent-mode) (< ps-mode-tab 1) (not (re-search-backward "^[ \t]+\\=" nil t))) (call-interactively 'delete-backward-char) @@ -694,32 +654,6 @@ defines the beginning of a group. These tokens are: { [ <<" (setq target 0)) (indent-line-to target)))) -(defun ps-mode-r-brace () - "Insert `}' and perform balance." - (interactive) - (insert "}") - (ps-mode-r-balance "}")) - -(defun ps-mode-r-angle () - "Insert `]' and perform balance." - (interactive) - (insert "]") - (ps-mode-r-balance "]")) - -(defun ps-mode-r-gt () - "Insert `>' and perform balance." - (interactive) - (insert ">") - (ps-mode-r-balance ">>")) - -(defun ps-mode-r-balance (right) - "Adjust indenting if point after RIGHT." - (if ps-mode-auto-indent - (save-excursion - (when (re-search-backward (concat "^[ \t]*" (regexp-quote right) "\\=") nil t) - (indent-line-to (ps-mode-target-column))))) - (blink-matching-open)) - (defun ps-mode-other-newline () "Perform newline in `*ps-run*' buffer." (interactive) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 833c3d9a9c5..13ff439bef2 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -31,9 +31,9 @@ ;; found in GNU/Emacs. ;; Implements Syntax highlighting, Indentation, Movement, Shell -;; interaction, Shell completion, Shell virtualenv support, Pdb -;; tracking, Symbol completion, Skeletons, FFAP, Code Check, Eldoc, -;; Imenu. +;; interaction, Shell completion, Shell virtualenv support, Shell +;; package support, Shell syntax highlighting, Pdb tracking, Symbol +;; completion, Skeletons, FFAP, Code Check, Eldoc, Imenu. ;; Syntax highlighting: Fontification of code is provided and supports ;; python's triple quoted strings properly. @@ -69,7 +69,7 @@ ;; Besides that only the standard CPython (2.x and 3.x) shell and ;; IPython are officially supported out of the box, the interaction ;; should support any other readline based Python shells as well -;; (e.g. Jython and Pypy have been reported to work). You can change +;; (e.g. Jython and PyPy have been reported to work). You can change ;; your default interpreter and commandline arguments by setting the ;; `python-shell-interpreter' and `python-shell-interpreter-args' ;; variables. This example enables IPython globally: @@ -119,18 +119,24 @@ ;; modify its behavior. ;; Shell completion: hitting tab will try to complete the current -;; word. Shell completion is implemented in such way that if you -;; change the `python-shell-interpreter' it should be possible to -;; integrate custom logic to calculate completions. To achieve this -;; you just need to set `python-shell-completion-setup-code' and -;; `python-shell-completion-string-code'. The default provided code, -;; enables autocompletion for both CPython and IPython (and ideally -;; any readline based Python shell). This code depends on the -;; readline module, so if you are using some Operating System that -;; bundles Python without it (like Windows), installing pyreadline -;; from URL `http://ipython.scipy.org/moin/PyReadline/Intro' should -;; suffice. To troubleshoot why you are not getting any completions -;; you can try the following in your Python shell: +;; word. The two built-in mechanisms depend on Python's readline +;; module: the "native" completion is tried first and is activated +;; when `python-shell-completion-native-enable' is non-nil, the +;; current `python-shell-interpreter' is not a member of the +;; `python-shell-completion-native-disabled-interpreters' variable and +;; `python-shell-completion-native-setup' succeeds; the "fallback" or +;; "legacy" mechanism works by executing Python code in the background +;; and enables auto-completion for shells that do not support +;; receiving escape sequences (with some limitations, i.e. completion +;; in blocks does not work). The code executed for the "fallback" +;; completion can be found in `python-shell-completion-setup-code' and +;; `python-shell-completion-string-code' variables. Their default +;; values enable completion for both CPython and IPython, and probably +;; any readline based shell (it's known to work with PyPy). If your +;; Python installation lacks readline (like CPython for Windows), +;; installing pyreadline (URL `http://ipython.org/pyreadline.html') +;; should suffice. To troubleshoot why you are not getting any +;; completions, you can try the following in your Python shell: ;; >>> import readline, rlcompleter @@ -158,18 +164,28 @@ ;; (python-shell-exec-path . ("/path/to/env/bin/")) ;; Since the above is cumbersome and can be programmatically -;; calculated, the variable `python-shell-virtualenv-path' is +;; calculated, the variable `python-shell-virtualenv-root' is ;; provided. When this variable is set with the path of the ;; virtualenv to use, `process-environment' and `exec-path' get proper ;; values in order to run shells inside the specified virtualenv. So ;; the following will achieve the same as the previous example: -;; (setq python-shell-virtualenv-path "/path/to/env/") +;; (setq python-shell-virtualenv-root "/path/to/env/") ;; Also the `python-shell-extra-pythonpaths' variable have been ;; introduced as simple way of adding paths to the PYTHONPATH without ;; affecting existing values. +;; Shell package support: you can enable a package in the current +;; shell so that relative imports work properly using the +;; `python-shell-package-enable' command. + +;; Shell syntax highlighting: when enabled current input in shell is +;; highlighted. The variable `python-shell-font-lock-enable' controls +;; activation of this feature globally when shells are started. +;; Activation/deactivation can be also controlled on the fly via the +;; `python-shell-font-lock-toggle' command. + ;; Pdb tracking: when you execute a block of code that contains some ;; call to pdb (or ipdb) it will prompt the block of code and will ;; follow the execution of pdb marking the current line with an arrow. @@ -178,15 +194,13 @@ ;; the shell completion in background so you should run ;; `python-shell-send-buffer' from time to time to get better results. -;; Skeletons: 6 skeletons are provided for simple inserting of class, -;; def, for, if, try and while. These skeletons are integrated with -;; abbrev. If you have `abbrev-mode' activated and +;; Skeletons: skeletons are provided for simple inserting of things like class, +;; def, for, import, if, try, and while. These skeletons are +;; integrated with abbrev. If you have `abbrev-mode' activated and ;; `python-skeleton-autoinsert' is set to t, then whenever you type ;; the name of any of those defined and hit SPC, they will be ;; automatically expanded. As an alternative you can use the defined -;; skeleton commands: `python-skeleton-class', `python-skeleton-def' -;; `python-skeleton-for', `python-skeleton-if', `python-skeleton-try' -;; and `python-skeleton-while'. +;; skeleton commands: `python-skeleton-<foo>'. ;; FFAP: You can find the filename for a given module when using ffap ;; out of the box. This feature needs an inferior python shell @@ -248,6 +262,7 @@ (defvar outline-heading-end-regexp) (autoload 'comint-mode "comint") +(autoload 'help-function-arglist "help-fns") ;;;###autoload (add-to-list 'auto-mode-alist (cons (purecopy "\\.py\\'") 'python-mode)) @@ -280,6 +295,7 @@ (define-key map "\C-c\C-td" 'python-skeleton-def) (define-key map "\C-c\C-tf" 'python-skeleton-for) (define-key map "\C-c\C-ti" 'python-skeleton-if) + (define-key map "\C-c\C-tm" 'python-skeleton-import) (define-key map "\C-c\C-tt" 'python-skeleton-try) (define-key map "\C-c\C-tw" 'python-skeleton-while) ;; Shell interaction @@ -461,6 +477,23 @@ The type returned can be `comment', `string' or `paren'." 'python-info-ppss-comment-or-string-p #'python-syntax-comment-or-string-p "24.3") +(defun python-docstring-at-p (pos) + "Check to see if there is a docstring at POS." + (save-excursion + (goto-char pos) + (if (looking-at-p "'''\\|\"\"\"") + (progn + (python-nav-backward-statement) + (looking-at "\\`\\|class \\|def ")) + nil))) + +(defun python-font-lock-syntactic-face-function (state) + (if (nth 3 state) + (if (python-docstring-at-p (nth 8 state)) + font-lock-doc-face + font-lock-string-face) + font-lock-comment-face)) + (defvar python-font-lock-keywords ;; Keywords `(,(rx symbol-start @@ -549,7 +582,7 @@ The type returned can be `comment', `string' or `paren'." (res nil)) (while (and (setq res (re-search-forward re limit t)) (or (python-syntax-context 'paren) - (equal (char-after (point-marker)) ?=)))) + (equal (char-after (point)) ?=)))) res)) (1 font-lock-variable-name-face nil nil)) ;; support for a, b, c = (1, 2, 3) @@ -674,7 +707,8 @@ It makes underscores and dots word constituent chars.") "Current indentation level `python-indent-line-function' is using.") (defvar python-indent-levels '(0) - "Levels of indentation available for `python-indent-line-function'.") + "Levels of indentation available for `python-indent-line-function'. +Can also be `noindent' if automatic indentation can't be used.") (defun python-indent-guess-indent-offset () "Guess and set `python-indent-offset' for the current buffer." @@ -795,7 +829,9 @@ START is the buffer position where the sexp starts." start)))) (defun python-indent-calculate-indentation () - "Calculate correct indentation offset for the current line." + "Calculate correct indentation offset for the current line. +Returns `noindent' if the indentation does not depend on Python syntax, +such as in strings." (let* ((indentation-context (python-indent-context)) (context-status (car indentation-context)) (context-start (cdr indentation-context))) @@ -845,9 +881,7 @@ START is the buffer position where the sexp starts." ;; When inside of a string, do nothing. just use the current ;; indentation. XXX: perhaps it would be a good idea to ;; invoke standard text indentation here - (`inside-string - (goto-char context-start) - (current-indentation)) + (`inside-string 'noindent) ;; After backslash we have several possibilities. (`after-backslash (cond @@ -973,14 +1007,17 @@ START is the buffer position where the sexp starts." ;; XXX: This asks for a refactor. Even if point is on a ;; dedenter statement, it could be multiline and in that case ;; the continuation lines should be indented with normal rules. - (let* ((indentation (python-indent-calculate-indentation)) - (remainder (% indentation python-indent-offset)) - (steps (/ (- indentation remainder) python-indent-offset))) - (setq python-indent-levels (list 0)) - (dotimes (step steps) - (push (* python-indent-offset (1+ step)) python-indent-levels)) - (when (not (eq 0 remainder)) - (push (+ (* python-indent-offset steps) remainder) python-indent-levels))) + (let* ((indentation (python-indent-calculate-indentation))) + (if (not (numberp indentation)) + (setq python-indent-levels indentation) + (let* ((remainder (% indentation python-indent-offset)) + (steps (/ (- indentation remainder) python-indent-offset))) + (setq python-indent-levels (list 0)) + (dotimes (step steps) + (push (* python-indent-offset (1+ step)) python-indent-levels)) + (when (not (eq 0 remainder)) + (push (+ (* python-indent-offset steps) remainder) + python-indent-levels))))) (setq python-indent-levels (or (mapcar (lambda (pos) @@ -989,8 +1026,9 @@ START is the buffer position where the sexp starts." (current-indentation))) (python-info-dedenter-opening-block-positions)) (list 0)))) - (setq python-indent-current-level (1- (length python-indent-levels)) - python-indent-levels (nreverse python-indent-levels))) + (when (listp python-indent-levels) + (setq python-indent-current-level (1- (length python-indent-levels)) + python-indent-levels (nreverse python-indent-levels)))) (defun python-indent-toggle-levels () "Toggle `python-indent-current-level' over `python-indent-levels'." @@ -1018,28 +1056,30 @@ in the variable `python-indent-levels'. Afterwards it sets the variable `python-indent-current-level' correctly so offset is equal to (nth python-indent-current-level python-indent-levels)" - (or - (and (or (and (memq this-command python-indent-trigger-commands) - (eq last-command this-command)) - force-toggle) - (not (equal python-indent-levels '(0))) - (or (python-indent-toggle-levels) t)) - (python-indent-calculate-levels)) - (let* ((starting-pos (point-marker)) - (indent-ending-position - (+ (line-beginning-position) (current-indentation))) - (follow-indentation-p - (or (bolp) - (and (<= (line-beginning-position) starting-pos) - (>= indent-ending-position starting-pos)))) - (next-indent (nth python-indent-current-level python-indent-levels))) - (unless (= next-indent (current-indentation)) - (beginning-of-line) - (delete-horizontal-space) - (indent-to next-indent) - (goto-char starting-pos)) - (and follow-indentation-p (back-to-indentation))) - (python-info-dedenter-opening-block-message)) + (if (and (or (and (memq this-command python-indent-trigger-commands) + (eq last-command this-command)) + force-toggle) + (not (equal python-indent-levels '(0)))) + (if (listp python-indent-levels) + (python-indent-toggle-levels)) + (python-indent-calculate-levels)) + (if (eq python-indent-levels 'noindent) + python-indent-levels + (let* ((starting-pos (point-marker)) + (indent-ending-position + (+ (line-beginning-position) (current-indentation))) + (follow-indentation-p + (or (bolp) + (and (<= (line-beginning-position) starting-pos) + (>= indent-ending-position starting-pos)))) + (next-indent (nth python-indent-current-level python-indent-levels))) + (unless (= next-indent (current-indentation)) + (beginning-of-line) + (delete-horizontal-space) + (indent-to next-indent) + (goto-char starting-pos)) + (and follow-indentation-p (back-to-indentation))) + (python-info-dedenter-opening-block-message))) (defun python-indent-line-function () "`indent-line-function' for Python mode. @@ -1050,9 +1090,9 @@ See `python-indent-line' for details." "De-indent current line." (interactive "*") (when (and (not (python-syntax-comment-or-string-p)) - (<= (point-marker) (save-excursion + (<= (point) (save-excursion (back-to-indentation) - (point-marker))) + (point))) (> (current-column) 0)) (python-indent-line t) t)) @@ -1129,12 +1169,10 @@ any lines in the region are indented less than COUNT columns." (while (< (point) end) (if (and (< (current-indentation) count) (not (looking-at "[ \t]*$"))) - (error "Can't shift all lines enough")) + (user-error "Can't shift all lines enough")) (forward-line)) (indent-rigidly start end (- count)))))) -(add-to-list 'debug-ignored-errors "^Can't shift all lines enough") - (defun python-indent-shift-right (start end &optional count) "Shift lines contained in region START END by COUNT columns to the right. COUNT defaults to `python-indent-offset'. If region isn't @@ -1176,7 +1214,7 @@ the line will be re-indented automatically if needed." (save-excursion (goto-char (line-beginning-position)) (let ((indentation (python-indent-calculate-indentation))) - (when (< (current-indentation) indentation) + (when (and (numberp indentation) (< (current-indentation) indentation)) (indent-line-to indentation))))) ;; Electric colon ((and (eq ?: last-command-event) @@ -1790,6 +1828,7 @@ position, else returns nil." (defcustom python-shell-prompt-input-regexps '(">>> " "\\.\\.\\. " ; Python "In \\[[0-9]+\\]: " ; IPython + " \\.\\.\\.: " ; IPython ;; Using ipdb outside IPython may fail to cleanup and leave static ;; IPython prompts activated, this adds some safeguard for that. "In : " "\\.\\.\\.: ") @@ -1825,7 +1864,10 @@ It should not contain a caret (^) at the beginning." It should not contain a caret (^) at the beginning." :type 'string) -(defcustom python-shell-enable-font-lock t +(define-obsolete-variable-alias + 'python-shell-enable-font-lock 'python-shell-font-lock-enable "25.1") + +(defcustom python-shell-font-lock-enable t "Should syntax highlighting be enabled in the Python shell buffer? Restart the Python shell after changing this variable for it to take effect." :type 'boolean @@ -1868,7 +1910,7 @@ default `exec-path'." :group 'python :safe 'listp) -(defcustom python-shell-virtualenv-path nil +(defcustom python-shell-virtualenv-root nil "Path to virtualenv root. This variable, when set to a string, makes the values stored in `python-shell-process-environment' and `python-shell-exec-path' @@ -1878,6 +1920,9 @@ virtualenv." :group 'python :safe 'stringp) +(define-obsolete-variable-alias + 'python-shell-virtualenv-path 'python-shell-virtualenv-root "25.1") + (defcustom python-shell-setup-codes '(python-shell-completion-setup-code python-ffap-setup-code python-eldoc-setup-code) @@ -1969,7 +2014,9 @@ detection and just returns nil." nil))) (when (and (not prompts) python-shell-prompt-detect-failure-warning) - (warn + (lwarn + '(python python-shell-prompt-regexp) + :warning (concat "Python shell prompts cannot be detected.\n" "If your emacs session hangs when starting python shells\n" @@ -2064,67 +2111,57 @@ and `python-shell-output-prompt-regexp' using the values from (defun python-shell-get-process-name (dedicated) "Calculate the appropriate process name for inferior Python process. -If DEDICATED is t and the variable `buffer-file-name' is non-nil -returns a string with the form -`python-shell-buffer-name'[variable `buffer-file-name'] else -returns the value of `python-shell-buffer-name'." - (let ((process-name - (if (and dedicated - buffer-file-name) - (format "%s[%s]" python-shell-buffer-name buffer-file-name) - (format "%s" python-shell-buffer-name)))) - process-name)) +If DEDICATED is t returns a string with the form +`python-shell-buffer-name'[`buffer-name'] else returns the value +of `python-shell-buffer-name'." + (if dedicated + (format "%s[%s]" python-shell-buffer-name (buffer-name)) + python-shell-buffer-name)) (defun python-shell-internal-get-process-name () "Calculate the appropriate process name for Internal Python process. The name is calculated from `python-shell-global-buffer-name' and -a hash of all relevant global shell settings in order to ensure -uniqueness for different types of configurations." - (format "%s [%s]" - python-shell-internal-buffer-name - (md5 - (concat - python-shell-interpreter - python-shell-interpreter-args - python-shell--prompt-calculated-input-regexp - python-shell--prompt-calculated-output-regexp - (mapconcat #'symbol-value python-shell-setup-codes "") - (mapconcat #'identity python-shell-process-environment "") - (mapconcat #'identity python-shell-extra-pythonpaths "") - (mapconcat #'identity python-shell-exec-path "") - (or python-shell-virtualenv-path "") - (mapconcat #'identity python-shell-exec-path ""))))) - -(defun python-shell-parse-command () ;FIXME: why name it "parse"? +the `buffer-name'." + (format "%s[%s]" python-shell-internal-buffer-name (buffer-name))) + +(defun python-shell-calculate-command () "Calculate the string used to execute the inferior Python process." - ;; FIXME: process-environment doesn't seem to be used anywhere within - ;; this let. - (let ((process-environment (python-shell-calculate-process-environment)) - (exec-path (python-shell-calculate-exec-path))) + (let ((exec-path (python-shell-calculate-exec-path))) + ;; `exec-path' gets tweaked so that virtualenv's specific + ;; `python-shell-interpreter' absolute path can be found by + ;; `executable-find'. (format "%s %s" ;; FIXME: Why executable-find? (shell-quote-argument (executable-find python-shell-interpreter)) python-shell-interpreter-args))) +(define-obsolete-function-alias + 'python-shell-parse-command + #'python-shell-calculate-command "25.1") + +(defun python-shell-calculate-pythonpath () + "Calculate the PYTHONPATH using `python-shell-extra-pythonpaths'." + (let ((pythonpath (getenv "PYTHONPATH")) + (extra (mapconcat 'identity + python-shell-extra-pythonpaths + path-separator))) + (if pythonpath + (concat extra path-separator pythonpath) + extra))) + (defun python-shell-calculate-process-environment () - "Calculate process environment given `python-shell-virtualenv-path'." + "Calculate process environment given `python-shell-virtualenv-root'." (let ((process-environment (append python-shell-process-environment process-environment nil)) - (virtualenv (if python-shell-virtualenv-path - (directory-file-name python-shell-virtualenv-path) + (virtualenv (if python-shell-virtualenv-root + (directory-file-name python-shell-virtualenv-root) nil))) (when python-shell-unbuffered (setenv "PYTHONUNBUFFERED" "1")) (when python-shell-extra-pythonpaths - (setenv "PYTHONPATH" - (format "%s%s%s" - (mapconcat 'identity - python-shell-extra-pythonpaths - path-separator) - path-separator - (or (getenv "PYTHONPATH") "")))) + (setenv "PYTHONPATH" (python-shell-calculate-pythonpath))) (if (not virtualenv) process-environment (setenv "PYTHONHOME" nil) @@ -2135,34 +2172,250 @@ uniqueness for different types of configurations." process-environment)) (defun python-shell-calculate-exec-path () - "Calculate exec path given `python-shell-virtualenv-path'." - (let ((path (append python-shell-exec-path - exec-path nil))) ;FIXME: Why nil? - (if (not python-shell-virtualenv-path) + "Calculate exec path given `python-shell-virtualenv-root'." + (let ((path (append + ;; Use nil as the tail so that the list is a full copy, + ;; this is a paranoid safeguard for side-effects. + python-shell-exec-path exec-path nil))) + (if (not python-shell-virtualenv-root) path - (cons (expand-file-name "bin" python-shell-virtualenv-path) + (cons (expand-file-name "bin" python-shell-virtualenv-root) path)))) -(defun python-comint-output-filter-function (output) - "Hook run after content is put into comint buffer. -OUTPUT is a string with the contents of the buffer." - (ansi-color-filter-apply output)) +(defvar python-shell--package-depth 10) + +(defun python-shell-package-enable (directory package) + "Add DIRECTORY parent to $PYTHONPATH and enable PACKAGE." + (interactive + (let* ((dir (expand-file-name + (read-directory-name + "Package root: " + (file-name-directory + (or (buffer-file-name) default-directory))))) + (name (completing-read + "Package: " + (python-util-list-packages + dir python-shell--package-depth)))) + (list dir name))) + (python-shell-send-string + (format + (concat + "import os.path;import sys;" + "sys.path.append(os.path.dirname(os.path.dirname('''%s''')));" + "__package__ = '''%s''';" + "import %s") + directory package package) + (python-shell-get-process))) + +(defun python-shell-accept-process-output (process &optional timeout regexp) + "Accept PROCESS output with TIMEOUT until REGEXP is found. +Optional argument TIMEOUT is the timeout argument to +`accept-process-output' calls. Optional argument REGEXP +overrides the regexp to match the end of output, defaults to +`comint-prompt-regexp.'. Returns non-nil when output was +properly captured. + +This utility is useful in situations where the output may be +received in chunks, since `accept-process-output' gives no +guarantees they will be grabbed in a single call. An example use +case for this would be the CPython shell start-up, where the +banner and the initial prompt are received separately." + (let ((regexp (or regexp comint-prompt-regexp))) + (catch 'found + (while t + (when (not (accept-process-output process timeout)) + (throw 'found nil)) + (when (looking-back regexp) + (throw 'found t)))))) + +(defun python-shell-comint-end-of-output-p (output) + "Return non-nil if OUTPUT is ends with input prompt." + (string-match + ;; XXX: It seems on OSX an extra carriage return is attached + ;; at the end of output, this handles that too. + (concat + "\r?\n?" + ;; Remove initial caret from calculated regexp + (replace-regexp-in-string + (rx string-start ?^) "" + python-shell--prompt-calculated-input-regexp) + (rx eos)) + output)) + +(define-obsolete-function-alias + 'python-comint-output-filter-function + 'ansi-color-filter-apply + "25.1") + +(defun python-comint-postoutput-scroll-to-bottom (output) + "Faster version of `comint-postoutput-scroll-to-bottom'. +Avoids `recenter' calls until OUTPUT is completely sent." + (when (and (not (string= "" output)) + (python-shell-comint-end-of-output-p + (ansi-color-filter-apply output))) + (comint-postoutput-scroll-to-bottom output)) + output) (defvar python-shell--parent-buffer nil) -(defvar python-shell-output-syntax-table - (let ((table (make-syntax-table python-dotty-syntax-table))) - (modify-syntax-entry ?\' "." table) - (modify-syntax-entry ?\" "." table) - (modify-syntax-entry ?\( "." table) - (modify-syntax-entry ?\[ "." table) - (modify-syntax-entry ?\{ "." table) - (modify-syntax-entry ?\) "." table) - (modify-syntax-entry ?\] "." table) - (modify-syntax-entry ?\} "." table) - table) - "Syntax table for shell output. -It makes parens and quotes be treated as punctuation chars.") +(defmacro python-shell-with-shell-buffer (&rest body) + "Execute the forms in BODY with the shell buffer temporarily current. +Signals an error if no shell buffer is available for current buffer." + (declare (indent 0) (debug t)) + (let ((shell-process (make-symbol "shell-process"))) + `(let ((,shell-process (python-shell-get-process-or-error))) + (with-current-buffer (process-buffer ,shell-process) + ,@body)))) + +(defvar python-shell--font-lock-buffer nil) + +(defun python-shell-font-lock-get-or-create-buffer () + "Get or create a font-lock buffer for current inferior process." + (python-shell-with-shell-buffer + (if python-shell--font-lock-buffer + python-shell--font-lock-buffer + (let ((process-name + (process-name (get-buffer-process (current-buffer))))) + (generate-new-buffer + (format "*%s-font-lock*" process-name)))))) + +(defun python-shell-font-lock-kill-buffer () + "Kill the font-lock buffer safely." + (python-shell-with-shell-buffer + (when (and python-shell--font-lock-buffer + (buffer-live-p python-shell--font-lock-buffer)) + (kill-buffer python-shell--font-lock-buffer) + (when (derived-mode-p 'inferior-python-mode) + (setq python-shell--font-lock-buffer nil))))) + +(defmacro python-shell-font-lock-with-font-lock-buffer (&rest body) + "Execute the forms in BODY in the font-lock buffer. +The value returned is the value of the last form in BODY. See +also `with-current-buffer'." + (declare (indent 0) (debug t)) + `(python-shell-with-shell-buffer + (save-current-buffer + (when (not (and python-shell--font-lock-buffer + (get-buffer python-shell--font-lock-buffer))) + (setq python-shell--font-lock-buffer + (python-shell-font-lock-get-or-create-buffer))) + (set-buffer python-shell--font-lock-buffer) + (set (make-local-variable 'delay-mode-hooks) t) + (let ((python-indent-guess-indent-offset nil)) + (when (not (derived-mode-p 'python-mode)) + (python-mode)) + ,@body)))) + +(defun python-shell-font-lock-cleanup-buffer () + "Cleanup the font-lock buffer. +Provided as a command because this might be handy if something +goes wrong and syntax highlighting in the shell gets messed up." + (interactive) + (python-shell-with-shell-buffer + (python-shell-font-lock-with-font-lock-buffer + (delete-region (point-min) (point-max))))) + +(defun python-shell-font-lock-comint-output-filter-function (output) + "Clean up the font-lock buffer after any OUTPUT." + (when (and (not (string= "" output)) + ;; Is end of output and is not just a prompt. + (not (member + (python-shell-comint-end-of-output-p + (ansi-color-filter-apply output)) + '(nil 0)))) + ;; If output is other than an input prompt then "real" output has + ;; been received and the font-lock buffer must be cleaned up. + (python-shell-font-lock-cleanup-buffer)) + output) + +(defun python-shell-font-lock-post-command-hook () + "Fontifies current line in shell buffer." + (if (eq this-command 'comint-send-input) + ;; Add a newline when user sends input as this may be a block. + (python-shell-font-lock-with-font-lock-buffer + (goto-char (line-end-position)) + (newline)) + (when (and (python-util-comint-last-prompt) + (> (point) (cdr (python-util-comint-last-prompt)))) + (let ((input (buffer-substring-no-properties + (cdr (python-util-comint-last-prompt)) (point-max))) + (old-input (python-shell-font-lock-with-font-lock-buffer + (buffer-substring-no-properties + (line-beginning-position) (point-max)))) + (current-point (point)) + (buffer-undo-list t)) + ;; When input hasn't changed, do nothing. + (when (not (string= input old-input)) + (delete-region (cdr (python-util-comint-last-prompt)) (point-max)) + (insert + (python-shell-font-lock-with-font-lock-buffer + (delete-region (line-beginning-position) + (line-end-position)) + (insert input) + ;; Ensure buffer is fontified, keeping it + ;; compatible with Emacs < 24.4. + (if (fboundp 'font-lock-ensure) + (funcall 'font-lock-ensure) + (font-lock-default-fontify-buffer)) + ;; Replace FACE text properties with FONT-LOCK-FACE so + ;; they are not overwritten by comint buffer's font lock. + (python-util-text-properties-replace-name + 'face 'font-lock-face) + (buffer-substring (line-beginning-position) + (line-end-position)))) + (goto-char current-point)))))) + +(defun python-shell-font-lock-turn-on (&optional msg) + "Turn on shell font-lock. +With argument MSG show activation message." + (interactive "p") + (python-shell-with-shell-buffer + (python-shell-font-lock-kill-buffer) + (set (make-local-variable 'python-shell--font-lock-buffer) nil) + (add-hook 'post-command-hook + #'python-shell-font-lock-post-command-hook nil 'local) + (add-hook 'kill-buffer-hook + #'python-shell-font-lock-kill-buffer nil 'local) + (add-hook 'comint-output-filter-functions + #'python-shell-font-lock-comint-output-filter-function + 'append 'local) + (when msg + (message "Shell font-lock is enabled")))) + +(defun python-shell-font-lock-turn-off (&optional msg) + "Turn off shell font-lock. +With argument MSG show deactivation message." + (interactive "p") + (python-shell-with-shell-buffer + (python-shell-font-lock-kill-buffer) + (when (python-util-comint-last-prompt) + ;; Cleanup current fontification + (remove-text-properties + (cdr (python-util-comint-last-prompt)) + (line-end-position) + '(face nil font-lock-face nil))) + (set (make-local-variable 'python-shell--font-lock-buffer) nil) + (remove-hook 'post-command-hook + #'python-shell-font-lock-post-command-hook'local) + (remove-hook 'kill-buffer-hook + #'python-shell-font-lock-kill-buffer 'local) + (remove-hook 'comint-output-filter-functions + #'python-shell-font-lock-comint-output-filter-function + 'local) + (when msg + (message "Shell font-lock is disabled")))) + +(defun python-shell-font-lock-toggle (&optional msg) + "Toggle font-lock for shell. +With argument MSG show activation/deactivation message." + (interactive "p") + (python-shell-with-shell-buffer + (set (make-local-variable 'python-shell-font-lock-enable) + (not python-shell-font-lock-enable)) + (if python-shell-font-lock-enable + (python-shell-font-lock-turn-on msg) + (python-shell-font-lock-turn-off msg)) + python-shell-font-lock-enable)) (define-derived-mode inferior-python-mode comint-mode "Inferior Python" "Major mode for Python inferior process. @@ -2173,13 +2426,17 @@ interpreter is run. Variables `python-shell-prompt-regexp', `python-shell-prompt-output-regexp', `python-shell-prompt-block-regexp', -`python-shell-enable-font-lock', +`python-shell-font-lock-enable', `python-shell-completion-setup-code', `python-shell-completion-string-code', `python-eldoc-setup-code', `python-eldoc-string-code', `python-ffap-setup-code' and `python-ffap-string-code' can customize this mode for different Python interpreters. +This mode resets `comint-output-filter-functions' locally, so you +may want to re-add custom functions to it using the +`inferior-python-mode-hook'. + You can also add additional setup code to be run at initialization of the interpreter via `python-shell-setup-codes' variable. @@ -2198,56 +2455,33 @@ variable. (set (make-local-variable 'python-shell--prompt-calculated-output-regexp) nil) (python-shell-prompt-set-calculated-regexps) (setq comint-prompt-regexp python-shell--prompt-calculated-input-regexp) + (set (make-local-variable 'comint-prompt-read-only) t) (setq mode-line-process '(":%s")) - (make-local-variable 'comint-output-filter-functions) - (add-hook 'comint-output-filter-functions - 'python-comint-output-filter-function) - (add-hook 'comint-output-filter-functions - 'python-pdbtrack-comint-output-filter-function) + (set (make-local-variable 'comint-output-filter-functions) + '(ansi-color-process-output + python-pdbtrack-comint-output-filter-function + python-comint-postoutput-scroll-to-bottom)) (set (make-local-variable 'compilation-error-regexp-alist) python-shell-compilation-regexp-alist) - (define-key inferior-python-mode-map [remap complete-symbol] - 'completion-at-point) (add-hook 'completion-at-point-functions - #'python-shell-completion-complete-at-point nil 'local) - (add-hook 'comint-dynamic-complete-functions ;FIXME: really? - #'python-shell-completion-complete-at-point nil 'local) + #'python-shell-completion-at-point nil 'local) (define-key inferior-python-mode-map "\t" 'python-shell-completion-complete-or-indent) (make-local-variable 'python-pdbtrack-buffers-to-kill) (make-local-variable 'python-pdbtrack-tracked-buffer) (make-local-variable 'python-shell-internal-last-output) - (when python-shell-enable-font-lock - (set-syntax-table python-mode-syntax-table) - (set (make-local-variable 'font-lock-defaults) - '(python-font-lock-keywords nil nil nil nil)) - (set (make-local-variable 'syntax-propertize-function) - (eval - ;; XXX: Unfortunately eval is needed here to make use of the - ;; dynamic value of `comint-prompt-regexp'. - `(syntax-propertize-rules - (,comint-prompt-regexp - (0 (ignore - (put-text-property - comint-last-input-start end 'syntax-table - python-shell-output-syntax-table) - ;; XXX: This might look weird, but it is the easiest - ;; way to ensure font lock gets cleaned up before the - ;; current prompt, which is needed for unclosed - ;; strings to not mess up with current input. - (font-lock-unfontify-region comint-last-input-start end)))) - (,(python-rx string-delimiter) - (0 (ignore - (and (not (eq (get-text-property start 'field) 'output)) - (python-syntax-stringify))))))))) - (compilation-shell-minor-mode 1)) - -(defun python-shell-make-comint (cmd proc-name &optional pop internal) + (when python-shell-font-lock-enable + (python-shell-font-lock-turn-on)) + (compilation-shell-minor-mode 1) + (python-shell-accept-process-output + (get-buffer-process (current-buffer)))) + +(defun python-shell-make-comint (cmd proc-name &optional show internal) "Create a Python shell comint buffer. CMD is the Python command to be executed and PROC-NAME is the process name the comint buffer will get. After the comint buffer is created the `inferior-python-mode' is activated. When -optional argument POP is non-nil the buffer is shown. When +optional argument SHOW is non-nil the buffer is shown. When optional argument INTERNAL is non-nil this process is run on a buffer with a name that starts with a space, following the Emacs convention for temporary/internal buffers, and also makes sure @@ -2276,22 +2510,24 @@ killed." (mapconcat #'identity args " "))) (with-current-buffer buffer (inferior-python-mode)) - (accept-process-output process) - (and pop (pop-to-buffer buffer t)) + (when show (display-buffer buffer)) (and internal (set-process-query-on-exit-flag process nil)))) proc-buffer-name))) ;;;###autoload -(defun run-python (cmd &optional dedicated show) +(defun run-python (&optional cmd dedicated show) "Run an inferior Python process. -Input and output via buffer named after -`python-shell-buffer-name'. If there is a process already -running in that buffer, just switch to it. -With argument, allows you to define CMD so you can edit the -command used to call the interpreter and define DEDICATED, so a -dedicated process for the current buffer is open. When numeric -prefix arg is other than 0 or 4 do not SHOW. +Argument CMD defaults to `python-shell-calculate-command' return +value. When called interactively with `prefix-arg', it allows +the user to edit such value and choose whether the interpreter +should be DEDICATED for the current buffer. When numeric prefix +arg is other than 0 or 4 do not SHOW. + +For a given buffer and same values of DEDICATED, if a process is +already running for it, it will do nothing. This means that if +the current buffer is using a global process, the user is still +able to switch it to use a dedicated one. Runs the hook `inferior-python-mode-hook' after `comint-mode-hook' is run. (Type \\[describe-mode] in the @@ -2299,13 +2535,14 @@ process buffer for a list of commands.)" (interactive (if current-prefix-arg (list - (read-string "Run Python: " (python-shell-parse-command)) + (read-shell-command "Run Python: " (python-shell-calculate-command)) (y-or-n-p "Make dedicated process? ") (= (prefix-numeric-value current-prefix-arg) 4)) - (list (python-shell-parse-command) nil t))) - (python-shell-make-comint - cmd (python-shell-get-process-name dedicated) show) - dedicated) + (list (python-shell-calculate-command) nil t))) + (get-buffer-process + (python-shell-make-comint + (or cmd (python-shell-calculate-command)) + (python-shell-get-process-name dedicated) show))) (defun run-python-internal () "Run an inferior Internal Python process. @@ -2319,57 +2556,69 @@ difference with global or dedicated shells is that these ones are attached to a configuration, not a buffer. This means that can be used for example to retrieve the sys.path and other stuff, without messing with user shells. Note that -`python-shell-enable-font-lock' and `inferior-python-mode-hook' +`python-shell-font-lock-enable' and `inferior-python-mode-hook' are set to nil for these shells, so setup codes are not sent at startup." - (let ((python-shell-enable-font-lock nil) + (let ((python-shell-font-lock-enable nil) (inferior-python-mode-hook nil)) (get-buffer-process (python-shell-make-comint - (python-shell-parse-command) + (python-shell-calculate-command) (python-shell-internal-get-process-name) nil t)))) (defun python-shell-get-buffer () - "Return inferior Python buffer for current buffer." - (let* ((dedicated-proc-name (python-shell-get-process-name t)) - (dedicated-proc-buffer-name (format "*%s*" dedicated-proc-name)) - (global-proc-name (python-shell-get-process-name nil)) - (global-proc-buffer-name (format "*%s*" global-proc-name)) - (dedicated-running (comint-check-proc dedicated-proc-buffer-name)) - (global-running (comint-check-proc global-proc-buffer-name))) - ;; Always prefer dedicated - (or (and dedicated-running dedicated-proc-buffer-name) - (and global-running global-proc-buffer-name)))) + "Return inferior Python buffer for current buffer. +If current buffer is in `inferior-python-mode', return it." + (if (derived-mode-p 'inferior-python-mode) + (current-buffer) + (let* ((dedicated-proc-name (python-shell-get-process-name t)) + (dedicated-proc-buffer-name (format "*%s*" dedicated-proc-name)) + (global-proc-name (python-shell-get-process-name nil)) + (global-proc-buffer-name (format "*%s*" global-proc-name)) + (dedicated-running (comint-check-proc dedicated-proc-buffer-name)) + (global-running (comint-check-proc global-proc-buffer-name))) + ;; Always prefer dedicated + (or (and dedicated-running dedicated-proc-buffer-name) + (and global-running global-proc-buffer-name))))) (defun python-shell-get-process () "Return inferior Python process for current buffer." (get-buffer-process (python-shell-get-buffer))) +(defun python-shell-get-process-or-error (&optional interactivep) + "Return inferior Python process for current buffer or signal error. +When argument INTERACTIVEP is non-nil, use `user-error' instead +of `error' with a user-friendly message." + (or (python-shell-get-process) + (if interactivep + (user-error + "Start a Python process first with `M-x run-python' or `%s'." + ;; Get the binding. + (key-description + (where-is-internal + #'run-python overriding-local-map t))) + (error + "No inferior Python process running.")))) + (defun python-shell-get-or-create-process (&optional cmd dedicated show) "Get or create an inferior Python process for current buffer and return it. Arguments CMD, DEDICATED and SHOW are those of `run-python' and are used to start the shell. If those arguments are not provided, `run-python' is called interactively and the user will be asked for their values." - (let* ((dedicated-proc-name (python-shell-get-process-name t)) - (dedicated-proc-buffer-name (format "*%s*" dedicated-proc-name)) - (global-proc-name (python-shell-get-process-name nil)) - (global-proc-buffer-name (format "*%s*" global-proc-name)) - (dedicated-running (comint-check-proc dedicated-proc-buffer-name)) - (global-running (comint-check-proc global-proc-buffer-name)) - (current-prefix-arg 16)) - (when (and (not dedicated-running) (not global-running)) - (if (if (not cmd) - ;; XXX: Refactor code such that calling `run-python' - ;; interactively is not needed anymore. - (call-interactively 'run-python) - (run-python cmd dedicated show)) - (setq dedicated-running t) - (setq global-running t))) - ;; Always prefer dedicated - (get-buffer-process (if dedicated-running - dedicated-proc-buffer-name - global-proc-buffer-name)))) + (let ((shell-process (python-shell-get-process))) + (when (not shell-process) + (if (not cmd) + ;; XXX: Refactor code such that calling `run-python' + ;; interactively is not needed anymore. + (call-interactively 'run-python) + (run-python cmd dedicated show))) + (or shell-process (python-shell-get-process)))) + +(make-obsolete + #'python-shell-get-or-create-process + "Instead call `python-shell-get-process' and create one if returns nil." + "25.1") (defvar python-shell-internal-buffer nil "Current internal shell buffer for the current buffer. @@ -2383,18 +2632,10 @@ there for compatibility with CEDET.") (defun python-shell-internal-get-or-create-process () "Get or create an inferior Internal Python process." - (let* ((proc-name (python-shell-internal-get-process-name)) - (proc-buffer-name (format " *%s*" proc-name))) - (when (not (process-live-p proc-name)) - (run-python-internal) - (setq python-shell-internal-buffer proc-buffer-name) - ;; XXX: Why is this `sit-for' needed? - ;; `python-shell-make-comint' calls `accept-process-output' - ;; already but it is not helping to get proper output on - ;; 'gnu/linux when the internal shell process is not running and - ;; a call to `python-shell-internal-send-string' is issued. - (sit-for 0.1 t)) - (get-buffer-process proc-buffer-name))) + (let ((proc-name (python-shell-internal-get-process-name))) + (if (process-live-p proc-name) + (get-process proc-name) + (run-python-internal)))) (define-obsolete-function-alias 'python-proc 'python-shell-internal-get-or-create-process "24.3") @@ -2417,10 +2658,14 @@ there for compatibility with CEDET.") (delete-trailing-whitespace)) temp-file-name)) -(defun python-shell-send-string (string &optional process) - "Send STRING to inferior Python PROCESS." - (interactive "sPython command: ") - (let ((process (or process (python-shell-get-or-create-process)))) +(defun python-shell-send-string (string &optional process msg) + "Send STRING to inferior Python PROCESS. +When optional argument MSG is non-nil, forces display of a +user-friendly message if there's no process running; defaults to +t when called interactively." + (interactive + (list (read-string "Python command: ") nil t)) + (let ((process (or process (python-shell-get-process-or-error msg)))) (if (string-match ".\n+." string) ;Multiline. (let* ((temp-file-name (python-shell--save-temp-file string)) (file-name (or (buffer-file-name) temp-file-name))) @@ -2443,16 +2688,7 @@ detecting a prompt at the end of the buffer." string (ansi-color-filter-apply string) python-shell-output-filter-buffer (concat python-shell-output-filter-buffer string)) - (when (string-match - ;; XXX: It seems on OSX an extra carriage return is attached - ;; at the end of output, this handles that too. - (concat - "\r?\n" - ;; Remove initial caret from calculated regexp - (replace-regexp-in-string - (rx string-start ?^) "" - python-shell--prompt-calculated-input-regexp) - "$") + (when (python-shell-comint-end-of-output-p python-shell-output-filter-buffer) ;; Output ends when `python-shell-output-filter-buffer' contains ;; the prompt attached at the end of it. @@ -2472,7 +2708,7 @@ detecting a prompt at the end of the buffer." (defun python-shell-send-string-no-output (string &optional process) "Send STRING to PROCESS and inhibit output. Return the output." - (let ((process (or process (python-shell-get-or-create-process))) + (let ((process (or process (python-shell-get-process-or-error))) (comint-preoutput-filter-functions '(python-shell-output-filter)) (python-shell-output-filter-in-progress t) @@ -2576,35 +2812,43 @@ the python shell: (line-beginning-position) (line-end-position)))) (buffer-substring-no-properties (point-min) (point-max))))) -(defun python-shell-send-region (start end &optional send-main) +(defun python-shell-send-region (start end &optional send-main msg) "Send the region delimited by START and END to inferior Python process. When optional argument SEND-MAIN is non-nil, allow execution of code inside blocks delimited by \"if __name__== '__main__':\". When called interactively SEND-MAIN defaults to nil, unless it's -called with prefix argument." - (interactive "r\nP") +called with prefix argument. When optional argument MSG is +non-nil, forces display of a user-friendly message if there's no +process running; defaults to t when called interactively." + (interactive + (list (region-beginning) (region-end) current-prefix-arg t)) (let* ((string (python-shell-buffer-substring start end (not send-main))) - (process (python-shell-get-or-create-process)) + (process (python-shell-get-process-or-error msg)) (original-string (buffer-substring-no-properties start end)) (_ (string-match "\\`\n*\\(.*\\)" original-string))) (message "Sent: %s..." (match-string 1 original-string)) (python-shell-send-string string process))) -(defun python-shell-send-buffer (&optional send-main) +(defun python-shell-send-buffer (&optional send-main msg) "Send the entire buffer to inferior Python process. When optional argument SEND-MAIN is non-nil, allow execution of code inside blocks delimited by \"if __name__== '__main__':\". When called interactively SEND-MAIN defaults to nil, unless it's -called with prefix argument." - (interactive "P") +called with prefix argument. When optional argument MSG is +non-nil, forces display of a user-friendly message if there's no +process running; defaults to t when called interactively." + (interactive (list current-prefix-arg t)) (save-restriction (widen) - (python-shell-send-region (point-min) (point-max) send-main))) + (python-shell-send-region (point-min) (point-max) send-main msg))) -(defun python-shell-send-defun (arg) +(defun python-shell-send-defun (&optional arg msg) "Send the current defun to inferior Python process. -When argument ARG is non-nil do not include decorators." - (interactive "P") +When argument ARG is non-nil do not include decorators. When +optional argument MSG is non-nil, forces display of a +user-friendly message if there's no process running; defaults to +t when called interactively." + (interactive (list current-prefix-arg t)) (save-excursion (python-shell-send-region (progn @@ -2620,17 +2864,28 @@ When argument ARG is non-nil do not include decorators." (progn (or (python-nav-end-of-defun) (end-of-line 1)) - (point-marker))))) + (point-marker)) + nil ;; noop + msg))) (defun python-shell-send-file (file-name &optional process temp-file-name - delete) + delete msg) "Send FILE-NAME to inferior Python PROCESS. If TEMP-FILE-NAME is passed then that file is used for processing instead, while internally the shell will continue to use FILE-NAME. If TEMP-FILE-NAME and DELETE are non-nil, then -TEMP-FILE-NAME is deleted after evaluation is performed." - (interactive "fFile to send: ") - (let* ((process (or process (python-shell-get-or-create-process))) +TEMP-FILE-NAME is deleted after evaluation is performed. When +optional argument MSG is non-nil, forces display of a +user-friendly message if there's no process running; defaults to +t when called interactively." + (interactive + (list + (read-file-name "File to send: ") ; file-name + nil ; process + nil ; temp-file-name + nil ; delete + t)) ; msg + (let* ((process (or process (python-shell-get-process-or-error msg))) (encoding (with-temp-buffer (insert-file-contents (or temp-file-name file-name)) @@ -2655,21 +2910,31 @@ TEMP-FILE-NAME is deleted after evaluation is performed." (or temp-file-name file-name) encoding encoding file-name) process))) -(defun python-shell-switch-to-shell () - "Switch to inferior Python process buffer." - (interactive) - (pop-to-buffer (process-buffer (python-shell-get-or-create-process)) t)) +(defun python-shell-switch-to-shell (&optional msg) + "Switch to inferior Python process buffer. +When optional argument MSG is non-nil, forces display of a +user-friendly message if there's no process running; defaults to +t when called interactively." + (interactive "p") + (pop-to-buffer + (process-buffer (python-shell-get-process-or-error msg)) nil t)) (defun python-shell-send-setup-code () "Send all setup code for shell. This function takes the list of setup code to send from the `python-shell-setup-codes' list." - (let ((process (get-buffer-process (current-buffer)))) - (dolist (code python-shell-setup-codes) - (when code - (message "Sent %s" code) - (python-shell-send-string - (symbol-value code) process))))) + (let ((process (python-shell-get-process)) + (code (concat + (mapconcat + (lambda (elt) + (cond ((stringp elt) elt) + ((symbolp elt) (symbol-value elt)) + (t ""))) + python-shell-setup-codes + "\n\n") + "\n\nprint ('python.el: sent setup code')"))) + (python-shell-send-string code process) + (python-shell-accept-process-output process))) (add-hook 'inferior-python-mode-hook #'python-shell-send-setup-code) @@ -2733,85 +2998,272 @@ the full statement in the case of imports." "24.4" "Completion string code must also autocomplete modules.") -(defcustom python-shell-completion-pdb-string-code - "';'.join(globals().keys() + locals().keys())" - "Python code used to get completions separated by semicolons for [i]pdb." - :type 'string - :group 'python) +(define-obsolete-variable-alias + 'python-shell-completion-pdb-string-code + 'python-shell-completion-string-code + "25.1" + "Completion string code must work for (i)pdb.") + +(defcustom python-shell-completion-native-disabled-interpreters + ;; PyPy's readline cannot handle some escape sequences yet. + (list "pypy") + "List of disabled interpreters. +When a match is found, native completion is disabled." + :type '(repeat string)) + +(defcustom python-shell-completion-native-enable t + "Enable readline based native completion." + :type 'boolean) + +(defcustom python-shell-completion-native-output-timeout 0.01 + "Time in seconds to wait for completion output before giving up." + :type 'float) + +(defvar python-shell-completion-native-redirect-buffer + " *Python completions redirect*" + "Buffer to be used to redirect output of readline commands.") + +(defun python-shell-completion-native-interpreter-disabled-p () + "Return non-nil if interpreter has native completion disabled." + (when python-shell-completion-native-disabled-interpreters + (string-match + (regexp-opt python-shell-completion-native-disabled-interpreters) + (file-name-nondirectory python-shell-interpreter)))) + +(defun python-shell-completion-native-try () + "Return non-nil if can trigger native completion." + (let ((python-shell-completion-native-enable t)) + (python-shell-completion-native-get-completions + (get-buffer-process (current-buffer)) + nil "int"))) + +(defun python-shell-completion-native-setup () + "Try to setup native completion, return non-nil on success." + (let ((process (python-shell-get-process))) + (python-shell-send-string + (funcall + 'mapconcat + #'identity + (list + "try:" + " import readline, rlcompleter" + ;; Remove parens on callables as it breaks completion on + ;; arguments (e.g. str(Ari<tab>)). + " class Completer(rlcompleter.Completer):" + " def _callable_postfix(self, val, word):" + " return word" + " readline.set_completer(Completer().complete)" + " if readline.__doc__ and 'libedit' in readline.__doc__:" + " readline.parse_and_bind('bind ^I rl_complete')" + " else:" + " readline.parse_and_bind('tab: complete')" + " print ('python.el: readline is available')" + "except:" + " print ('python.el: readline not available')") + "\n") + process) + (python-shell-accept-process-output process) + (when (save-excursion + (re-search-backward + (regexp-quote "python.el: readline is available") nil t 1)) + (python-shell-completion-native-try)))) + +(defun python-shell-completion-native-turn-off (&optional msg) + "Turn off shell native completions. +With argument MSG show deactivation message." + (interactive "p") + (python-shell-with-shell-buffer + (set (make-local-variable 'python-shell-completion-native-enable) nil) + (when msg + (message "Shell native completion is disabled, using fallback")))) + +(defun python-shell-completion-native-turn-on (&optional msg) + "Turn on shell native completions. +With argument MSG show deactivation message." + (interactive "p") + (python-shell-with-shell-buffer + (set (make-local-variable 'python-shell-completion-native-enable) t) + (python-shell-completion-native-turn-on-maybe msg))) + +(defun python-shell-completion-native-turn-on-maybe (&optional msg) + "Turn on native completions if enabled and available. +With argument MSG show activation/deactivation message." + (interactive "p") + (python-shell-with-shell-buffer + (when python-shell-completion-native-enable + (cond + ((python-shell-completion-native-interpreter-disabled-p) + (python-shell-completion-native-turn-off msg)) + ((python-shell-completion-native-setup) + (when msg + (message "Shell native completion is enabled."))) + (t (lwarn + '(python python-shell-completion-native-turn-on-maybe) + :warning + (concat + "Your `python-shell-interpreter' doesn't seem to " + "support readline, yet `python-shell-completion-native' " + (format "was `t' and %S is not part of the " + (file-name-nondirectory python-shell-interpreter)) + "`python-shell-completion-native-disabled-interpreters' " + "list. Native completions have been disabled locally. ")) + (python-shell-completion-native-turn-off msg)))))) + +(defun python-shell-completion-native-turn-on-maybe-with-msg () + "Like `python-shell-completion-native-turn-on-maybe' but force messages." + (python-shell-completion-native-turn-on-maybe t)) -(defun python-shell-completion-get-completions (process line input) - "Do completion at point for PROCESS. -LINE is used to detect the context on how to complete given INPUT." +(add-hook 'inferior-python-mode-hook + #'python-shell-completion-native-turn-on-maybe-with-msg) + +(defun python-shell-completion-native-toggle (&optional msg) + "Toggle shell native completion. +With argument MSG show activation/deactivation message." + (interactive "p") + (python-shell-with-shell-buffer + (if python-shell-completion-native-enable + (python-shell-completion-native-turn-off msg) + (python-shell-completion-native-turn-on msg)) + python-shell-completion-native-enable)) + +(defun python-shell-completion-native-get-completions (process import input) + "Get completions using native readline for PROCESS. +When IMPORT is non-nil takes precedence over INPUT for +completion." + (when (and python-shell-completion-native-enable + (python-util-comint-last-prompt) + (>= (point) (cdr (python-util-comint-last-prompt)))) + (let* ((input (or import input)) + (original-filter-fn (process-filter process)) + (redirect-buffer (get-buffer-create + python-shell-completion-native-redirect-buffer)) + (separators (python-rx + (or whitespace open-paren close-paren))) + (trigger "\t\t\t") + (new-input (concat input trigger)) + (input-length + (save-excursion + (+ (- (point-max) (comint-bol)) (length new-input)))) + (delete-line-command (make-string input-length ?\b)) + (input-to-send (concat new-input delete-line-command))) + ;; Ensure restoring the process filter, even if the user quits + ;; or there's some other error. + (unwind-protect + (with-current-buffer redirect-buffer + ;; Cleanup the redirect buffer + (delete-region (point-min) (point-max)) + ;; Mimic `comint-redirect-send-command', unfortunately it + ;; can't be used here because it expects a newline in the + ;; command and that's exactly what we are trying to avoid. + (let ((comint-redirect-echo-input nil) + (comint-redirect-verbose nil) + (comint-redirect-perform-sanity-check nil) + (comint-redirect-insert-matching-regexp nil) + ;; Feed it some regex that will never match. + (comint-redirect-finished-regexp "^\\'$") + (comint-redirect-output-buffer redirect-buffer)) + ;; Compatibility with Emacs 24.x. Comint changed and + ;; now `comint-redirect-filter' gets 3 args. This + ;; checks which version of `comint-redirect-filter' is + ;; in use based on its args and uses `apply-partially' + ;; to make it up for the 3 args case. + (if (= (length + (help-function-arglist 'comint-redirect-filter)) 3) + (set-process-filter + process (apply-partially + #'comint-redirect-filter original-filter-fn)) + (set-process-filter process #'comint-redirect-filter)) + (process-send-string process input-to-send) + (accept-process-output + process + python-shell-completion-native-output-timeout) + ;; XXX: can't use `python-shell-accept-process-output' + ;; here because there are no guarantees on how output + ;; ends. The workaround here is to call + ;; `accept-process-output' until we don't find anything + ;; else to accept. + (while (accept-process-output + process + python-shell-completion-native-output-timeout)) + (cl-remove-duplicates + (split-string + (buffer-substring-no-properties + (point-min) (point-max)) + separators t)))) + (set-process-filter process original-filter-fn))))) + +(defun python-shell-completion-get-completions (process import input) + "Do completion at point using PROCESS for IMPORT or INPUT. +When IMPORT is non-nil takes precedence over INPUT for +completion." (with-current-buffer (process-buffer process) (let* ((prompt - ;; Get last prompt of the inferior process buffer (this - ;; intentionally avoids using `comint-last-prompt' because - ;; of incompatibilities with Emacs 24.x). - (save-excursion + (let ((prompt-boundaries (python-util-comint-last-prompt))) (buffer-substring-no-properties - (line-beginning-position) ;End of prompt. - (re-search-backward "^")))) + (car prompt-boundaries) (cdr prompt-boundaries)))) (completion-code ;; Check whether a prompt matches a pdb string, an import ;; statement or just the standard prompt and use the ;; correct python-shell-completion-*-code string - (cond ((and (> (length python-shell-completion-pdb-string-code) 0) - (string-match + (cond ((and (string-match (concat "^" python-shell-prompt-pdb-regexp) prompt)) - python-shell-completion-pdb-string-code) + ;; Since there are no guarantees the user will remain + ;; in the same context where completion code was sent + ;; (e.g. user steps into a function), safeguard + ;; resending completion setup continuously. + (concat python-shell-completion-setup-code + "\nprint (" python-shell-completion-string-code ")")) ((string-match python-shell--prompt-calculated-input-regexp prompt) python-shell-completion-string-code) (t nil))) - (input - (if (string-match - (python-rx line-start (* space) (or "from" "import") space) - line) - line - input))) + (subject (or import input))) (and completion-code (> (length input) 0) (let ((completions (python-util-strip-string (python-shell-send-string-no-output - (format completion-code input) process)))) + (format completion-code subject) process)))) (and (> (length completions) 2) (split-string completions "^'\\|^\"\\|;\\|'$\\|\"$" t))))))) -(defun python-shell-completion-complete-at-point (&optional process) - "Perform completion at point in inferior Python. +(defun python-shell-completion-at-point (&optional process) + "Function for `completion-at-point-functions' in `inferior-python-mode'. Optional argument PROCESS forces completions to be retrieved using that one instead of current buffer's process." (setq process (or process (get-buffer-process (current-buffer)))) - (let* ((start + (let* ((last-prompt-end (cdr (python-util-comint-last-prompt))) + (import-statement + (when (string-match-p + (rx (* space) word-start (or "from" "import") word-end space) + (buffer-substring-no-properties last-prompt-end (point))) + (buffer-substring-no-properties last-prompt-end (point)))) + (start (save-excursion - (with-syntax-table python-dotty-syntax-table - (let* ((paren-depth (car (syntax-ppss))) - (syntax-string "w_") - (syntax-list (string-to-syntax syntax-string))) - ;; Stop scanning for the beginning of the completion - ;; subject after the char before point matches a - ;; delimiter - (while (member - (car (syntax-after (1- (point)))) syntax-list) - (skip-syntax-backward syntax-string) - (when (or (equal (char-before) ?\)) - (equal (char-before) ?\")) - (forward-char -1)) - (while (or - ;; honor initial paren depth - (> (car (syntax-ppss)) paren-depth) - (python-syntax-context 'string)) - (forward-char -1))) - (point))))) - (end (point))) + (if (not (re-search-backward + (python-rx + (or whitespace open-paren close-paren string-delimiter)) + last-prompt-end + t 1)) + last-prompt-end + (forward-char (length (match-string-no-properties 0))) + (point)))) + (end (point)) + (completion-fn + (if python-shell-completion-native-enable + #'python-shell-completion-native-get-completions + #'python-shell-completion-get-completions))) (list start end (completion-table-dynamic (apply-partially - #'python-shell-completion-get-completions - process (buffer-substring-no-properties - (line-beginning-position) end)))))) + completion-fn + process import-statement))))) + +(define-obsolete-function-alias + 'python-shell-completion-complete-at-point + 'python-shell-completion-at-point + "25.1") (defun python-shell-completion-complete-or-indent () "Complete or indent depending on the context. @@ -2820,7 +3272,7 @@ If not try to complete." (interactive) (if (string-match "^[[:space:]]*$" (buffer-substring (comint-line-beginning-position) - (point-marker))) + (point))) (indent-for-tab-command) (completion-at-point))) @@ -2919,18 +3371,19 @@ Argument OUTPUT is a string with the output from the comint process." ;;; Symbol completion -(defun python-completion-complete-at-point () - "Complete current symbol at point. +(defun python-completion-at-point () + "Function for `completion-at-point-functions' in `python-mode'. For this to work as best as possible you should call `python-shell-send-buffer' from time to time so context in inferior Python process is updated properly." (let ((process (python-shell-get-process))) - (if (not process) - (error "Completion needs an inferior Python process running") - (python-shell-completion-complete-at-point process)))) + (when process + (python-shell-completion-at-point process)))) -(add-to-list 'debug-ignored-errors - "^Completion needs an inferior Python process running.") +(define-obsolete-function-alias + 'python-completion-complete-at-point + 'python-completion-at-point + "25.1") ;;; Fill paragraph @@ -3150,8 +3603,7 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." (save-restriction (narrow-to-region (progn (while (python-syntax-context 'paren) - (goto-char (1- (point-marker)))) - (point-marker) + (goto-char (1- (point)))) (line-beginning-position)) (progn (when (not (python-syntax-context 'paren)) @@ -3160,8 +3612,8 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." (skip-syntax-backward "^)"))) (while (and (python-syntax-context 'paren) (not (eobp))) - (goto-char (1+ (point-marker)))) - (point-marker))) + (goto-char (1+ (point)))) + (point))) (let ((paragraph-start "\f\\|[ \t]*$") (paragraph-separate ",") (fill-paragraph-function)) @@ -3270,6 +3722,12 @@ The skeleton will be bound to python-skeleton-NAME." > _ \n '(python-skeleton--else) | ^) +(python-skeleton-define import nil + "Import from module: " + "from " str & " " | -5 + "import " + ("Identifier: " str ", ") -2 \n _) + (python-skeleton-define try nil nil "try:" \n @@ -3296,7 +3754,7 @@ The skeleton will be bound to python-skeleton-NAME." "class " str "(" ("Inheritance, %s: " (unless (equal ?\( (char-before)) ", ") str) - & ")" | -2 + & ")" | -1 ":" \n "\"\"\"" - "\"\"\"" \n > _ \n) @@ -3358,7 +3816,9 @@ The skeleton will be bound to python-skeleton-NAME." ;;; Code check (defcustom python-check-command - "pyflakes" + (or (executable-find "pyflakes") + (executable-find "epylint") + "install pyflakes, pylint or something else") "Command used to check a Python file." :type 'string :group 'python) @@ -3369,7 +3829,7 @@ The skeleton will be bound to python-skeleton-NAME." :type 'string :group 'python) -(defvar python-check-custom-command nil +(defvar-local python-check-custom-command nil "Internal use.") (defun python-check (command) @@ -3401,7 +3861,11 @@ See `python-check-command' for the default." "def __PYDOC_get_help(obj): try: import inspect - if hasattr(obj, 'startswith'): + try: + str_type = basestring + except NameError: + str_type = str + if isinstance(obj, str_type): obj = eval(obj, globals()) doc = inspect.getdoc(obj) if not doc and callable(obj): @@ -3424,10 +3888,7 @@ See `python-check-command' for the default." doc = doc.splitlines()[0] except: doc = '' - try: - exec('print doc') - except SyntaxError: - print(doc)" + print (doc)" "Python code to setup documentation retrieval." :type 'string :group 'python) @@ -3444,8 +3905,7 @@ If not FORCE-INPUT is passed then what `python-info-current-symbol' returns will be used. If not FORCE-PROCESS is passed what `python-shell-get-process' returns is used." (let ((process (or force-process (python-shell-get-process)))) - (if (not process) - (error "Eldoc needs an inferior Python process running") + (when process (let ((input (or force-input (python-info-current-symbol t)))) (and input @@ -3475,9 +3935,6 @@ Interactively, prompt for symbol." nil nil symbol)))) (message (python-eldoc--get-doc-at-point symbol))) -(add-to-list 'debug-ignored-errors - "^Eldoc needs an inferior Python process running.") - ;;; Imenu @@ -3997,6 +4454,18 @@ to \"^python-\"." (cdr pair)))) (buffer-local-variables from-buffer))) +(defvar comint-last-prompt-overlay) ; Shut up, byte compiler. + +(defun python-util-comint-last-prompt () + "Return comint last prompt overlay start and end. +This is for compatibility with Emacs < 24.4." + (cond ((bound-and-true-p comint-last-prompt-overlay) + (cons (overlay-start comint-last-prompt-overlay) + (overlay-end comint-last-prompt-overlay))) + ((bound-and-true-p comint-last-prompt) + comint-last-prompt) + (t nil))) + (defun python-util-forward-comment (&optional direction) "Python mode specific version of `forward-comment'. Optional argument DIRECTION defines the direction to move to." @@ -4008,6 +4477,68 @@ Optional argument DIRECTION defines the direction to move to." (goto-char comment-start)) (forward-comment factor))) +(defun python-util-list-directories (directory &optional predicate max-depth) + "List DIRECTORY subdirs, filtered by PREDICATE and limited by MAX-DEPTH. +Argument PREDICATE defaults to `identity' and must be a function +that takes one argument (a full path) and returns non-nil for +allowed files. When optional argument MAX-DEPTH is non-nil, stop +searching when depth is reached, else don't limit." + (let* ((dir (expand-file-name directory)) + (dir-length (length dir)) + (predicate (or predicate #'identity)) + (to-scan (list dir)) + (tally nil)) + (while to-scan + (let ((current-dir (car to-scan))) + (when (funcall predicate current-dir) + (setq tally (cons current-dir tally))) + (setq to-scan (append (cdr to-scan) + (python-util-list-files + current-dir #'file-directory-p) + nil)) + (when (and max-depth + (<= max-depth + (length (split-string + (substring current-dir dir-length) + "/\\|\\\\" t)))) + (setq to-scan nil)))) + (nreverse tally))) + +(defun python-util-list-files (dir &optional predicate) + "List files in DIR, filtering with PREDICATE. +Argument PREDICATE defaults to `identity' and must be a function +that takes one argument (a full path) and returns non-nil for +allowed files." + (let ((dir-name (file-name-as-directory dir))) + (apply #'nconc + (mapcar (lambda (file-name) + (let ((full-file-name (expand-file-name file-name dir-name))) + (when (and + (not (member file-name '("." ".."))) + (funcall (or predicate #'identity) full-file-name)) + (list full-file-name)))) + (directory-files dir-name))))) + +(defun python-util-list-packages (dir &optional max-depth) + "List packages in DIR, limited by MAX-DEPTH. +When optional argument MAX-DEPTH is non-nil, stop searching when +depth is reached, else don't limit." + (let* ((dir (expand-file-name dir)) + (parent-dir (file-name-directory + (directory-file-name + (file-name-directory + (file-name-as-directory dir))))) + (subpath-length (length parent-dir))) + (mapcar + (lambda (file-name) + (replace-regexp-in-string + (rx (or ?\\ ?/)) "." (substring file-name subpath-length))) + (python-util-list-directories + (directory-file-name dir) + (lambda (dir) + (file-exists-p (expand-file-name "__init__.py" dir))) + max-depth)))) + (defun python-util-popn (lst n) "Return LST first N elements. N should be an integer, when negative its opposite is used. @@ -4024,6 +4555,23 @@ returned as is." n (1- n))) (reverse acc)))) +(defun python-util-text-properties-replace-name + (from to &optional start end) + "Replace properties named FROM to TO, keeping its value. +Arguments START and END narrow the buffer region to work on." + (save-excursion + (goto-char (or start (point-min))) + (while (not (eobp)) + (let ((plist (text-properties-at (point))) + (next-change (or (next-property-change (point) (current-buffer)) + (or end (point-max))))) + (when (plist-get plist from) + (let* ((face (plist-get plist from)) + (plist (plist-put plist from nil)) + (plist (plist-put plist to face))) + (set-text-properties (point) next-change plist (current-buffer)))) + (goto-char next-change))))) + (defun python-util-strip-string (string) "Strip STRING whitespace and newlines from end and beginning." (replace-regexp-in-string @@ -4067,7 +4615,10 @@ returned as is." 'python-nav-forward-sexp) (set (make-local-variable 'font-lock-defaults) - '(python-font-lock-keywords nil nil nil nil)) + '(python-font-lock-keywords + nil nil nil nil + (font-lock-syntactic-face-function + . python-font-lock-syntactic-face-function))) (set (make-local-variable 'syntax-propertize-function) python-syntax-propertize-function) @@ -4076,8 +4627,9 @@ returned as is." #'python-indent-line-function) (set (make-local-variable 'indent-region-function) #'python-indent-region) ;; Because indentation is not redundant, we cannot safely reindent code. - (setq-local electric-indent-inhibit t) - (setq-local electric-indent-chars (cons ?: electric-indent-chars)) + (set (make-local-variable 'electric-indent-inhibit) t) + (set (make-local-variable 'electric-indent-chars) + (cons ?: electric-indent-chars)) ;; Add """ ... """ pairing to electric-pair-mode. (add-hook 'post-self-insert-hook @@ -4093,7 +4645,7 @@ returned as is." #'python-nav-end-of-defun) (add-hook 'completion-at-point-functions - #'python-completion-complete-at-point nil 'local) + #'python-completion-at-point nil 'local) (add-hook 'post-self-insert-hook #'python-indent-post-self-insert-function 'append 'local) @@ -4112,13 +4664,14 @@ returned as is." (current-column)))) (^ '(- (1+ (current-indentation)))))) - (set (make-local-variable 'eldoc-documentation-function) - #'python-eldoc-function) + (add-function :before-until (local 'eldoc-documentation-function) + #'python-eldoc-function) (add-to-list 'hs-special-modes-alist `(python-mode "^\\s-*\\(?:def\\|class\\)\\>" nil "#" ,(lambda (_arg) - (python-nav-end-of-defun)) nil)) + (python-nav-end-of-defun)) + nil)) (set (make-local-variable 'outline-regexp) (python-rx (* space) block-start)) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 3f560b9fee6..d1e42ca3443 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -152,6 +152,7 @@ This should only be called after matching against `ruby-here-doc-beg-re'." (define-key map (kbd "M-C-p") 'ruby-beginning-of-block) (define-key map (kbd "M-C-n") 'ruby-end-of-block) (define-key map (kbd "C-c {") 'ruby-toggle-block) + (define-key map (kbd "C-c '") 'ruby-toggle-string-quotes) map) "Keymap used in Ruby mode.") @@ -164,6 +165,8 @@ This should only be called after matching against `ruby-here-doc-beg-re'." ["End of Block" ruby-end-of-block t] ["Toggle Block" ruby-toggle-block t] "--" + ["Toggle String Quotes" ruby-toggle-string-quotes t] + "--" ["Backward Sexp" ruby-backward-sexp :visible (not ruby-use-smie)] ["Backward Sexp" backward-sexp @@ -1763,6 +1766,43 @@ If the result is do-end block, it will always be multiline." (ruby-do-end-to-brace beg end))) (goto-char start)))) +(defun ruby--string-region () + "Return region for string at point." + (let ((state (syntax-ppss))) + (when (memq (nth 3 state) '(?' ?\")) + (save-excursion + (goto-char (nth 8 state)) + (forward-sexp) + (list (nth 8 state) (point)))))) + +(defun ruby-string-at-point-p () + "Check if cursor is at a string or not." + (ruby--string-region)) + +(defun ruby--inverse-string-quote (string-quote) + "Get the inverse string quoting for STRING-QUOTE." + (if (equal string-quote "\"") "'" "\"")) + +(defun ruby-toggle-string-quotes () + "Toggle string literal quoting between single and double." + (interactive) + (when (ruby-string-at-point-p) + (let* ((region (ruby--string-region)) + (min (nth 0 region)) + (max (nth 1 region)) + (string-quote (ruby--inverse-string-quote (buffer-substring-no-properties min (1+ min)))) + (content + (buffer-substring-no-properties (1+ min) (1- max)))) + (setq content + (if (equal string-quote "\"") + (replace-regexp-in-string "\\\\\"" "\"" (replace-regexp-in-string "\\([^\\\\]\\)'" "\\1\\\\'" content)) + (replace-regexp-in-string "\\\\\'" "'" (replace-regexp-in-string "\\([^\\\\]\\)\"" "\\1\\\\\"" content)))) + (let ((orig-point (point))) + (delete-region min max) + (insert + (format "%s%s%s" string-quote content string-quote)) + (goto-char orig-point))))) + (eval-and-compile (defconst ruby-percent-literal-beg-re "\\(%\\)[qQrswWxIi]?\\([[:punct:]]\\)" @@ -2206,9 +2246,10 @@ See `font-lock-syntax-table'.") (add-to-list 'auto-mode-alist (cons (purecopy (concat "\\(?:\\." "rb\\|ru\\|rake\\|thor" - "\\|jbuilder\\|gemspec\\|podspec" + "\\|jbuilder\\|rabl\\|gemspec\\|podspec" "\\|/" "\\(?:Gem\\|Rake\\|Cap\\|Thor" + "\\|Puppet\\|Berks" "\\|Vagrant\\|Guard\\|Pod\\)file" "\\)\\'")) 'ruby-mode)) diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 8dcb82f41ff..a21bc198e3b 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -1,4 +1,4 @@ -;;; scheme.el --- Scheme (and DSSSL) editing mode +;;; scheme.el --- Scheme (and DSSSL) editing mode -*- lexical-binding: t; -*- ;; Copyright (C) 1986-1988, 1997-1998, 2001-2015 Free Software ;; Foundation, Inc. @@ -280,7 +280,9 @@ See `run-hooks'." "\\|-module" "\\)\\)\\>" ;; Any whitespace and declared object. - "[ \t]*(?" + ;; The "(*" is for curried definitions, e.g., + ;; (define ((sum a) b) (+ a b)) + "[ \t]*(*" "\\(\\sw+\\)?") '(1 font-lock-keyword-face) '(6 (cond ((match-beginning 3) font-lock-function-name-face) @@ -491,20 +493,20 @@ indentation." ;;; Let is different in Scheme -(defun would-be-symbol (string) - (not (string-equal (substring string 0 1) "("))) +;; (defun scheme-would-be-symbol (string) +;; (not (string-equal (substring string 0 1) "("))) -(defun next-sexp-as-string () - ;; Assumes that it is protected by a save-excursion - (forward-sexp 1) - (let ((the-end (point))) - (backward-sexp 1) - (buffer-substring (point) the-end))) +;; (defun scheme-next-sexp-as-string () +;; ;; Assumes that it is protected by a save-excursion +;; (forward-sexp 1) +;; (let ((the-end (point))) +;; (backward-sexp 1) +;; (buffer-substring (point) the-end))) ;; This is correct but too slow. ;; The one below works almost always. ;;(defun scheme-let-indent (state indent-point) -;; (if (would-be-symbol (next-sexp-as-string)) +;; (if (scheme-would-be-symbol (scheme-next-sexp-as-string)) ;; (scheme-indent-specform 2 state indent-point) ;; (scheme-indent-specform 1 state indent-point))) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 4700324d376..135f945dbb9 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -237,6 +237,7 @@ (ksh88 . jsh) (oash . sh) (pdksh . ksh88) + (mksh . pdksh) (posix . sh) (tcsh . csh) (wksh . ksh88) @@ -262,6 +263,7 @@ sh Bourne Shell ksh Korn Shell '93 dtksh CDE Desktop Korn Shell pdksh Public Domain Korn Shell + mksh MirOS BSD Korn Shell wksh Window Korn Shell zsh Z Shell oash SCO OA (curses) Shell @@ -271,7 +273,6 @@ sh Bourne Shell :version "24.4" ; added dash :group 'sh-script) - (defcustom sh-alias-alist (append (if (eq system-type 'gnu/linux) '((csh . tcsh) @@ -279,11 +280,20 @@ sh Bourne Shell ;; for the time being '((ksh . ksh88) (bash2 . bash) - (sh5 . sh))) + (sh5 . sh) + ;; Android's system shell + ("^/system/bin/sh$" . mksh))) "Alist for transforming shell names to what they really are. -Use this where the name of the executable doesn't correspond to the type of -shell it really is." - :type '(repeat (cons symbol symbol)) +Use this where the name of the executable doesn't correspond to +the type of shell it really is. Keys are regular expressions +matched against the full path of the interpreter. (For backward +compatibility, keys may also be symbols, which are matched +against the interpreter's basename. The values are symbols +naming the shell." + :type '(repeat (cons (radio + (regexp :tag "Regular expression") + (symbol :tag "Basename")) + (symbol :tag "Shell"))) :group 'sh-script) @@ -387,15 +397,20 @@ the car and cdr are the same symbol.") "Non-nil if `sh-shell-variables' is initialized.") (defun sh-canonicalize-shell (shell) - "Convert a shell name SHELL to the one we should handle it as." - (if (string-match "\\.exe\\'" shell) - (setq shell (substring shell 0 (match-beginning 0)))) - (or (symbolp shell) - (setq shell (intern shell))) - (or (cdr (assq shell sh-alias-alist)) - shell)) - -(defvar sh-shell (sh-canonicalize-shell (file-name-nondirectory sh-shell-file)) + "Convert a shell name SHELL to the one we should handle it as. +SHELL is a full path to the shell interpreter; return a shell +name symbol." + (cl-loop + with shell = (cond ((string-match "\\.exe\\'" shell) + (substring shell 0 (match-beginning 0))) + (t shell)) + with shell-base = (intern (file-name-nondirectory shell)) + for (key . value) in sh-alias-alist + if (and (stringp key) (string-match key shell)) return value + if (eq key shell-base) return value + finally return shell-base)) + +(defvar sh-shell (sh-canonicalize-shell sh-shell-file) "The shell being programmed. This is set by \\[sh-set-shell].") ;;;###autoload(put 'sh-shell 'safe-local-variable 'symbolp) @@ -680,7 +695,7 @@ removed when closing the here document." "jobs" "kill" "let" "local" "popd" "printf" "pushd" "shopt" "source" "suspend" "typeset" "unalias" ;; bash4 - "mapfile" "readarray") + "mapfile" "readarray" "coproc") ;; The next entry is only used for defining the others (bourne sh-append shell @@ -895,7 +910,7 @@ See `sh-feature'.") (:foreground "tan1" )) (t (:weight bold))) - "Face to show a here-document" + "Face to show a here-document." :group 'sh-indentation) ;; These colors are probably icky. It's just a placeholder though. @@ -906,7 +921,7 @@ See `sh-feature'.") (:foreground "magenta")) (t (:weight bold))) - "Face to show quoted execs like ``" + "Face to show quoted execs like `blabla`." :group 'sh-indentation) (define-obsolete-face-alias 'sh-heredoc-face 'sh-heredoc "22.1") (defvar sh-heredoc-face 'sh-heredoc) @@ -1036,13 +1051,11 @@ Point is at the beginning of the next line." "Search for a subshell embedded in a string. Find all the unescaped \" characters within said subshell, remembering that subshells can nest." - ;; FIXME: This can (and often does) match multiple lines, yet it makes no - ;; effort to handle multiline cases correctly, so it ends up being - ;; rather flaky. (when (eq ?\" (nth 3 (syntax-ppss))) ; Check we matched an opening quote. ;; bingo we have a $( or a ` inside a "" (let (;; `state' can be: double-quote, backquote, code. (state (if (eq (char-before) ?`) 'backquote 'code)) + (startpos (point)) ;; Stacked states in the context. (states '(double-quote))) (while (and state (progn (skip-chars-forward "^'\\\\\"`$()" limit) @@ -1073,7 +1086,12 @@ subshells can nest." (`double-quote nil) (_ (setq state (pop states))))) (_ (error "Internal error in sh-font-lock-quoted-subshell"))) - (forward-char 1))))) + (forward-char 1)) + (when (< startpos (line-beginning-position)) + (put-text-property startpos (point) 'syntax-multiline t) + (add-hook 'syntax-propertize-extend-region-functions + 'syntax-propertize-multiline nil t)) + ))) (defun sh-is-quoted-p (pos) @@ -1536,6 +1554,12 @@ When the region is active, send the region instead." ;; mode-command and utility functions +(defun sh-after-hack-local-variables () + (when (assq 'sh-shell file-local-variables-alist) + (sh-set-shell (if (symbolp sh-shell) + (symbol-name sh-shell) + sh-shell)))) + ;;;###autoload (define-derived-mode sh-mode prog-mode "Shell-script" "Major mode for editing shell scripts. @@ -1645,7 +1669,9 @@ with your script for an edit-interpret-debug cycle." ((string-match "[.]csh\\>" buffer-file-name) "csh") ((equal (file-name-nondirectory buffer-file-name) ".profile") "sh") (t sh-shell-file)) - nil nil)) + nil nil) + (add-hook 'hack-local-variables-hook + #'sh-after-hack-local-variables nil t)) ;;;###autoload (defalias 'shell-script-mode 'sh-mode) @@ -2299,9 +2325,7 @@ Calls the value of `sh-set-shell-hook' if set." t)) (if (string-match "\\.exe\\'" shell) (setq shell (substring shell 0 (match-beginning 0)))) - (setq sh-shell (intern (file-name-nondirectory shell)) - sh-shell (or (cdr (assq sh-shell sh-alias-alist)) - sh-shell)) + (setq sh-shell (sh-canonicalize-shell shell)) (if insert-flag (setq sh-shell-file (executable-set-magic shell (sh-feature sh-shell-arg) @@ -2353,7 +2377,7 @@ Calls the value of `sh-set-shell-hook' if set." (when font-lock-mode (setq font-lock-set-defaults nil) (font-lock-set-defaults) - (font-lock-fontify-buffer)) + (font-lock-flush)) (setq sh-shell-process nil) (run-hooks 'sh-set-shell-hook)) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 6fac2221f6f..2ed3a745bb0 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -212,11 +212,11 @@ ;; Michael Mauger <michael@mauger.com> -- improved product support ;; Drew Adams <drew.adams@oracle.com> -- Emacs 20 support ;; Harald Maier <maierh@myself.com> -- sql-send-string -;; Stefan Monnier <monnier@iro.umontreal.ca> -- font-lock corrections; +;; Stefan Monnier <monnier@iro.umontreal.ca> -- font-lock corrections; ;; code polish ;; Paul Sleigh <bat@flurf.net> -- MySQL keyword enhancement ;; Andrew Schein <andrew@andrewschein.com> -- sql-port bug -;; Ian Bjorhovde <idbjorh@dataproxy.com> -- db2 escape newlines +;; Ian Bjorhovde <idbjorh@dataproxy.com> -- db2 escape newlines ;; incorrectly enabled by default ;; Roman Scherer <roman.scherer@nugg.ad> -- Connection documentation ;; Mark Wilkinson <wilkinsonmr@gmail.com> -- file-local variables ignored @@ -282,6 +282,13 @@ file. Since that is a plaintext file, this could be dangerous." :group 'SQL :safe 'numberp) +(defcustom sql-default-directory nil + "Default directory for SQL processes." + :version "25.1" + :type '(choice (const nil) string) + :group 'SQL + :safe 'stringp) + ;; Login parameter type (define-widget 'sql-login-params 'lazy @@ -498,6 +505,18 @@ file. Since that is a plaintext file, this could be dangerous." :prompt-length 5 :syntax-alist ((?@ . "_")) :terminator ("^go" . "go")) + + (vertica + :name "Vertica" + :sqli-program sql-vertica-program + :sqli-options sql-vertica-options + :sqli-login sql-vertica-login-params + :sqli-comint-func sql-comint-vertica + :list-all ("\\d" . "\\dS") + :list-table "\\d %s" + :prompt-regexp "^\\w*=[#>] " + :prompt-length 5 + :prompt-cont-regexp "^\\w*[-(][#>] ") ) "An alist of product specific configuration settings. @@ -1221,7 +1240,9 @@ Based on `comint-mode-map'.") (define-key map (kbd "C-c C-r") 'sql-send-region) (define-key map (kbd "C-c C-s") 'sql-send-string) (define-key map (kbd "C-c C-b") 'sql-send-buffer) + (define-key map (kbd "C-c C-n") 'sql-send-line-and-next) (define-key map (kbd "C-c C-i") 'sql-product-interactive) + (define-key map (kbd "C-c C-z") 'sql-show-sqli-buffer) (define-key map (kbd "C-c C-l a") 'sql-list-all) (define-key map (kbd "C-c C-l t") 'sql-list-table) (define-key map [remap beginning-of-defun] 'sql-beginning-of-statement) @@ -1556,8 +1577,6 @@ to add functions and PL/SQL keywords.") ;; Oracle SQL*Plus Commands ;; Only recognized in they start in column 1 and the ;; abbreviation is followed by a space or the end of line. - - "\\|" (list (concat "^" (sql-regexp-abbrev "rem~ark") "\\(?:\\s-.*\\)?$") 0 'font-lock-comment-face t) @@ -1605,6 +1624,11 @@ to add functions and PL/SQL keywords.") 0 'font-lock-doc-face t) '("&?&\\(?:\\sw\\|\\s_\\)+[.]?" 0 font-lock-preprocessor-face t) + ;; Oracle PL/SQL Attributes (Declare these first to match %TYPE correctly) + (sql-font-lock-keywords-builder 'font-lock-builtin-face '("%" . "\\b") +"bulk_exceptions" "bulk_rowcount" "found" "isopen" "notfound" +"rowcount" "rowtype" "type" +) ;; Oracle Functions (sql-font-lock-keywords-builder 'font-lock-builtin-face nil "abs" "acos" "add_months" "appendchildxml" "ascii" "asciistr" "asin" @@ -1634,7 +1658,7 @@ to add functions and PL/SQL keywords.") "prediction" "prediction_bounds" "prediction_cost" "prediction_details" "prediction_probability" "prediction_set" "presentnnv" "presentv" "previous" "rank" "ratio_to_report" "rawtohex" -"rawtonhex" "ref" "reftohex" "regexp_count" "regexp_instr" +"rawtonhex" "ref" "reftohex" "regexp_count" "regexp_instr" "regexp_like" "regexp_replace" "regexp_substr" "regr_avgx" "regr_avgy" "regr_count" "regr_intercept" "regr_r2" "regr_slope" "regr_sxx" "regr_sxy" "regr_syy" "remainder" "replace" "round" "rowidtochar" "rowidtonchar" @@ -1719,7 +1743,7 @@ to add functions and PL/SQL keywords.") "password_life_time" "password_lock_time" "password_reuse_max" "password_reuse_time" "password_verify_function" "pctfree" "pctincrease" "pctthreshold" "pctused" "pctversion" "percent" -"performance" "permanent" "pfile" "physical" "pipelined" "plan" +"performance" "permanent" "pfile" "physical" "pipelined" "pivot" "plan" "post_transaction" "pragma" "prebuilt" "preserve" "primary" "private" "private_sga" "privileges" "procedure" "profile" "protection" "public" "purge" "query" "quiesce" "quota" "range" "read" "reads" "rebuild" @@ -1742,7 +1766,7 @@ to add functions and PL/SQL keywords.") "temporary" "test" "than" "then" "thread" "through" "time_zone" "timeout" "to" "trace" "transaction" "trigger" "triggers" "truncate" "trust" "type" "types" "unarchived" "under" "under_path" "undo" -"uniform" "union" "unique" "unlimited" "unlock" "unquiesce" +"uniform" "union" "unique" "unlimited" "unlock" "unpivot" "unquiesce" "unrecoverable" "until" "unusable" "unused" "update" "upgrade" "usage" "use" "using" "validate" "validation" "value" "values" "variable" "varray" "version" "view" "wait" "when" "whenever" "where" "with" @@ -1757,12 +1781,6 @@ to add functions and PL/SQL keywords.") "time" "timestamp" "urowid" "varchar2" "with" "year" "zone" ) - ;; Oracle PL/SQL Attributes - (sql-font-lock-keywords-builder 'font-lock-builtin-face '("%" . "\\b") -"bulk_exceptions" "bulk_rowcount" "found" "isopen" "notfound" -"rowcount" "rowtype" "type" -) - ;; Oracle PL/SQL Functions (sql-font-lock-keywords-builder 'font-lock-builtin-face nil "delete" "trim" "extend" "exists" "first" "last" "count" "limit" @@ -3050,7 +3068,7 @@ If you call it from anywhere else, it sets the global copy of (interactive) (let ((default-buffer (sql-find-sqli-buffer))) (if (null default-buffer) - (user-error "There is no suitable SQLi buffer") + (sql-product-interactive) (let ((new-buffer (read-buffer "New SQLi buffer: " default-buffer t))) (if (null (sql-buffer-live-p new-buffer)) (user-error "Buffer %s is not a working SQLi buffer" new-buffer) @@ -3059,21 +3077,20 @@ If you call it from anywhere else, it sets the global copy of (run-hooks 'sql-set-sqli-hook))))))) (defun sql-show-sqli-buffer () - "Show the name of current SQLi buffer. + "Display the current SQLi buffer. -This is the buffer SQL strings are sent to. It is stored in the -variable `sql-buffer'. See `sql-help' on how to create such a buffer." +This is the buffer SQL strings are sent to. +It is stored in the variable `sql-buffer'. +I +See also `sql-help' on how to create such a buffer." (interactive) - (if (or (null sql-buffer) - (null (buffer-live-p (get-buffer sql-buffer)))) - (user-error "%s has no SQLi buffer set" (buffer-name (current-buffer))) - (if (null (get-buffer-process sql-buffer)) - (user-error "Buffer %s has no process" sql-buffer) - (user-error "Current SQLi buffer is %s" sql-buffer)))) + (unless (and sql-buffer (buffer-live-p (get-buffer sql-buffer)) + (get-buffer-process sql-buffer)) + (sql-set-sqli-buffer)) + (display-buffer sql-buffer)) (defun sql-make-alternate-buffer-name () "Return a string that can be used to rename a SQLi buffer. - This is used to set `sql-alternate-buffer-name' within `sql-interactive-mode'. @@ -3323,7 +3340,7 @@ to avoid deleting non-prompt output." (setq oline (replace-match "" nil nil oline) sql-output-newline-count (1- sql-output-newline-count) prompt-found t))) - + ;; If we've found all the expected prompts, stop looking (if (= sql-output-newline-count 0) (setq sql-output-newline-count nil @@ -3403,6 +3420,13 @@ to avoid deleting non-prompt output." (interactive) (sql-send-region (point-min) (point-max))) +(defun sql-send-line-and-next () + "Send the current line to the SQL process and go to the next line." + (interactive) + (sql-send-region (line-beginning-position 1) (line-beginning-position 2)) + (beginning-of-line 2) + (while (forward-comment 1))) ; skip all comments and whitespace + (defun sql-send-magic-terminator (buf str terminator) "Send TERMINATOR to buffer BUF if its not present in STR." (let (comint-input-sender-no-newline pat term) @@ -3480,45 +3504,51 @@ list of SQLi command strings." (message "Executing SQL command...done")))) (defun sql-redirect-one (sqlbuf command outbuf save-prior) - (with-current-buffer sqlbuf - (let ((buf (get-buffer-create (or outbuf " *SQL-Redirect*"))) - (proc (get-buffer-process (current-buffer))) - (comint-prompt-regexp (sql-get-product-feature sql-product - :prompt-regexp)) - (start nil)) - (with-current-buffer buf - (setq-local view-no-disable-on-exit t) - (read-only-mode -1) - (unless save-prior - (erase-buffer)) - (goto-char (point-max)) - (unless (zerop (buffer-size)) - (insert "\n")) - (setq start (point))) - - (when sql-debug-redirect - (message ">>SQL> %S" command)) - - ;; Run the command - (comint-redirect-send-command-to-process command buf proc nil t) - (while (null comint-redirect-completed) - (accept-process-output nil 1)) - - ;; Clean up the output results - (with-current-buffer buf - ;; Remove trailing whitespace - (goto-char (point-max)) - (when (looking-back "[ \t\f\n\r]*" start) - (delete-region (match-beginning 0) (match-end 0))) - ;; Remove echo if there was one - (goto-char start) - (when (looking-at (concat "^" (regexp-quote command) "[\\n]")) - (delete-region (match-beginning 0) (match-end 0))) - ;; Remove Ctrl-Ms - (goto-char start) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (goto-char start))))) + (when command + (with-current-buffer sqlbuf + (let ((buf (get-buffer-create (or outbuf " *SQL-Redirect*"))) + (proc (get-buffer-process (current-buffer))) + (comint-prompt-regexp (sql-get-product-feature sql-product + :prompt-regexp)) + (start nil)) + (with-current-buffer buf + (setq-local view-no-disable-on-exit t) + (read-only-mode -1) + (unless save-prior + (erase-buffer)) + (goto-char (point-max)) + (unless (zerop (buffer-size)) + (insert "\n")) + (setq start (point))) + + (when sql-debug-redirect + (message ">>SQL> %S" command)) + + ;; Run the command + (let ((inhibit-quit t) + comint-preoutput-filter-functions) + (with-local-quit + (comint-redirect-send-command-to-process command buf proc nil t) + (while (or quit-flag (null comint-redirect-completed)) + (accept-process-output nil 1))) + + (if quit-flag + (comint-redirect-cleanup) + ;; Clean up the output results + (with-current-buffer buf + ;; Remove trailing whitespace + (goto-char (point-max)) + (when (looking-back "[ \t\f\n\r]*" start) + (delete-region (match-beginning 0) (match-end 0))) + ;; Remove echo if there was one + (goto-char start) + (when (looking-at (concat "^" (regexp-quote command) "[\\n]")) + (delete-region (match-beginning 0) (match-end 0))) + ;; Remove Ctrl-Ms + (goto-char start) + (while (re-search-forward "\r+$" nil t) + (replace-match "" t t)) + (goto-char start)))))))) (defun sql-redirect-value (sqlbuf command regexp &optional regexp-groups) "Execute the SQL command and return part of result. @@ -3589,7 +3619,7 @@ buffer is popped into a view window." (apply c sqlbuf outbuf enhanced arg nil)) (t (error "Unknown sql-execute item %s" c)))) (if (consp command) command (cons command nil))) - + (setq outbuf (get-buffer outbuf)) (if (zerop (buffer-size outbuf)) (kill-buffer outbuf) @@ -3597,7 +3627,11 @@ buffer is popped into a view window." (get-lru-window)))) (with-current-buffer outbuf (set-buffer-modified-p nil) - (read-only-mode +1)) + (setq-local revert-buffer-function + (lambda (_ignore-auto _noconfirm) + (sql-execute sqlbuf (buffer-name outbuf) + command enhanced arg))) + (special-mode)) (pop-to-buffer outbuf) (when one-win (shrink-window-if-larger-than-buffer))))) @@ -3755,7 +3789,9 @@ must tell Emacs. Here's how to do that in your init file: \(add-hook 'sql-mode-hook (lambda () (modify-syntax-entry ?\\\\ \".\" sql-mode-syntax-table)))" + :group 'SQL :abbrev-table sql-mode-abbrev-table + (if sql-mode-menu (easy-menu-add sql-mode-menu)); XEmacs @@ -3786,6 +3822,7 @@ must tell Emacs. Here's how to do that in your init file: ;;; SQL interactive mode (put 'sql-interactive-mode 'mode-class 'special) +(put 'sql-interactive-mode 'custom-mode-group 'SQL) (defun sql-interactive-mode () "Major mode to use a SQL interpreter interactively. @@ -3928,11 +3965,10 @@ you entered, right above the output it created. ;; People wanting a different history file for each ;; buffer/process/client/whatever can change separator and file-name ;; on the sql-interactive-mode-hook. - (setq-local comint-input-ring-separator sql-input-ring-separator) - (setq comint-input-ring-file-name sql-input-ring-file-name) - ;; Calling the hook before calling comint-read-input-ring allows users - ;; to set comint-input-ring-file-name in sql-interactive-mode-hook. - (comint-read-input-ring t)) + (let + ((comint-input-ring-separator sql-input-ring-separator) + (comint-input-ring-file-name sql-input-ring-file-name)) + (comint-read-input-ring t))) (defun sql-stop (process event) "Called when the SQL process is stopped. @@ -3942,11 +3978,15 @@ Writes the input history to a history file using This function is a sentinel watching the SQL interpreter process. Sentinels will always get the two parameters PROCESS and EVENT." - (comint-write-input-ring) - (if (and (eq (current-buffer) sql-buffer) - (not buffer-read-only)) - (insert (format "\nProcess %s %s\n" process event)) - (message "Process %s %s" process event))) + (with-current-buffer (process-buffer process) + (let + ((comint-input-ring-separator sql-input-ring-separator) + (comint-input-ring-file-name sql-input-ring-file-name)) + (comint-write-input-ring)) + + (if (not buffer-read-only) + (insert (format "\nProcess %s %s\n" process event)) + (message "Process %s %s" process event)))) @@ -4164,7 +4204,9 @@ the call to \\[sql-product-interactive] with (sql-password (default-value 'sql-password)) (sql-server (default-value 'sql-server)) (sql-database (default-value 'sql-database)) - (sql-port (default-value 'sql-port))) + (sql-port (default-value 'sql-port)) + (default-directory (or sql-default-directory + default-directory))) (funcall (sql-get-product-feature product :sqli-comint-func) product (sql-get-product-feature product :sqli-options))) @@ -5039,6 +5081,46 @@ buffer. +(defcustom sql-vertica-program "vsql" + "Command to start the Vertica client." + :version "25.1" + :type 'file + :group 'SQL) + +(defcustom sql-vertica-options '("-P" "pager=off") + "List of additional options for `sql-vertica-program'. +The default value disables the internal pager." + :version "25.1" + :type '(repeat string) + :group 'SQL) + +(defcustom sql-vertica-login-params '(user password database server) + "List of login parameters needed to connect to Vertica." + :version "25.1" + :type 'sql-login-params + :group 'SQL) + +(defun sql-comint-vertica (product options) + "Create comint buffer and connect to Vertica." + (sql-comint product + (nconc + (and (not (string= "" sql-server)) + (list "-h" sql-server)) + (and (not (string= "" sql-database)) + (list "-d" sql-database)) + (and (not (string= "" sql-password)) + (list "-w" sql-password)) + (and (not (string= "" sql-user)) + (list "-U" sql-user)) + options))) + +;;;###autoload +(defun sql-vertica (&optional buffer) + "Run vsql as an inferior process." + (interactive "P") + (sql-product-interactive 'vertica buffer)) + + (provide 'sql) ;;; sql.el ends here diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el index 738618e0f51..a279e294fec 100644 --- a/lisp/progmodes/subword.el +++ b/lisp/progmodes/subword.el @@ -1,4 +1,4 @@ -;;; subword.el --- Handling capitalized subwords in a nomenclature +;;; subword.el --- Handling capitalized subwords in a nomenclature -*- lexical-binding: t -*- ;; Copyright (C) 2004-2015 Free Software Foundation, Inc. @@ -21,13 +21,10 @@ ;;; Commentary: -;; This package was cc-submode.el before it was recognized being -;; useful in general and not tied to C and c-mode at all. - -;; This package provides `subword' oriented commands and a minor mode -;; (`subword-mode') that substitutes the common word handling -;; functions with them. It also provides the `superword-mode' minor -;; mode that treats symbols as words, the opposite of `subword-mode'. +;; This package provides the `subword' minor mode, which merges the +;; old remap-based subword.el (derived from cc-mode code) and +;; cap-words.el, which takes advantage of core Emacs +;; word-motion-customization functionality. ;; In spite of GNU Coding Standards, it is popular to name a symbol by ;; mixing uppercase and lowercase letters, e.g. "GtkWidget", @@ -47,25 +44,6 @@ ;; words. You also get a mode to treat symbols as words instead, ;; called `superword-mode' (the opposite of `subword-mode'). -;; In the minor mode, all common key bindings for word oriented -;; commands are overridden by the subword oriented commands: - -;; Key Word oriented command Subword oriented command (also superword) -;; ============================================================ -;; M-f `forward-word' `subword-forward' -;; M-b `backward-word' `subword-backward' -;; M-@ `mark-word' `subword-mark' -;; M-d `kill-word' `subword-kill' -;; M-DEL `backward-kill-word' `subword-backward-kill' -;; M-t `transpose-words' `subword-transpose' -;; M-c `capitalize-word' `subword-capitalize' -;; M-u `upcase-word' `subword-upcase' -;; M-l `downcase-word' `subword-downcase' -;; -;; Note: If you have changed the key bindings for the word oriented -;; commands in your .emacs or a similar place, the keys you've changed -;; to are also used for the corresponding subword oriented commands. - ;; To make the mode turn on automatically, put the following code in ;; your .emacs: ;; @@ -102,27 +80,25 @@ "Regexp used by `subword-backward-internal'.") (defvar subword-mode-map - (let ((map (make-sparse-keymap))) - (dolist (cmd '(forward-word backward-word mark-word kill-word - backward-kill-word transpose-words - capitalize-word upcase-word downcase-word - left-word right-word)) - (let ((othercmd (let ((name (symbol-name cmd))) - (string-match "\\([[:alpha:]-]+\\)-word[s]?" name) - (intern (concat "subword-" (match-string 1 name)))))) - (define-key map (vector 'remap cmd) othercmd))) - map) + ;; We originally remapped motion keys here, but now use Emacs core + ;; hooks. Leave this keymap around so that user additions to it + ;; keep working. + (make-sparse-keymap) "Keymap used in `subword-mode' minor mode.") ;;;###autoload +(define-obsolete-function-alias + 'capitalized-words-mode 'subword-mode "25.1") + +;;;###autoload (define-minor-mode subword-mode "Toggle subword movement and editing (Subword mode). With a prefix argument ARG, enable Subword mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -Subword mode is a buffer-local minor mode. Enabling it remaps -word-based editing commands to subword-based commands that handle +Subword mode is a buffer-local minor mode. Enabling it changes +the definition of a word so that word-based commands stop inside symbols with mixed uppercase and lowercase letters, e.g. \"GtkWidget\", \"EmacsFrameClass\", \"NSGraphicsContext\". @@ -136,13 +112,13 @@ called a `subword'. Here are some examples: EmacsFrameClass => \"Emacs\", \"Frame\" and \"Class\" NSGraphicsContext => \"NS\", \"Graphics\" and \"Context\" -The subword oriented commands activated in this minor mode recognize -subwords in a nomenclature to move between subwords and to edit them -as words. +This mode changes the definition of a word so that word commands +treat nomenclature boundaries as word boundaries. \\{subword-mode-map}" :lighter " ," - (when subword-mode (superword-mode -1))) + (when subword-mode (superword-mode -1)) + (subword-setup-buffer)) (define-obsolete-function-alias 'c-subword-mode 'subword-mode "23.2") @@ -151,6 +127,13 @@ as words. (lambda () (subword-mode 1)) :group 'convenience) +;; N.B. These commands aren't used unless explicitly invoked; they're +;; here for compatibility. Today, subword-mode leaves motion commands +;; alone and uses `find-word-boundary-function-table' to change how +;; `forward-word' and other low-level commands detect word boundaries. +;; This way, all word-related activities, not just the images we +;; imagine here, get subword treatment. + (defun subword-forward (&optional arg) "Do the same as `forward-word' but on subwords. See the command `subword-mode' for a description of subwords. @@ -159,10 +142,10 @@ Optional argument ARG is the same as for `forward-word'." (unless arg (setq arg 1)) (cond ((< 0 arg) - (dotimes (i arg (point)) + (dotimes (_i arg (point)) (funcall subword-forward-function))) ((> 0 arg) - (dotimes (i (- arg) (point)) + (dotimes (_i (- arg) (point)) (funcall subword-backward-function))) (t (point)))) @@ -262,7 +245,7 @@ Optional argument ARG is the same as for `capitalize-word'." (start (point)) (advance (>= arg 0))) - (dotimes (i count) + (dotimes (_i count) (if advance (progn (re-search-forward "[[:alpha:]]") @@ -290,17 +273,15 @@ With a prefix argument ARG, enable Superword mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -Superword mode is a buffer-local minor mode. Enabling it remaps -word-based editing commands to superword-based commands that -treat symbols as words, e.g. \"this_is_a_symbol\". - -The superword oriented commands activated in this minor mode -recognize symbols as superwords to move between superwords and to -edit them as words. +Superword mode is a buffer-local minor mode. Enabling it changes +the definition of words such that symbols characters are treated +as parts of words: e.g., in `superword-mode', +\"this_is_a_symbol\" counts as one word. \\{superword-mode-map}" :lighter " ²" - (when superword-mode (subword-mode -1))) + (when superword-mode (subword-mode -1)) + (subword-setup-buffer)) ;;;###autoload (define-global-minor-mode global-superword-mode superword-mode @@ -347,9 +328,45 @@ edit them as words. (1+ (match-beginning 0))))) (backward-word 1)))) +(defconst subword-find-word-boundary-function-table + (let ((tab (make-char-table nil))) + (set-char-table-range tab t #'subword-find-word-boundary) + tab) + "Assigned to `find-word-boundary-function-table' in +`subword-mode' and `superword-mode'; defers to +`subword-find-word-boundary'.") + +(defconst subword-empty-char-table + (make-char-table nil) + "Assigned to `find-word-boundary-function-table' while we're +searching subwords in order to avoid unwanted reentrancy.") + +(defun subword-setup-buffer () + (set (make-local-variable 'find-word-boundary-function-table) + (if (or subword-mode superword-mode) + subword-find-word-boundary-function-table + subword-empty-char-table))) + +(defun subword-find-word-boundary (pos limit) + "Catch-all handler in `subword-find-word-boundary-function-table'." + (let ((find-word-boundary-function-table subword-empty-char-table)) + (save-match-data + (save-excursion + (save-restriction + (if (< pos limit) + (progn + (goto-char pos) + (narrow-to-region (point-min) limit) + (funcall subword-forward-function)) + (goto-char (1+ pos)) + (narrow-to-region limit (point-max)) + (funcall subword-backward-function)) + (point)))))) + (provide 'subword) (provide 'superword) +(provide 'cap-words) ; Obsolete alias ;;; subword.el ends here diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index 0e804b35e44..5f1cb53f1dd 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -138,7 +138,6 @@ If nil, TAB always indents current line." (define-key map "\C-c\t" 'indent-according-to-mode) (define-key map "\M-\C-\\" 'vera-indent-region) (define-key map "\C-c\C-c" 'vera-comment-uncomment-region) - (define-key map "\C-c\C-f" 'vera-fontify-buffer) (define-key map "\C-c\C-v" 'vera-version) (define-key map "\M-\t" 'tab-to-tab-stop) ;; Electric key bindings. @@ -172,8 +171,6 @@ If nil, TAB always indents current line." ["Indent Region" vera-indent-region (mark)] ["Indent Buffer" vera-indent-buffer t] "--" - ["Fontify Buffer" vera-fontify-buffer t] - "--" ["Documentation" describe-mode] ["Version" vera-version t] ["Bug Report..." vera-submit-bug-report t] @@ -686,7 +683,8 @@ Adapted from `font-lock-match-c-style-declaration-item-and-skip-to-next'." "Font lock mode face used to highlight interface names." :group 'font-lock-highlighting-faces) -(defalias 'vera-fontify-buffer 'font-lock-fontify-buffer) +(define-obsolete-function-alias 'vera-fontify-buffer + 'font-lock-fontify-buffer "25.1") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Indentation diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index b0d48534241..7b6f2d3a819 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -123,7 +123,7 @@ ;;; Code: ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2013-11-05-78e66ba-vpo" +(defconst verilog-mode-version "2014-11-12-aa4b777-vpo" "Version of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -1020,6 +1020,20 @@ SystemVerilog designs." :type 'string) (put 'verilog-assignment-delay 'safe-local-variable 'stringp) +(defcustom verilog-auto-arg-format 'packed + "Formatting to use for AUTOARG signal names. +If 'packed', then as many inputs and outputs that fit within +`fill-column' will be put onto one line. + +If 'single', then a single input or output will be put onto each +line." + :version "25.1" + :type '(radio (const :tag "Line up Assignments and Declarations" packed) + (const :tag "Line up Assignment statements" single)) + :group 'verilog-mode-auto) +(put 'verilog-auto-arg-format 'safe-local-variable + '(lambda (x) (memq x '(packed single)))) + (defcustom verilog-auto-arg-sort nil "Non-nil means AUTOARG signal names will be sorted, not in declaration order. Declaration order is advantageous with order based instantiations @@ -1460,6 +1474,8 @@ If set will become buffer local.") :help "Help on AUTOINPUT - adding inputs from cells"] ["AUTOINSERTLISP" (describe-function 'verilog-auto-insert-lisp) :help "Help on AUTOINSERTLISP - insert text from a lisp function"] + ["AUTOINSERTLAST" (describe-function 'verilog-auto-insert-last) + :help "Help on AUTOINSERTLISPLAST - insert text from a lisp function"] ["AUTOINST" (describe-function 'verilog-auto-inst) :help "Help on AUTOINST - adding pins for cells"] ["AUTOINST (.*)" (describe-function 'verilog-auto-star) @@ -1634,7 +1650,7 @@ will break, as the o's continuously replace. xa -> x works ok though." string)) (defsubst verilog-re-search-forward (REGEXP BOUND NOERROR) - ; checkdoc-params: (REGEXP BOUND NOERROR) + ;; checkdoc-params: (REGEXP BOUND NOERROR) "Like `re-search-forward', but skips over match in comments or strings." (let ((mdata '(nil nil))) ;; So match-end will return nil if no matches found (while (and @@ -1650,7 +1666,7 @@ will break, as the o's continuously replace. xa -> x works ok though." (match-end 0))) (defsubst verilog-re-search-backward (REGEXP BOUND NOERROR) - ; checkdoc-params: (REGEXP BOUND NOERROR) + ;; checkdoc-params: (REGEXP BOUND NOERROR) "Like `re-search-backward', but skips over match in comments or strings." (let ((mdata '(nil nil))) ;; So match-end will return nil if no matches found (while (and @@ -1679,7 +1695,7 @@ so there may be a large up front penalty for the first search." pt)) (defsubst verilog-re-search-backward-quick (regexp bound noerror) - ; checkdoc-params: (REGEXP BOUND NOERROR) + ;; checkdoc-params: (REGEXP BOUND NOERROR) "Like `verilog-re-search-backward', including use of REGEXP BOUND and NOERROR, but trashes match data and is faster for REGEXP that doesn't match often. This uses `verilog-scan' and text properties to ignore comments, @@ -1748,6 +1764,7 @@ To call on \\[verilog-auto], set `verilog-auto-delete-trailing-whitespace'." (unless (bolp) (insert "\n")))) (defvar compile-command) +(defvar create-lockfiles) ;; Emacs 24 ;; compilation program (defun verilog-set-compile-command () @@ -2250,7 +2267,11 @@ find the errors." ;; "\\(assert\\|assume\\|cover\\)\\s-+property\\>" (defconst verilog-no-indent-begin-re - "\\<\\(if\\|else\\|while\\|for\\|repeat\\|always\\|always_comb\\|always_ff\\|always_latch\\)\\>") + (eval-when-compile + (verilog-regexp-words + '("always" "always_comb" "always_ff" "always_latch" "initial" "final" ;; procedural blocks + "if" "else" ;; conditional statements + "while" "for" "foreach" "repeat" "do" "forever" )))) ;; loop statements (defconst verilog-ends-re ;; Parenthesis indicate type of keyword found @@ -2308,6 +2329,7 @@ find the errors." "endinterface" "endpackage" "endsequence" + "endproperty" "endspecify" "endtable" "endtask" @@ -2340,6 +2362,7 @@ find the errors." "\\(program\\)\\|" ; 13 "\\(sequence\\)\\|" ; 14 "\\(clocking\\)\\|" ; 15 + "\\(property\\)\\|" ; 16 "\\)\\>\\)")) (defconst verilog-end-block-re (eval-when-compile @@ -2404,7 +2427,7 @@ find the errors." "\\(\\<package\\>\\)\\|" "\\(\\<final\\>\\)\\|" "\\(@\\)\\|" - "\\(\\<while\\>\\)\\|" + "\\(\\<while\\>\\)\\|\\(\\<do\\>\\)\\|" "\\(\\<for\\(ever\\|each\\)?\\>\\)\\|" "\\(\\<repeat\\>\\)\\|\\(\\<wait\\>\\)\\|" "#")) @@ -2498,15 +2521,20 @@ find the errors." "join" "join_any" "join_none" "end" "endcase" - "endconfig" + "endchecker" "endclass" "endclocking" + "endconfig" "endfunction" "endgenerate" + "endgroup" "endmodule" "endprimitive" "endinterface" "endpackage" + "endprogram" + "endproperty" + "endsequence" "endspecify" "endtable" "endtask" ) @@ -2704,9 +2732,9 @@ find the errors." (defconst verilog-disable-fork-re "\\(disable\\|wait\\)\\s-+fork\\>") (defconst verilog-extended-case-re "\\(\\(unique0?\\s-+\\|priority\\s-+\\)?case[xz]?\\)") (defconst verilog-extended-complete-re - (concat "\\(\\(\\<extern\\s-+\\|\\<\\(\\<pure\\>\\s-+\\)?virtual\\s-+\\|\\<protected\\s-+\\)*\\(\\<function\\>\\|\\<task\\>\\)\\)" + (concat "\\(\\(\\<extern\\s-+\\|\\<\\(\\<\\(pure\\|context\\)\\>\\s-+\\)?virtual\\s-+\\|\\<protected\\s-+\\)*\\(\\<function\\>\\|\\<task\\>\\)\\)" "\\|\\(\\(\\<typedef\\>\\s-+\\)*\\(\\<struct\\>\\|\\<union\\>\\|\\<class\\>\\)\\)" - "\\|\\(\\(\\<import\\>\\s-+\\)?\\(\"DPI-C\"\\s-+\\)?\\(\\<pure\\>\\s-+\\)?\\(function\\>\\|task\\>\\)\\)" + "\\|\\(\\(\\<import\\>\\s-+\\)?\\(\"DPI-C\"\\s-+\\)?\\(\\<\\(pure\\|context\\)\\>\\s-+\\)?\\([A-Za-z_][A-Za-z0-9_]*\\s-+=\\s-+\\)?\\(function\\>\\|task\\>\\)\\)" "\\|" verilog-extended-case-re )) (defconst verilog-basic-complete-re (eval-when-compile @@ -2736,10 +2764,45 @@ find the errors." "String used to mark end of excluded text.") (defconst verilog-preprocessor-re (eval-when-compile - (verilog-regexp-words - `( - "`define" "`include" "`ifdef" "`ifndef" "`if" "`endif" "`else" - )))) + (concat + ;; single words + "\\(?:" + (verilog-regexp-words + `("`__FILE__" + "`__LINE__" + "`celldefine" + "`else" + "`end_keywords" + "`endcelldefine" + "`endif" + "`nounconnected_drive" + "`resetall" + "`unconnected_drive" + "`undefineall")) + "\\)\\|\\(?:" + ;; two words: i.e. `ifdef DEFINE + "\\<\\(`elsif\\|`ifn?def\\|`undef\\|`default_nettype\\|`begin_keywords\\)\\>\\s-" + "\\)\\|\\(?:" + ;; `line number "filename" level + "\\<\\(`line\\)\\>\\s-+[0-9]+\\s-+\"[^\"]+\"\\s-+[012]" + "\\)\\|\\(?:" + ;;`include "file" or `include <file> + "\\<\\(`include\\)\\>\\s-+\\(?:\"[^\"]+\"\\|<[^>]+>\\)" + "\\)\\|\\(?:" + ;; `pragma <stuff> (no mention in IEEE 1800-2012 that pragma can span multiple lines + "\\<\\(`pragma\\)\\>\\s-+.+$" + "\\)\\|\\(?:" + ;; `timescale time_unit / time_precision + "\\<\\(`timescale\\)\\>\\s-+10\\{0,2\\}\\s-*[munpf]?s\\s-*\\/\\s-*10\\{0,2\\}\\s-*[munpf]?s" + "\\)\\|\\(?:" + ;; `define and `if can span multiple lines if line ends in '\'. NOTE: `if is not IEEE 1800-2012 + ;; from http://www.emacswiki.org/emacs/MultilineRegexp + (concat "\\<\\(`define\\|`if\\)\\>" ;; directive + "\\s-+" ;; separator + "\\(.*\\(?:\n.*\\)*?\\)" ;; definition: to tend of line, the maybe more lines (excludes any trailing \n) + "\\(?:\n\\s-*\n\\|\\'\\)") ;; blank line or EOF + "\\)" + ))) (defconst verilog-keywords '( "`case" "`default" "`define" "`else" "`endfor" "`endif" @@ -2788,8 +2851,8 @@ find the errors." "sync_reject_on" "unique0" "until" "until_with" "untyped" "weak" ;; 1800-2012 "implements" "interconnect" "nettype" "soft" - ) - "List of Verilog keywords.") + ) + "List of Verilog keywords.") (defconst verilog-comment-start-regexp "//\\|/\\*" "Dual comment value for `comment-start-regexp'.") @@ -2906,7 +2969,7 @@ See also `verilog-font-lock-extra-types'.") '( "and" "bit" "buf" "bufif0" "bufif1" "cmos" "defparam" "event" "genvar" "inout" "input" "integer" "localparam" - "logic" "mailbox" "nand" "nmos" "not" "notif0" "notif1" "or" + "logic" "mailbox" "nand" "nmos" "nor" "not" "notif0" "notif1" "or" "output" "parameter" "pmos" "pull0" "pull1" "pulldown" "pullup" "rcmos" "real" "realtime" "reg" "rnmos" "rpmos" "rtran" "rtranif0" "rtranif1" "semaphore" "signed" "struct" "supply" @@ -3332,9 +3395,9 @@ Use filename, if current buffer being edited shorten to just buffer name." (verilog-re-search-backward reg nil 'move)) (cond ((match-end 1) ; matched verilog-end-block-re - ; try to leap back to matching outward block by striding across - ; indent level changing tokens then immediately - ; previous line governs indentation. + ;; try to leap back to matching outward block by striding across + ;; indent level changing tokens then immediately + ;; previous line governs indentation. (verilog-leap-to-head)) ((match-end 2) ; else, we're in deep (setq elsec (1+ elsec))) @@ -3992,7 +4055,7 @@ This puts the mark at the end, and point at the beginning." (mark-defun))) (defun verilog-comment-region (start end) - ; checkdoc-params: (start end) + ;; checkdoc-params: (start end) "Put the region into a Verilog comment. The comments that are in this area are \"deformed\": `*)' becomes `!(*' and `}' becomes `!{'. @@ -4106,9 +4169,7 @@ Uses `verilog-scan' cache." (while (and (> (marker-position e) (point)) (verilog-re-search-forward - (concat - "\\<end\\(\\(function\\)\\|\\(task\\)\\|\\(module\\)\\|\\(primitive\\)\\|\\(interface\\)\\|\\(package\\)\\|\\(case\\)\\)?\\>" - "\\|\\(`endif\\)\\|\\(`else\\)") + verilog-auto-end-comment-lines-re nil 'move)) (goto-char (match-beginning 0)) (let ((indent-str (verilog-indent-line))) @@ -4137,45 +4198,47 @@ Uses `verilog-scan' cache." ;; or the token before us unambiguously ends a statement, ;; then move back a token and test again. (not (or - ;; stop if beginning of buffer - (bolp) - ;; stop if we find a ; + ;; stop if beginning of buffer + (bobp) + ;; stop if we find a ; (= (preceding-char) ?\;) - ;; stop if we see a named coverpoint + ;; stop if we see a named coverpoint (looking-at "\\w+\\W*:\\W*\\(coverpoint\\|cross\\|constraint\\)") - ;; keep going if we are in the middle of a word + ;; keep going if we are in the middle of a word (not (or (looking-at "\\<") (forward-word -1))) - ;; stop if we see an assertion (perhaps labeled) + ;; stop if we see an assertion (perhaps labeled) (and (looking-at "\\(\\<\\(assert\\|assume\\|cover\\)\\>\\s-+\\<property\\>\\)\\|\\(\\<assert\\>\\)") (progn - (setq h (point)) - (save-excursion - (verilog-backward-token) - (if (looking-at verilog-label-re) - (setq h (point)))) - (goto-char h))) - ;; stop if we see an extended complete reg, perhaps a complete one + (setq h (point)) + (save-excursion + (verilog-backward-token) + (if (looking-at verilog-label-re) + (setq h (point)))) + (goto-char h))) + ;; stop if we see an extended complete reg, perhaps a complete one (and - (looking-at verilog-complete-reg) - (let* ((p (point))) - (while (and (looking-at verilog-extended-complete-re) - (progn (setq p (point)) - (verilog-backward-token) - (/= p (point))))) - (goto-char p))) - ;; stop if we see a complete reg (previous found extended ones) + (looking-at verilog-complete-reg) + (let* ((p (point))) + (while (and (looking-at verilog-extended-complete-re) + (progn (setq p (point)) + (verilog-backward-token) + (/= p (point))))) + (goto-char p))) + ;; stop if we see a complete reg (previous found extended ones) (looking-at verilog-basic-complete-re) - ;; stop if previous token is an ender + ;; stop if previous token is an ender (save-excursion - (verilog-backward-token) - (or - (looking-at verilog-end-block-re) - (looking-at verilog-preprocessor-re))))) ;; end of test - (verilog-backward-syntactic-ws) - (verilog-backward-token)) + (verilog-backward-token) + (looking-at verilog-end-block-re)))) + (verilog-backward-syntactic-ws) + (verilog-backward-token)) ;; Now point is where the previous line ended. - (verilog-forward-syntactic-ws))) + (verilog-forward-syntactic-ws) + ;; Skip forward over any preprocessor directives, as they have wacky indentation + (if (looking-at verilog-preprocessor-re) + (progn (goto-char (match-end 0)) + (verilog-forward-syntactic-ws))))) (defun verilog-beg-of-statement-1 () "Move backward to beginning of statement." @@ -4189,13 +4252,12 @@ Uses `verilog-scan' cache." (verilog-backward-syntactic-ws) (if (or (bolp) (= (preceding-char) ?\;) - (save-excursion + (progn (verilog-backward-token) (looking-at verilog-ends-re))) (progn (goto-char pt) - (throw 'done t)) - (verilog-backward-token)))) + (throw 'done t))))) (verilog-forward-syntactic-ws))) ; ; (while (and @@ -4223,7 +4285,7 @@ Uses `verilog-scan' cache." ((equal (char-after) ?\}) (forward-char)) - ;; Skip to end of statement + ;; Skip to end of statement ((condition-case nil (setq pos (catch 'found @@ -4285,7 +4347,7 @@ More specifically, point @ in the line foo : @ begin" (setq nest (1+ nest))) ((match-end 2) (if (= nest 1) - (throw 'found 1)) + (throw 'found 1)) (setq nest (1- nest))) (t (throw 'found (= nest 0))))))) @@ -4430,6 +4492,7 @@ Limit search to point LIM." "\\(`ifdef\\>\\)\\|" "\\(`ifndef\\>\\)\\|" "\\(`elsif\\>\\)")) + (defun verilog-set-auto-endcomments (indent-str kill-existing-comment) "Add ending comment with given INDENT-STR. With KILL-EXISTING-COMMENT, remove what was there before. @@ -4752,10 +4815,10 @@ primitive or interface named NAME." (cond ((match-end 5) ;; of verilog-end-block-ordered-re (setq reg "\\(\\<function\\>\\)\\|\\(\\<\\(endfunction\\|task\\|\\(macro\\)?module\\|primitive\\)\\>\\)") - (setq name-re "\\w+\\s-*(")) + (setq name-re "\\w+\\(?:\n\\|\\s-\\)*[(;]")) ((match-end 6) ;; of verilog-end-block-ordered-re (setq reg "\\(\\<task\\>\\)\\|\\(\\<\\(endtask\\|function\\|\\(macro\\)?module\\|primitive\\)\\>\\)") - (setq name-re "\\w+\\s-*(")) + (setq name-re "\\w+\\(?:\n\\|\\s-\\)*[(;]")) ((match-end 7) ;; of verilog-end-block-ordered-re (setq reg "\\(\\<\\(macro\\)?module\\>\\)\\|\\<endmodule\\>")) ((match-end 8) ;; of verilog-end-block-ordered-re @@ -4774,6 +4837,8 @@ primitive or interface named NAME." (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<\\(endsequence\\|primitive\\|interface\\|\\(macro\\)?module\\)\\>\\)")) ((match-end 15) ;; of verilog-end-block-ordered-re (setq reg "\\(\\<clocking\\>\\)\\|\\<endclocking\\>")) + ((match-end 16) ;; of verilog-end-block-ordered-re + (setq reg "\\(\\<property\\>\\)\\|\\<endproperty\\>")) (t (error "Problem in verilog-set-auto-endcomments"))) (let (b e) @@ -5078,13 +5143,13 @@ FILENAME to find directory to run in, or defaults to `buffer-file-name`." (list (let ((default (verilog-expand-command verilog-preprocessor))) (set (make-local-variable `verilog-preprocessor) - (read-from-minibuffer "Run Preprocessor (like this): " - default nil nil - 'verilog-preprocess-history default))))) + (read-from-minibuffer "Run Preprocessor (like this): " + default nil nil + 'verilog-preprocess-history default))))) (unless command (setq command (verilog-expand-command verilog-preprocessor))) (let* ((fontlocked (and (boundp 'font-lock-mode) font-lock-mode)) - (dir (file-name-directory (or filename buffer-file-name))) - (cmd (concat "cd " dir "; " command))) + (dir (file-name-directory (or filename buffer-file-name))) + (cmd (concat "cd " dir "; " command))) (with-output-to-temp-buffer "*Verilog-Preprocessed*" (with-current-buffer (get-buffer "*Verilog-Preprocessed*") (insert (concat "// " cmd "\n")) @@ -5092,7 +5157,11 @@ FILENAME to find directory to run in, or defaults to `buffer-file-name`." (verilog-mode) ;; Without this force, it takes a few idle seconds ;; to get the color, which is very jarring - (when fontlocked (font-lock-fontify-buffer)))))) + (unless (fboundp 'font-lock-ensure) + ;; We should use font-lock-ensure in preference to + ;; font-lock-fontify-buffer, but IIUC the problem this is supposed to + ;; solve only appears in Emacsen older than font-lock-ensure anyway. + (when fontlocked (font-lock-fontify-buffer))))))) ;; @@ -5138,23 +5207,29 @@ Save the result unless optional NO-SAVE is t." ;; Make sure any sub-files we read get proper mode (setq-default major-mode 'verilog-mode) ;; Ditto files already read in - (mapc (lambda (buf) - (when (buffer-file-name buf) - (with-current-buffer buf - (verilog-mode)))) - (buffer-list)) - ;; Process the files - (mapcar (lambda (buf) + ;; Remember buffer list, so don't later pickup any verilog-getopt files + (let ((orig-buffer-list (buffer-list))) + (mapc (lambda (buf) (when (buffer-file-name buf) - (save-excursion - (if (not (file-exists-p (buffer-file-name buf))) - (error - (concat "File not found: " (buffer-file-name buf)))) - (message (concat "Processing " (buffer-file-name buf))) - (set-buffer buf) - (funcall funref) - (unless no-save (save-buffer))))) - (buffer-list)))) + (with-current-buffer buf + (verilog-mode) + (verilog-auto-reeval-locals) + (verilog-getopt-flags)))) + orig-buffer-list) + ;; Process the files + (mapcar (lambda (buf) + (when (buffer-file-name buf) + (save-excursion + (if (not (file-exists-p (buffer-file-name buf))) + (error + (concat "File not found: " (buffer-file-name buf)))) + (message (concat "Processing " (buffer-file-name buf))) + (set-buffer buf) + (funcall funref) + (when (and (not no-save) + (buffer-modified-p)) ;; Avoid "no changes to be saved" + (save-buffer))))) + orig-buffer-list)))) (defun verilog-batch-auto () "For use with --batch, perform automatic expansions as a stand-alone tool. @@ -5271,7 +5346,7 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (if (save-excursion (beginning-of-line) (and (looking-at verilog-directive-re-1) (not (or (looking-at "[ \t]*`[ou]vm_") - (looking-at "[ \t]*`vmm_"))))) + (looking-at "[ \t]*`vmm_"))))) (throw 'nesting 'directive)) ;; indent structs as if there were module level (setq structres (verilog-in-struct-nested-p)) @@ -5510,10 +5585,10 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." ; endfunction (verilog-beg-of-statement) (if (looking-at verilog-beg-block-re-ordered) - (throw 'nesting 'block) - (throw 'nesting 'defun))) + (throw 'nesting 'block) + (throw 'nesting 'defun))) - ;; + ;; ((looking-at "\\<property\\>") ; *sigh* ; {assert|assume|cover} property (); are complete @@ -5704,7 +5779,7 @@ Jump from end to matching begin, from endcase to matching case, and so on." (setq sreg reg) (setq reg "\\(\\<fork\\>\\)\\|\\(\\<join\\(_any\\|_none\\)?\\>\\)" )) ))) - ;no nesting + ;; no nesting (if (and (verilog-re-search-backward reg nil 'move) (match-end 1)) ; task -> could be virtual and/or protected @@ -5818,7 +5893,9 @@ Set point to where line starts." (;-- any of begin|initial|while are complete statements; 'begin : foo' is also complete t (forward-word -1) - (while (= (preceding-char) ?\_) + (while (or (= (preceding-char) ?\_) + (= (preceding-char) ?\@) + (= (preceding-char) ?\.)) (forward-word -1)) (cond ((looking-at "\\<else\\>") @@ -6072,14 +6149,18 @@ Return >0 for nested struct." (defun verilog-at-constraint-p () "If at the { of a constraint or coverpoint definition, return true, moving point to constraint." (if (save-excursion + (let ((p (point))) (and (equal (char-after) ?\{) (forward-list) (progn (backward-char 1) (verilog-backward-ws&directives) + (and (or (equal (char-before) ?\{) ;; empty case (equal (char-before) ?\;) - (equal (char-before) ?\}))))) + (equal (char-before) ?\})) + ;; skip what looks like bus repetition operator {#{ + (not (string-match "^{\\s-*[0-9]+\\s-*{" (buffer-substring p (point))))))))) (progn (let ( (pt (point)) (pass 0)) (verilog-backward-ws&directives) @@ -6398,6 +6479,9 @@ Only look at a few lines to determine indent level." (looking-at verilog-declaration-re)) (verilog-indent-declaration ind)) + (;-- form feeds - ignored as bug in indent-line-to in < 24.5 + (looking-at "\f")) + (;-- Everything else t (let ((val (eval (cdr (assoc type verilog-indent-alist))))) @@ -6547,10 +6631,9 @@ Be verbose about progress unless optional QUIET set." endpos (set-marker (make-marker) end) base-ind (progn (goto-char start) - (forward-char 1) - (skip-chars-forward " \t") - (current-column)) - ) + (forward-char 1) + (skip-chars-forward " \t") + (current-column))) ;; in a declaration block (not in argument list) (setq start (progn @@ -8065,7 +8148,7 @@ Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters." Return an array of [outputs inouts inputs wire reg assign const]." (let ((end-mod-point (or (verilog-get-end-of-defun) (point-max))) (functask 0) (paren 0) (sig-paren 0) (v2kargs-ok t) - in-modport in-clocking ptype ign-prop + in-modport in-clocking in-ign-to-semi ptype ign-prop sigs-in sigs-out sigs-inout sigs-var sigs-assign sigs-const sigs-gparam sigs-intf sigs-modports vec expect-signal keywd newsig rvalue enum io signed typedefed multidim @@ -8097,19 +8180,24 @@ Return an array of [outputs inouts inputs wire reg assign const]." (or (re-search-forward "[^\\]\"" nil t) ;; don't forward-char first, since we look for a non backslash first (error "%s: Unmatched quotes, at char %d" (verilog-point-text) (point)))) ((eq ?\; (following-char)) - (when (and in-modport (not (eq in-modport t))) ;; end of a modport declaration - (verilog-modport-decls-set - in-modport - (verilog-decls-new sigs-out sigs-inout sigs-in - nil nil nil nil nil nil)) - ;; Pop from varstack to restore state to pre-clocking - (setq tmp (car varstack) - varstack (cdr varstack) - sigs-out (aref tmp 0) - sigs-inout (aref tmp 1) - sigs-in (aref tmp 2))) - (setq vec nil io nil expect-signal nil newsig nil paren 0 rvalue nil - v2kargs-ok nil in-modport nil ign-prop nil) + (cond (in-ign-to-semi ;; Such as inside a "import ...;" in a module header + (setq in-ign-to-semi nil)) + ((and in-modport (not (eq in-modport t))) ;; end of a modport declaration + (verilog-modport-decls-set + in-modport + (verilog-decls-new sigs-out sigs-inout sigs-in + nil nil nil nil nil nil)) + ;; Pop from varstack to restore state to pre-clocking + (setq tmp (car varstack) + varstack (cdr varstack) + sigs-out (aref tmp 0) + sigs-inout (aref tmp 1) + sigs-in (aref tmp 2)) + (setq vec nil io nil expect-signal nil newsig nil paren 0 rvalue nil + v2kargs-ok nil in-modport nil ign-prop nil)) + (t + (setq vec nil io nil expect-signal nil newsig nil paren 0 rvalue nil + v2kargs-ok nil in-modport nil ign-prop nil))) (forward-char 1)) ((eq ?= (following-char)) (setq rvalue t newsig nil) @@ -8212,8 +8300,12 @@ Return an array of [outputs inouts inputs wire reg assign const]." (setq in-modport t)) ((equal keywd "clocking") (setq in-clocking t)) + ((equal keywd "import") + (if v2kargs-ok ;; import in module header, not a modport import + (setq in-ign-to-semi t rvalue t))) ((equal keywd "type") (setq ptype t)) + ((equal keywd "var")) ;; Ifdef? Ignore name of define ((member keywd '("`ifdef" "`ifndef" "`elsif")) (setq rvalue t)) @@ -8224,7 +8316,8 @@ Return an array of [outputs inouts inputs wire reg assign const]." (setq typedefed (if typedefed (concat typedefed " " keywd) keywd))) (t (setq vec nil enum nil rvalue nil signed nil - typedefed nil multidim nil sig-paren paren + typedefed keywd ; Have a type + multidim nil sig-paren paren expect-signal 'sigs-var modport nil)))) ;; Interface with optional modport in v2k arglist? ;; Skip over parsing modport, and take the interface name as the type @@ -8285,6 +8378,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." (eq functask 0) (not (member keywd verilog-keywords))) ;; Add new signal to expect-signal's variable + ;;(if dbg (setq dbg (concat dbg (format "Pt %s New sig %s'\n" (point) keywd)))) (setq newsig (verilog-sig-new keywd vec nil nil enum signed typedefed multidim modport)) (set expect-signal (cons newsig (symbol-value expect-signal)))))) @@ -8853,7 +8947,6 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement." (save-excursion (let* (;;(dbg "") sigs-out-d sigs-out-i sigs-out-unk sigs-temp sigs-in) - (search-forward ")") (verilog-read-always-signals-recurse nil nil nil) (setq sigs-out-i (append sigs-out-i sigs-out-unk) sigs-out-unk nil) @@ -9138,7 +9231,7 @@ foo.v (an include file): `define _FOO_V ... contents of file `endif // _FOO_V" -;;slow: (verilog-read-defines nil t)) + ;;slow: (verilog-read-defines nil t) (save-excursion (verilog-getopt-flags) (goto-char (point-min)) @@ -9527,7 +9620,7 @@ variables to build the path. With optional CHECK-EXT also check (setq outlist (cons (expand-file-name fn (file-name-directory current)) outlist))) - (setq chkexts (cdr chkexts))) + (setq chkexts (cdr chkexts))) (setq chkdirs (cdr chkdirs))) (setq outlist (nreverse outlist)) (setq verilog-dir-cache-lib-filenames @@ -9624,7 +9717,7 @@ Return modi if successful, else print message unless IGNORE-ERROR is true." allow-cache (setq modi (gethash module verilog-modi-lookup-cache)) (equal verilog-modi-lookup-last-current current) - ;; Iff hit is in current buffer, then tick must match + ;; If hit is in current buffer, then tick must match (or (equal verilog-modi-lookup-last-tick (buffer-chars-modified-tick)) (not (equal current (verilog-modi-file-or-buffer modi))))) ;;(message "verilog-modi-lookup: HIT %S" modi) @@ -10602,7 +10695,7 @@ If FORCE, always reread it." ;; (defun verilog-auto-arg-ports (sigs message indent-pt) - "Print a list of ports for an AUTOINST. + "Print a list of ports for AUTOARG. Takes SIGS list, adds MESSAGE to front and inserts each at INDENT-PT." (when sigs (when verilog-auto-arg-sort @@ -10614,13 +10707,20 @@ Takes SIGS list, adds MESSAGE to front and inserts each at INDENT-PT." (let ((space "")) (indent-to indent-pt) (while sigs - (cond ((> (+ 2 (current-column) (length (verilog-sig-name (car sigs)))) fill-column) + (cond ((equal verilog-auto-arg-format 'single) + (insert space) + (indent-to indent-pt) + (setq space "\n")) + ;; verilog-auto-arg-format 'packed + ((> (+ 2 (current-column) (length (verilog-sig-name (car sigs)))) fill-column) (insert "\n") - (indent-to indent-pt)) - (t (insert space))) + (indent-to indent-pt) + (setq space " ")) + (t + (insert space) + (setq space " "))) (insert (verilog-sig-name (car sigs)) ",") - (setq sigs (cdr sigs) - space " "))))) + (setq sigs (cdr sigs)))))) (defun verilog-auto-arg () "Expand AUTOARG statements. @@ -10655,9 +10755,11 @@ Typing \\[verilog-auto] will make this into: output o; endmodule -The argument declarations may be printed in declaration order to best suit -order based instantiations, or alphabetically, based on the -`verilog-auto-arg-sort' variable. +The argument declarations may be printed in declaration order to +best suit order based instantiations, or alphabetically, based on +the `verilog-auto-arg-sort' variable. + +Formatting is controlled with `verilog-auto-arg-format' variable. Any ports declared between the ( and /*AUTOARG*/ are presumed to be predeclared and are not redeclared by AUTOARG. AUTOARG will make a @@ -11681,6 +11783,9 @@ Limitations: Typedefs must match `verilog-typedef-regexp', which is disabled by default. + Types are added to declarations if an AUTOLOGIC or + `verilog-auto-wire-type' is set to logic. + Signals matching `verilog-auto-output-ignore-regexp' are not included. An example (see `verilog-auto-inst' for what else is going on here): @@ -11773,10 +11878,18 @@ Typing \\[verilog-auto] will make this into: wire tempa = i; wire tempb = tempa; wire o = tempb; - endmodule" + endmodule + +You may also provide an optional regular expression, in which case only +signals matching the regular expression will be included. For example the +same expansion will result from only extracting outputs starting with ov: + + /*AUTOOUTPUTEVERY(\"^ov\")*/" (save-excursion ;;Point must be at insertion point (let* ((indent-pt (current-indentation)) + (params (verilog-read-auto-params 0 1)) + (regexp (nth 0 params)) (v2k (verilog-in-paren-quick)) (modi (verilog-modi-current)) (moddecls (verilog-modi-get-decls modi)) @@ -11784,6 +11897,11 @@ Typing \\[verilog-auto] will make this into: (verilog-signals-not-in (verilog-decls-get-signals moddecls) (verilog-decls-get-ports moddecls))))) + (when regexp + (setq sig-list (verilog-signals-matching-regexp + sig-list regexp))) + (setq sig-list (verilog-signals-not-matching-regexp + sig-list verilog-auto-output-ignore-regexp)) (verilog-forward-or-insert-line) (when v2k (verilog-repair-open-comma)) (when sig-list @@ -11809,6 +11927,9 @@ Limitations: Typedefs must match `verilog-typedef-regexp', which is disabled by default. + Types are added to declarations if an AUTOLOGIC or + `verilog-auto-wire-type' is set to logic. + Signals matching `verilog-auto-input-ignore-regexp' are not included. An example (see `verilog-auto-inst' for what else is going on here): @@ -11889,6 +12010,9 @@ Limitations: Typedefs must match `verilog-typedef-regexp', which is disabled by default. + Types are added to declarations if an AUTOLOGIC or + `verilog-auto-wire-type' is set to logic. + Signals matching `verilog-auto-inout-ignore-regexp' are not included. An example (see `verilog-auto-inst' for what else is going on here): @@ -12005,13 +12129,14 @@ same expansion will result from only extracting signals starting with i: /*AUTOINOUTMODULE(\"ExampMain\",\"^i\")*/ -You may also provide an optional second regular expression, in -which case only signals which have that pin direction and data -type will be included. This matches against everything before -the signal name in the declaration, for example against -\"input\" (single bit), \"output logic\" (direction and type) or -\"output [1:0]\" (direction and implicit type). You also -probably want to skip spaces in your regexp. +You may also provide an optional third argument regular +expression, in which case only signals which have that pin +direction and data type matching that regular expression will be +included. This matches against everything before the signal name +in the declaration, for example against \"input\" (single bit), +\"output logic\" (direction and type) or \"output +[1:0]\" (direction and implicit type). You also probably want to +skip spaces in your regexp. For example, the below will result in matching the output \"o\" against the previous example's module: @@ -12071,7 +12196,7 @@ against the previous example's module: (verilog-signals-matching-regexp sig-list-if regexp) "interface" direction-re)) (when v2k (verilog-repair-open-comma)) - (when (or sig-list-i sig-list-o sig-list-io) + (when (or sig-list-i sig-list-o sig-list-io sig-list-if) (verilog-insert-indent "// Beginning of automatic in/out/inouts (from specific module)\n") ;; Don't sort them so an upper AUTOINST will match the main module (verilog-insert-definition modi sig-list-o "output" indent-pt v2k t) @@ -12130,7 +12255,21 @@ You may also provide an optional regular expression, in which case only signals matching the regular expression will be included. For example the same expansion will result from only extracting signals starting with i: - /*AUTOINOUTCOMP(\"ExampMain\",\"^i\")*/" + /*AUTOINOUTCOMP(\"ExampMain\",\"^i\")*/ + +You may also provide an optional third argument regular +expression, in which case only signals which have that pin +direction and data type matching that regular expression will be +included. This matches against everything before the signal name +in the declaration, for example against \"input\" (single bit), +\"output logic\" (direction and type) or \"output +[1:0]\" (direction and implicit type). You also probably want to +skip spaces in your regexp. + +For example, the below will result in matching the output \"o\" +against the previous example's module: + + /*AUTOINOUTCOMP(\"ExampMain\",\"\",\"^output.*\")*/" (verilog-auto-inout-module t nil)) (defun verilog-auto-inout-in () @@ -12181,7 +12320,7 @@ You may also provide an optional regular expression, in which case only signals matching the regular expression will be included. For example the same expansion will result from only extracting signals starting with i: - /*AUTOINOUTCOMP(\"ExampMain\",\"^i\")*/" + /*AUTOINOUTIN(\"ExampMain\",\"^i\")*/" (verilog-auto-inout-module nil t)) (defun verilog-auto-inout-param () @@ -12374,9 +12513,13 @@ driver/monitor using AUTOINST in the testbench." (defun verilog-auto-insert-lisp () "Expand AUTOINSERTLISP statements, as part of \\[verilog-auto]. -The Lisp code provided is called, and the Lisp code calls -`insert` to insert text into the current file beginning on the -line after the AUTOINSERTLISP. +The Lisp code provided is called before other AUTOS are expanded, +and the Lisp code generally will call `insert` to insert text +into the current file beginning on the line after the +AUTOINSERTLISP. + +See also AUTOINSERTLAST and `verilog-auto-insert-last' which +executes after (as opposed to before) other AUTOs. See also AUTO_LISP, which takes a Lisp expression and evaluates it during `verilog-auto-inst' but does not insert any text. @@ -12433,9 +12576,25 @@ text: (setq verilog-scan-cache-tick nil) ;; Clear cache; inserted unknown text (verilog-delete-empty-auto-pair)))) +(defun verilog-auto-insert-last () + "Expand AUTOINSERTLAST statements, as part of \\[verilog-auto]. +The Lisp code provided is called after all other AUTOS have been +expanded, and the Lisp code generally will call `insert` to +insert text into the current file beginning on the line after the +AUTOINSERTLAST. + +Other than when called (after AUTOs are expanded), the functionality +is otherwise identical to AUTOINSERTLISP and `verilog-auto-insert-lisp' which +executes before (as opposed to after) other AUTOs. + +See `verilog-auto-insert-lisp' for examples." + (verilog-auto-insert-lisp)) + (defun verilog-auto-sense-sigs (moddecls presense-sigs) "Return list of signals for current AUTOSENSE block." - (let* ((sigss (verilog-read-always-signals)) + (let* ((sigss (save-excursion + (search-forward ")") + (verilog-read-always-signals))) (sig-list (verilog-signals-not-params (verilog-signals-not-in (verilog-alw-get-inputs sigss) (append (and (not verilog-auto-sense-include-inputs) @@ -12625,11 +12784,12 @@ Typing \\[verilog-auto] will make this into: (save-excursion (verilog-read-signals (save-excursion - (verilog-re-search-backward-quick "\\(@\\|\\<begin\\>\\|\\<if\\>\\|\\<case\\>\\)" nil t) + (verilog-re-search-backward-quick + "\\(@\\|\\<\\(begin\\|if\\|case\\|always\\(_latch\\|_ff\\|_comb\\)?\\)\\>\\)" nil t) (point)) (point))))) (save-excursion - (verilog-re-search-backward-quick "@" nil t) + (verilog-re-search-backward-quick "\\(@\\|\\<\\(always\\(_latch\\|_ff\\|_comb\\)?\\)\\>\\)" nil t) (setq sigss (verilog-read-always-signals))) (setq dly-list (verilog-alw-get-outputs-delayed sigss)) (setq sig-list (verilog-signals-not-in (append @@ -13159,6 +13319,7 @@ Using \\[describe-function], see also: `verilog-auto-inout-param' for AUTOINOUTPARAM copying params from elsewhere `verilog-auto-input' for AUTOINPUT making hierarchy inputs `verilog-auto-insert-lisp' for AUTOINSERTLISP insert code from lisp function + `verilog-auto-insert-last' for AUTOINSERTLAST insert code from lisp function `verilog-auto-inst' for AUTOINST instantiation pins `verilog-auto-star' for AUTOINST .* SystemVerilog pins `verilog-auto-inst-param' for AUTOINSTPARAM instantiation params @@ -13235,7 +13396,6 @@ Wilson Snyder (wsnyder@wsnyder.org)." (verilog-inject-arg)) ;; ;; Do user inserts first, so their code can insert AUTOs - ;; We may provide an AUTOINSERTLISPLAST if another cleanup pass is needed (verilog-auto-re-search-do "/\\*AUTOINSERTLISP(.*?)\\*/" 'verilog-auto-insert-lisp) ;; Expand instances before need the signals the instances input/output @@ -13269,11 +13429,13 @@ Wilson Snyder (wsnyder@wsnyder.org)." (verilog-auto-re-search-do "/\\*AUTOREG\\*/" 'verilog-auto-reg) (verilog-auto-re-search-do "/\\*AUTOREGINPUT\\*/" 'verilog-auto-reg-input) ;; outputevery needs AUTOOUTPUTs done first - (verilog-auto-re-search-do "/\\*AUTOOUTPUTEVERY\\*/" 'verilog-auto-output-every) + (verilog-auto-re-search-do "/\\*AUTOOUTPUTEVERY\\((.*?)\\)?\\*/" 'verilog-auto-output-every) ;; After we've created all new variables (verilog-auto-re-search-do "/\\*AUTOUNUSED\\*/" 'verilog-auto-unused) ;; Must be after all inputs outputs are generated (verilog-auto-re-search-do "/\\*AUTOARG\\*/" 'verilog-auto-arg) + ;; User inserts + (verilog-auto-re-search-do "/\\*AUTOINSERTLAST(.*?)\\*/" 'verilog-auto-insert-last) ;; Fix line numbers (comments only) (when verilog-auto-inst-template-numbers (verilog-auto-templated-rel)) @@ -13442,7 +13604,7 @@ See also `verilog-header' for an alternative format." > "`ovm_object_utils_begin(" name ")" \n > (- verilog-indent-level) " `ovm_object_utils_end" \n > _ \n - > "function new(name=\"" name "\");" \n + > "function new(string name=\"" name "\");" \n > "super.new(name);" \n > (- verilog-indent-level) "endfunction" \n > _ \n @@ -13456,7 +13618,7 @@ See also `verilog-header' for an alternative format." > "`uvm_object_utils_begin(" name ")" \n > (- verilog-indent-level) "`uvm_object_utils_end" \n > _ \n - > "function new(name=\"" name "\");" \n + > "function new(string name=\"" name "\");" \n > "super.new(name);" \n > (- verilog-indent-level) "endfunction" \n > _ \n @@ -13470,7 +13632,7 @@ See also `verilog-header' for an alternative format." > "`uvm_component_utils_begin(" name ")" \n > (- verilog-indent-level) "`uvm_component_utils_end" \n > _ \n - > "function new(name=\"\", uvm_component parent);" \n + > "function new(string name=\"\", uvm_component parent);" \n > "super.new(name, parent);" \n > (- verilog-indent-level) "endfunction" \n > _ \n @@ -13538,8 +13700,7 @@ for sensitivity list." () > "begin" '(verilog-sk-prompt-name) \n > _ \n - > (- verilog-indent-level-behavioral) "end" -) + > (- verilog-indent-level-behavioral) "end" ) (define-skeleton verilog-sk-fork "Insert a fork join block." diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 4dccec83d03..875de3b865c 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -13,10 +13,10 @@ ;; filed in the Emacs bug reporting system against this file, a copy ;; of the bug report be sent to the maintainer's email address. -(defconst vhdl-version "3.34.2" +(defconst vhdl-version "3.36.1" "VHDL Mode version number.") -(defconst vhdl-time-stamp "2012-11-21" +(defconst vhdl-time-stamp "2014-11-27" "VHDL Mode time stamp for last update.") ;; This file is part of GNU Emacs. @@ -72,12 +72,12 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Emacs Versions -;; this updated version was only tested on: GNU Emacs 20.4 +;; this updated version was only tested on: GNU Emacs 24.1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Installation -;; Prerequisites: GNU Emacs 20.X/21.X/22.X/23.X, XEmacs 20.X/21.X. +;; Prerequisites: GNU Emacs 20/21/22/23/24, XEmacs 20/21. ;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation ;; or into an arbitrary directory that is added to the load path by the @@ -215,20 +215,20 @@ Overrides local variable `indent-tabs-mode'." ;; [Error] Assignment error: variable is illegal target of signal assignment ("ADVance MS" "vacom" "-work \\1" "make" "-f \\1" nil "valib \\1; vamap \\2 \\1" "./" "work/" "Makefile" "adms" - ("^\\s-+\\([0-9]+\\):\\s-+" nil 1 nil) ("Compiling file \\(.+\\)" 1) + ("^\\s-+\\([0-9]+\\):\\s-+" nil 1 nil) ("^Compiling file \\(.+\\)" 1) ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif" "PACK/\\1.vif" "BODY/\\1.vif" upcase)) ;; Aldec ;; COMP96 ERROR COMP96_0018: "Identifier expected." "test.vhd" 66 3 ("Aldec" "vcom" "-work \\1" "make" "-f \\1" nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "aldec" - (".* ERROR [^:]+: \".*\" \"\\([^ \\t\\n]+\\)\" \\([0-9]+\\) \\([0-9]+\\)" 1 2 3) ("" 0) + ("^.* ERROR [^:]+: \".*\" \"\\([^ \t\n]+\\)\" \\([0-9]+\\) \\([0-9]+\\)" 1 2 3) ("" 0) nil) ;; Cadence Leapfrog: cv -file test.vhd ;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared ("Cadence Leapfrog" "cv" "-work \\1 -file" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "leapfrog" - ("duluth: \\*E,[0-9]+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)):" 1 2 nil) ("" 0) + ("^duluth: \\*E,[0-9]+ (\\([^ \t\n]+\\),\\([0-9]+\\)):" 1 2 nil) ("" 0) ("\\1/entity" "\\2/\\1" "\\1/configuration" "\\1/package" "\\1/body" downcase)) ;; Cadence Affirma NC vhdl: ncvhdl test.vhd @@ -236,27 +236,29 @@ Overrides local variable `indent-tabs-mode'." ;; (PLL_400X_TOP) is not declared [10.3]. ("Cadence NC" "ncvhdl" "-work \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "ncvhdl" - ("ncvhdl_p: \\*E,\\w+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0) + ("^ncvhdl_p: \\*E,\\w+ (\\([^ \t\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0) ("\\1/entity/pc.db" "\\2/\\1/pc.db" "\\1/configuration/pc.db" "\\1/package/pc.db" "\\1/body/pc.db" downcase)) - ;; ghdl vhdl: ghdl test.vhd + ;; ghdl vhdl + ;; ghdl -a bad_counter.vhdl + ;; bad_counter.vhdl:13:14: operator "=" is overloaded ("GHDL" "ghdl" "-i --workdir=\\1 --ieee=synopsys -fexplicit " "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "ghdl" - ("ghdl_p: \\*E,\\w+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0) + ("^ghdl_p: \\*E,\\w+ (\\([^ \t\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0) ("\\1/entity" "\\2/\\1" "\\1/configuration" "\\1/package" "\\1/body" downcase)) ;; IBM Compiler ;; 00 COACHDL* | [CCHDL-1]: File: adder.vhd, line.column: 120.6 ("IBM Compiler" "g2tvc" "-src" "precomp" "\\1" nil "mkdir \\1" "./" "work/" "Makefile" "ibm" - ("[0-9]+ COACHDL.*: File: \\([^ \\t\\n]+\\), line.column: \\([0-9]+\\).\\([0-9]+\\)" 1 2 3) (" " 0) + ("^[0-9]+ COACHDL.*: File: \\([^ \t\n]+\\), *line.column: \\([0-9]+\\).\\([0-9]+\\)" 1 2 3) (" " 0) nil) ;; Ikos Voyager: analyze test.vhd ;; analyze test.vhd ;; E L4/C5: this library unit is inaccessible ("Ikos" "analyze" "-l \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "ikos" - ("E L\\([0-9]+\\)/C\\([0-9]+\\):" nil 1 2) + ("^E L\\([0-9]+\\)/C\\([0-9]+\\):" nil 1 2) ("^analyze +\\(.+ +\\)*\\(.+\\)$" 2) nil) ;; ModelSim, Model Technology: vcom test.vhd @@ -266,14 +268,14 @@ Overrides local variable `indent-tabs-mode'." ;; ** Error: adder.vhd(190): Unknown identifier: ctl_numb ("ModelSim" "vcom" "-93 -work \\1" "make" "-f \\1" nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "modelsim" - ("\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*:\\( *\[[0-9]+\]\\)? \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 3 4 nil) ("" 0) + ("^\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*:\\( *\[[0-9]+\]\\)? \\([^ \t\n]+\\)(\\([0-9]+\\)):" 3 4 nil) ("" 0) ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat" "\\1/_primary.dat" "\\1/body.dat" downcase)) ;; ProVHDL, Synopsys LEDA: provhdl -w work -f test.vhd ;; test.vhd:34: error message ("LEDA ProVHDL" "provhdl" "-w \\1 -f" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "provhdl" - ("\\([^ \\t\\n]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0) + ("^\\([^ \t\n:]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0) ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif" "PACK/\\1.vif" "BODY/BODY-\\1.vif" upcase)) ;; Quartus compiler @@ -284,21 +286,21 @@ Overrides local variable `indent-tabs-mode'." ;; Warning: VHDL Process Statement warning at dvi2sdi_tst.vhd(172): ... ("Quartus" "make" "-work \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "quartus" - ("\\(Error\\|Warning\\): .* \\([^ \\t\\n]+\\)(\\([0-9]+\\))" 2 3 nil) ("" 0) + ("^\\(Error\\|Warning\\): .* \\([^ \t\n]+\\)(\\([0-9]+\\))" 2 3 nil) ("" 0) nil) ;; QuickHDL, Mentor Graphics: qvhcom test.vhd ;; ERROR: test.vhd(24): near "dnd": expecting: END ;; WARNING[4]: test.vhd(30): A space is required between ... ("QuickHDL" "qvhcom" "-work \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "quickhdl" - ("\\(ERROR\\|WARNING\\)[^:]*: \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 2 3 nil) ("" 0) + ("^\\(ERROR\\|WARNING\\)[^:]*: \\([^ \t\n]+\\)(\\([0-9]+\\)):" 2 3 nil) ("" 0) ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat" "\\1/_primary.dat" "\\1/body.dat" downcase)) ;; Savant: scram -publish-cc test.vhd ;; test.vhd:87: _set_passed_through_out_port(IIR_Boolean) not defined for ("Savant" "scram" "-publish-cc -design-library-name \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work._savant_lib/" "Makefile" "savant" - ("\\([^ \\t\\n]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0) + ("^\\([^ \t\n:]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0) ("\\1_entity.vhdl" "\\2_secondary_units._savant_lib/\\2_\\1.vhdl" "\\1_config.vhdl" "\\1_package.vhdl" "\\1_secondary_units._savant_lib/\\1_package_body.vhdl" downcase)) @@ -306,39 +308,39 @@ Overrides local variable `indent-tabs-mode'." ;; Error: CSVHDL0002: test.vhd: (line 97): Invalid prefix ("Simili" "vhdlp" "-work \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "simili" - ("\\(Error\\|Warning\\): \\w+: \\([^ \\t\\n]+\\): (line \\([0-9]+\\)): " 2 3 nil) ("" 0) + ("^\\(Error\\|Warning\\): \\w+: \\([^ \t\n]+\\): (line \\([0-9]+\\)): " 2 3 nil) ("" 0) ("\\1/prim.var" "\\2/_\\1.var" "\\1/prim.var" "\\1/prim.var" "\\1/_body.var" downcase)) ;; Speedwave (Innoveda): analyze -libfile vsslib.ini -src test.vhd ;; ERROR[11]::File test.vhd Line 100: Use of undeclared identifier ("Speedwave" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "speedwave" - ("^ *ERROR\[[0-9]+\]::File \\([^ \\t\\n]+\\) Line \\([0-9]+\\):" 1 2 nil) ("" 0) + ("^ *ERROR\[[0-9]+\]::File \\([^ \t\n]+\\) Line \\([0-9]+\\):" 1 2 nil) ("" 0) nil) ;; Synopsys, VHDL Analyzer (sim): vhdlan -nc test.vhd ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context. ("Synopsys" "vhdlan" "-nc -work \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "synopsys" - ("\\*\\*Error: vhdlan,[0-9]+ \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0) + ("^\\*\\*Error: vhdlan,[0-9]+ \\([^ \t\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0) ("\\1.sim" "\\2__\\1.sim" "\\1.sim" "\\1.sim" "\\1__.sim" upcase)) ;; Synopsys, VHDL Analyzer (syn): vhdlan -nc -spc test.vhd ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context. ("Synopsys Design Compiler" "vhdlan" "-nc -spc -work \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "synopsys_dc" - ("\\*\\*Error: vhdlan,[0-9]+ \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0) + ("^\\*\\*Error: vhdlan,[0-9]+ \\([^ \t\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0) ("\\1.syn" "\\2__\\1.syn" "\\1.syn" "\\1.syn" "\\1__.syn" upcase)) ;; Synplify: ;; @W:"test.vhd":57:8:57:9|Optimizing register bit count_x(5) to a constant 0 ("Synplify" "n/a" "n/a" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "synplify" - ("@[EWN]:\"\\([^ \\t\\n]+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3) ("" 0) + ("^@[EWN]:\"\\([^ \t\n]+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3) ("" 0) nil) ;; Vantage: analyze -libfile vsslib.ini -src test.vhd ;; Compiling "test.vhd" line 1... ;; **Error: LINE 49 *** No aggregate value is valid in this context. ("Vantage" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "vantage" - ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil) + ("^\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil) ("^ *Compiling \"\\(.+\\)\" " 1) nil) ;; VeriBest: vc vhdl test.vhd @@ -355,14 +357,14 @@ Overrides local variable `indent-tabs-mode'." ;; **Error: LINE 49 *** No aggregate value is valid in this context. ("Viewlogic" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "viewlogic" - ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil) + ("^\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil) ("^ *Compiling \"\\(.+\\)\" " 1) nil) ;; Xilinx XST: ;; ERROR:HDLParsers:164 - "test.vhd" Line 3. parse error ("Xilinx XST" "xflow" "" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "xilinx" - ("^ERROR:HDLParsers:[0-9]+ - \"\\([^ \\t\\n]+\\)\" Line \\([0-9]+\\)\." 1 2 nil) ("" 0) + ("^ERROR:HDLParsers:[0-9]+ - \"\\([^ \t\n]+\\)\" Line \\([0-9]+\\)\." 1 2 nil) ("" 0) nil) ) "List of available VHDL compilers and their properties. @@ -392,7 +394,8 @@ File message: Unit-to-file name mapping: mapping of library unit names to names of files generated by the compiler (used for Makefile generation) To string : string a name is mapped to (\"\\1\" inserts the unit name, - \"\\2\" inserts the entity name for architectures) + \"\\2\" inserts the entity name for architectures, + \"\\3\" inserts the library name) Case adjustment : adjust case of inserted unit names \(*) The regular expression must match the error message starting from the @@ -486,7 +489,7 @@ Select a compiler name from the ones defined in option `vhdl-compiler-alist'." (append '(choice) (nreverse list))) :group 'vhdl-compile) -(defcustom vhdl-compile-use-local-error-regexp t +(defcustom vhdl-compile-use-local-error-regexp nil "Non-nil means use buffer-local `compilation-error-regexp-alist'. In this case, only error message regexps for VHDL compilers are active if compilation is started from a VHDL buffer. Otherwise, the error message @@ -495,6 +498,7 @@ active all the time. Note that by doing that, the predefined global regexps might result in erroneous parsing of error messages for some VHDL compilers. NOTE: Activate the new setting by restarting Emacs." + :version "25.1" ; t -> nil :type 'boolean :group 'vhdl-compile) @@ -1069,7 +1073,7 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry "Customizations for sequential processes." :group 'vhdl-template) -(defcustom vhdl-reset-kind 'async +(defcustom vhdl-reset-kind 'async "Specifies which kind of reset to use in sequential processes." :type '(choice (const :tag "None" none) (const :tag "Synchronous" sync) @@ -2125,7 +2129,6 @@ your style, only those that are different from the default.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; mandatory -(require 'assoc) (require 'compile) ; XEmacs (require 'easymenu) (require 'hippie-exp) @@ -2137,6 +2140,36 @@ your style, only those that are different from the default.") (require 'ps-print) (require 'speedbar))) ; for speedbar-with-writable +(defun vhdl-aput (alist-symbol key &optional value) + "Insert a key-value pair into an alist. +The alist is referenced by ALIST-SYMBOL. The key-value pair is made +from KEY and VALUE. If the key-value pair referenced by KEY can be +found in the alist, the value of KEY will be set to VALUE. If the +key-value pair cannot be found in the alist, it will be inserted into +the head of the alist." + (let* ((alist (symbol-value alist-symbol)) + (elem (assoc key alist))) + (if elem + (setcdr elem value) + (set alist-symbol (cons (cons key value) alist))))) + +(defun vhdl-adelete (alist-symbol key) + "Delete a key-value pair from the alist. +Alist is referenced by ALIST-SYMBOL and the key-value pair to remove +is pair matching KEY." + (let ((alist (symbol-value alist-symbol)) alist-cdr) + (while (equal key (caar alist)) + (setq alist (cdr alist)) + (set alist-symbol alist)) + (while (setq alist-cdr (cdr alist)) + (if (equal key (caar alist-cdr)) + (setcdr alist (cdr alist-cdr)) + (setq alist alist-cdr))))) + +(defun vhdl-aget (alist key) + "Return the value in ALIST that is associated with KEY. If KEY is +not found, then nil is returned." + (cdr (assoc key alist))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Compatibility @@ -2256,7 +2289,6 @@ Ignore byte-compiler warnings you might see." "Wait until idle, then run FUNCTION." (if (fboundp 'start-itimer) (start-itimer "vhdl-mode" function secs repeat t) -; (run-with-idle-timer secs repeat function))) ;; explicitly activate timer (necessary when Emacs is already idle) (aset (run-with-idle-timer secs repeat function) 0 nil))) @@ -2429,7 +2461,7 @@ specified." current buffer if no project is defined." (if (vhdl-project-p) (expand-file-name (vhdl-resolve-env-variable - (nth 1 (aget vhdl-project-alist vhdl-project)))) + (nth 1 (vhdl-aget vhdl-project-alist vhdl-project)))) default-directory)) (defmacro vhdl-prepare-search-1 (&rest body) @@ -2537,11 +2569,11 @@ conversion." (setq file-list (cdr file-list))) dir-list)) -(defun vhdl-aput (alist-symbol key &optional value) +(defun vhdl-aput-delete-if-nil (alist-symbol key &optional value) "As `aput', but delete key-value pair if VALUE is nil." (if value - (aput alist-symbol key value) - (adelete alist-symbol key))) + (vhdl-aput alist-symbol key value) + (vhdl-adelete alist-symbol key))) (defun vhdl-delete (elt list) "Delete by side effect the first occurrence of ELT as a member of LIST." @@ -2596,11 +2628,6 @@ conversion." (set-buffer (marker-buffer marker))) (goto-char marker)) -(defun vhdl-goto-line (line) - "Use this instead of calling user level function `goto-line'." - (goto-char (point-min)) - (forward-line (1- line))) - (defun vhdl-menu-split (list title) "Split menu LIST into several submenus, if number of elements > `vhdl-menu-max-size'." @@ -2975,7 +3002,7 @@ STRING are replaced by `-' and substrings are converted to lower case." (make-variable-buffer-local 'vhdl-syntactic-context) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Abbrev ook bindings +;; Abbrev hook bindings (defvar vhdl-mode-abbrev-table nil "Abbrev table to use in `vhdl-mode' buffers.") @@ -2985,8 +3012,10 @@ STRING are replaced by `-' and substrings are converted to lower case." (define-abbrev-table 'vhdl-mode-abbrev-table (append (when (memq 'vhdl vhdl-electric-keywords) - ;; VHDL'93 keywords - (mapcar (lambda (x) (list (car x) "" (cdr x) 0 'system)) + ;; VHDL'02 keywords + (mapcar (if (featurep 'xemacs) + (lambda (x) (list (car x) "" (cdr x) 0)) + (lambda (x) (list (car x) "" (cdr x) 0 'system))) '( ("--" . vhdl-template-display-comment-hook) ("abs" . vhdl-template-default-hook) @@ -3102,7 +3131,9 @@ STRING are replaced by `-' and substrings are converted to lower case." ))) ;; VHDL-AMS keywords (when (and (memq 'vhdl vhdl-electric-keywords) (vhdl-standard-p 'ams)) - (mapcar (lambda (x) (list (car x) "" (cdr x) 0 'system)) + (mapcar (if (featurep 'xemacs) + (lambda (x) (list (car x) "" (cdr x) 0)) + (lambda (x) (list (car x) "" (cdr x) 0 'system))) '( ("across" . vhdl-template-default-hook) ("break" . vhdl-template-break-hook) @@ -4822,7 +4853,7 @@ Key bindings: ;; set local variables (set (make-local-variable 'paragraph-start) - "\\s-*\\(--+\\s-*$\\|[^ -]\\|$\\)") + "\\s-*\\(--+\\s-*$\\|$\\)") (set (make-local-variable 'paragraph-separate) paragraph-start) (set (make-local-variable 'paragraph-ignore-fill-prefix) t) (set (make-local-variable 'parse-sexp-ignore-comments) t) @@ -4860,9 +4891,7 @@ Key bindings: (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode) (set (make-local-variable 'lazy-lock-defer-contextually) nil) (set (make-local-variable 'lazy-lock-defer-on-the-fly) t) -; (set (make-local-variable 'lazy-lock-defer-time) 0.1) (set (make-local-variable 'lazy-lock-defer-on-scrolling) t)) -; (turn-on-font-lock) ;; variables for source file compilation (when vhdl-compile-use-local-error-regexp @@ -7566,7 +7595,6 @@ indentation is done before aligning." (setq end (point-marker)) (goto-char begin) (setq bol (setq begin (progn (beginning-of-line) (point)))) -; (untabify bol end) (when indent (indent-region bol end nil)))) (let ((copy (copy-alist alignment-list))) @@ -7962,7 +7990,6 @@ end of line, do nothing in comments and strings." (and (looking-at "\\s-+") (re-search-forward "\\s-+" end t) (progn (replace-match " " nil nil) t)) (and (looking-at "-") (re-search-forward "-" end t)) -; (re-search-forward "[^ \t-]+" end t)))) (re-search-forward "[^ \t\"-]+" end t)))) (unless no-message (message "Fixing up whitespace...done"))) @@ -8080,7 +8107,7 @@ Currently supported keywords: 'begin', 'if'." (while (re-search-forward "\\<\\(for\\|if\\)\\>" end t) (goto-char (match-end 1)) (setq point (point-marker)) - ;; exception: in literal or preceded by `end' or label + ;; exception: in literal or preceded by `end', `wait' or label (when (and (not (save-excursion (goto-char (match-beginning 1)) (vhdl-in-literal))) (save-excursion @@ -8089,7 +8116,7 @@ Currently supported keywords: 'begin', 'if'." (and (re-search-forward "^\\s-*\\([^ \t\n].*\\)" (match-beginning 1) t) (not (string-match - "\\(\\<end\\>\\|\\<wait\\>\\|\\w+\\s-*:\\)\\s-*$" + "\\(\\<end\\>\\|\\<wait .*\\|\\w+\\s-*:\\)\\s-*$" (match-string 1))))))) (goto-char (match-beginning 1)) (insert "\n") @@ -8138,10 +8165,12 @@ case fixing to a region. Calls functions `vhdl-indent-buffer', (when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t)) (when (nth 1 vhdl-beautify-options) (vhdl-fix-statement-region beg end)) (when (nth 2 vhdl-beautify-options) (vhdl-indent-region beg end)) - (let ((vhdl-align-groups t)) - (when (nth 3 vhdl-beautify-options) (vhdl-align-region beg end))) + (when (nth 3 vhdl-beautify-options) + (let ((vhdl-align-groups t)) (vhdl-align-region beg end))) (when (nth 4 vhdl-beautify-options) (vhdl-fix-case-region beg end)) - (when (nth 0 vhdl-beautify-options) (vhdl-remove-trailing-spaces-region beg end))) + (when (nth 0 vhdl-beautify-options) + (vhdl-remove-trailing-spaces-region beg end) + (if vhdl-indent-tabs-mode (tabify beg end) (untabify beg end)))) (defun vhdl-beautify-buffer () "Beautify buffer by applying indentation, whitespace fixup, alignment, and @@ -8447,11 +8476,11 @@ buffer." (setq beg (point)))))) ;; search for signals declared in surrounding block declarative parts (save-excursion - (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*block\\|\\(end\\)\\s-+block\\)\\>" nil t)) - (match-string 2)) - (goto-char (match-end 2)) + (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*\\(block\\|\\(for\\|if\\).*\\<generate\\>\\)\\|\\(end\\)\\s-+block\\)\\>" nil t)) + (match-string 4)) + (goto-char (match-end 4)) (vhdl-backward-sexp) - (re-search-backward "^\\s-*\\w+\\s-*:\\s-*block\\>" nil t)) + (re-search-backward "^\\s-*\\w+\\s-*:\\s-*\\(block\\|generate\\)\\>" nil t)) beg) (setq end (re-search-forward "^\\s-*begin\\>" nil t))) ;; scan for all declared signal names @@ -8548,7 +8577,8 @@ Used for undoing after template abortion.") "Return the working library name of the current project or \"work\" if no project is defined." (vhdl-resolve-env-variable - (or (nth 6 (aget vhdl-project-alist vhdl-project)) vhdl-default-library))) + (or (nth 6 (vhdl-aget vhdl-project-alist vhdl-project)) + vhdl-default-library))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Enabling/disabling @@ -8966,8 +8996,6 @@ since these are almost equivalent)." (interactive) (when (vhdl-template-field "target signal") (insert " <= ") -; (if (not (equal (vhdl-template-field "[GUARDED] [TRANSPORT]") "")) -; (insert " ")) (let ((margin (current-column)) (start (point)) position) @@ -9903,7 +9931,7 @@ otherwise." (defun vhdl-template-record (kind &optional name secondary) "Insert a record type declaration." (interactive) - (let ((margin (current-column)) + (let ((margin (current-indentation)) (start (point)) (first t)) (vhdl-insert-keyword "RECORD\n") @@ -9965,7 +9993,6 @@ otherwise." (insert "\n") (indent-to (+ margin vhdl-basic-offset)) (vhdl-template-field "target signal" " <= ") -; (vhdl-template-field "[GUARDED] [TRANSPORT]") (insert "\n") (indent-to (+ margin vhdl-basic-offset)) (vhdl-template-field "waveform") @@ -10466,8 +10493,10 @@ specification, if not already there." (defun vhdl-template-replace-header-keywords (beg end &optional file-title is-model) "Replace keywords in header and footer." - (let ((project-title (or (nth 0 (aget vhdl-project-alist vhdl-project)) "")) - (project-desc (or (nth 9 (aget vhdl-project-alist vhdl-project)) "")) + (let ((project-title (or (nth 0 (vhdl-aget vhdl-project-alist vhdl-project)) + "")) + (project-desc (or (nth 9 (vhdl-aget vhdl-project-alist vhdl-project)) + "")) pos) (vhdl-prepare-search-2 (save-excursion @@ -10525,9 +10554,9 @@ specification, if not already there." (replace-match file-title t t)) (goto-char beg)) (let (string) - (while - (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t) - (setq string (read-string (concat (match-string 1) ": "))) + (while (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t) + (save-match-data + (setq string (read-string (concat (match-string 1) ": ")))) (replace-match string t t))) (goto-char beg) (when (and (not is-model) (search-forward "<cursor>" end t)) @@ -10635,14 +10664,7 @@ If starting after end-comment-column, start a new line." (if (not (or (and string (progn (insert string) t)) (vhdl-template-field "[comment]" nil t))) (delete-region position (point)) - (while (= (preceding-char) ?\ ) (delete-char -1)) - ;; (when (> (current-column) end-comment-column) - ;; (setq position (point-marker)) - ;; (re-search-backward "-- ") - ;; (insert "\n") - ;; (indent-to comment-column) - ;; (goto-char position)) - )))) + (while (= (preceding-char) ?\ ) (delete-char -1)))))) (defun vhdl-comment-block () "Insert comment for code block." @@ -10882,8 +10904,6 @@ Point is left between them." (defun vhdl-template-generate-body (margin label) "Insert body for generate template." (vhdl-insert-keyword " GENERATE") -; (if (not (vhdl-standard-p '87)) -; (vhdl-template-begin-end "GENERATE" label margin) (insert "\n\n") (indent-to margin) (vhdl-insert-keyword "END GENERATE ") @@ -11670,7 +11690,6 @@ reflected in a subsequent paste operation." comment group-comment)))) ;; parse group comment and spacing (setq group-comment (vhdl-parse-group-comment)))) -; (vhdl-parse-string "end\\>") ;; parse context clause (setq context-clause (vhdl-scan-context-clause)) ; ;; add surrounding package to context clause @@ -12622,7 +12641,6 @@ reflected in a subsequent paste operation." (while (and he-expand-list (or (not (stringp (car he-expand-list))) (he-string-member (car he-expand-list) he-tried-table t))) -; (equal (car he-expand-list) he-search-string))) (unless (stringp (car he-expand-list)) (setq vhdl-expand-upper-case (car he-expand-list))) (setq he-expand-list (cdr he-expand-list))) @@ -12908,8 +12926,8 @@ File statistics: \"%s\"\n\ ";; project name\n" "(setq vhdl-project \"" vhdl-project "\")\n\n" ";; project setup\n" - "(aput 'vhdl-project-alist vhdl-project\n'") - (pp (aget vhdl-project-alist vhdl-project) (current-buffer)) + "(vhdl-aput 'vhdl-project-alist vhdl-project\n'") + (pp (vhdl-aget vhdl-project-alist vhdl-project) (current-buffer)) (insert ")\n") (save-buffer) (kill-buffer (current-buffer)) @@ -12929,16 +12947,18 @@ File statistics: \"%s\"\n\ (condition-case () (let ((current-project vhdl-project)) (load-file file-name) - (when (/= (length (aget vhdl-project-alist vhdl-project t)) 10) - (adelete 'vhdl-project-alist vhdl-project) + (when (/= (length (vhdl-aget vhdl-project-alist vhdl-project)) 10) + (vhdl-adelete 'vhdl-project-alist vhdl-project) (error "")) - (when not-make-current - (setq vhdl-project current-project)) + (if not-make-current + (setq vhdl-project current-project) + (setq vhdl-compiler + (caar (nth 4 (vhdl-aget vhdl-project-alist vhdl-project))))) (vhdl-update-mode-menu) (vhdl-speedbar-refresh) (unless not-make-current - (message "Current VHDL project: \"%s\"%s" - vhdl-project (if auto " (auto-loaded)" "")))) + (message "Current VHDL project: \"%s\"; compiler: \"%s\"%s" + vhdl-project vhdl-compiler (if auto " (auto-loaded)" "")))) (error (vhdl-warning (format "ERROR: Invalid project setup file: \"%s\"" file-name)))))) @@ -12946,7 +12966,7 @@ File statistics: \"%s\"\n\ "Duplicate setup of current project." (interactive) (let ((new-name (read-from-minibuffer "New project name: ")) - (project-entry (aget vhdl-project-alist vhdl-project t))) + (project-entry (vhdl-aget vhdl-project-alist vhdl-project))) (setq vhdl-project-alist (append vhdl-project-alist (list (cons new-name project-entry)))) @@ -13275,7 +13295,6 @@ This does highlighting of keywords and standard identifiers.") (skip-syntax-backward " ") (skip-syntax-backward "w_") (skip-syntax-backward " "))) -; (skip-chars-backward "^-(\n\";") (goto-char (match-end 1)) (1 font-lock-variable-name-face))) ;; highlight formal parameters in component instantiations and subprogram @@ -13676,8 +13695,6 @@ hierarchy otherwise.") non-final) "Scan contents of VHDL files in directory or file pattern NAME." (string-match "\\(.*[/\\]\\)\\(.*\\)" name) -; (unless (file-directory-p (match-string 1 name)) -; (message "No such directory: \"%s\"" (match-string 1 name))) (let* ((dir-name (match-string 1 name)) (file-pattern (match-string 2 name)) (is-directory (= 0 (length file-pattern))) @@ -13690,18 +13707,18 @@ hierarchy otherwise.") dir-name t (wildcard-to-regexp file-pattern))))) (key (or project dir-name)) (file-exclude-regexp - (or (nth 3 (aget vhdl-project-alist project)) "")) + (or (nth 3 (vhdl-aget vhdl-project-alist project)) "")) (limit-design-file-size (nth 0 vhdl-speedbar-scan-limit)) (limit-hier-file-size (nth 0 (nth 1 vhdl-speedbar-scan-limit))) (limit-hier-inst-no (nth 1 (nth 1 vhdl-speedbar-scan-limit))) ent-alist conf-alist pack-alist ent-inst-list file-alist tmp-list tmp-entry no-files files-exist big-files) (when (or project update) - (setq ent-alist (aget vhdl-entity-alist key t) - conf-alist (aget vhdl-config-alist key t) - pack-alist (aget vhdl-package-alist key t) - ent-inst-list (car (aget vhdl-ent-inst-alist key t)) - file-alist (aget vhdl-file-alist key t))) + (setq ent-alist (vhdl-aget vhdl-entity-alist key) + conf-alist (vhdl-aget vhdl-config-alist key) + pack-alist (vhdl-aget vhdl-package-alist key) + ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist key)) + file-alist (vhdl-aget vhdl-file-alist key))) (when (and (not is-directory) (null file-list)) (message "No such file: \"%s\"" name)) (setq files-exist file-list) @@ -13743,7 +13760,7 @@ hierarchy otherwise.") (while (re-search-forward "^[ \t]*entity[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) (let* ((ent-name (match-string-no-properties 1)) (ent-key (downcase ent-name)) - (ent-entry (aget ent-alist ent-key t)) + (ent-entry (vhdl-aget ent-alist ent-key)) (lib-alist (vhdl-scan-context-clause))) (if (nth 1 ent-entry) (vhdl-warning-when-idle @@ -13751,10 +13768,10 @@ hierarchy otherwise.") ent-name (nth 1 ent-entry) (nth 2 ent-entry) file-name (vhdl-current-line)) (push ent-key ent-list) - (aput 'ent-alist ent-key - (list ent-name file-name (vhdl-current-line) - (nth 3 ent-entry) (nth 4 ent-entry) - lib-alist))))) + (vhdl-aput 'ent-alist ent-key + (list ent-name file-name (vhdl-current-line) + (nth 3 ent-entry) (nth 4 ent-entry) + lib-alist))))) ;; scan for architectures (goto-char (point-min)) (while (re-search-forward "^[ \t]*architecture[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) @@ -13762,9 +13779,9 @@ hierarchy otherwise.") (arch-key (downcase arch-name)) (ent-name (match-string-no-properties 2)) (ent-key (downcase ent-name)) - (ent-entry (aget ent-alist ent-key t)) + (ent-entry (vhdl-aget ent-alist ent-key)) (arch-alist (nth 3 ent-entry)) - (arch-entry (aget arch-alist arch-key t)) + (arch-entry (vhdl-aget arch-alist arch-key)) (lib-arch-alist (vhdl-scan-context-clause))) (if arch-entry (vhdl-warning-when-idle @@ -13773,20 +13790,20 @@ hierarchy otherwise.") (nth 2 arch-entry) file-name (vhdl-current-line)) (setq arch-list (cons arch-key arch-list) arch-ent-list (cons ent-key arch-ent-list)) - (aput 'arch-alist arch-key - (list arch-name file-name (vhdl-current-line) nil - lib-arch-alist)) - (aput 'ent-alist ent-key - (list (or (nth 0 ent-entry) ent-name) - (nth 1 ent-entry) (nth 2 ent-entry) - (vhdl-sort-alist arch-alist) - arch-key (nth 5 ent-entry)))))) + (vhdl-aput 'arch-alist arch-key + (list arch-name file-name (vhdl-current-line) + nil lib-arch-alist)) + (vhdl-aput 'ent-alist ent-key + (list (or (nth 0 ent-entry) ent-name) + (nth 1 ent-entry) (nth 2 ent-entry) + (vhdl-sort-alist arch-alist) + arch-key (nth 5 ent-entry)))))) ;; scan for configurations (goto-char (point-min)) (while (re-search-forward "^[ \t]*configuration[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) (let* ((conf-name (match-string-no-properties 1)) (conf-key (downcase conf-name)) - (conf-entry (aget conf-alist conf-key t)) + (conf-entry (vhdl-aget conf-alist conf-key)) (ent-name (match-string-no-properties 2)) (ent-key (downcase ent-name)) (lib-alist (vhdl-scan-context-clause)) @@ -13827,16 +13844,16 @@ hierarchy otherwise.") inst-lib-key) comp-conf-list)) (setq inst-key-list (cdr inst-key-list))))) - (aput 'conf-alist conf-key - (list conf-name file-name conf-line ent-key - arch-key comp-conf-list lib-alist))))) + (vhdl-aput 'conf-alist conf-key + (list conf-name file-name conf-line ent-key + arch-key comp-conf-list lib-alist))))) ;; scan for packages (goto-char (point-min)) (while (re-search-forward "^[ \t]*package[ \t\n\r\f]+\\(body[ \t\n\r\f]+\\)?\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) (let* ((pack-name (match-string-no-properties 2)) (pack-key (downcase pack-name)) (is-body (match-string-no-properties 1)) - (pack-entry (aget pack-alist pack-key t)) + (pack-entry (vhdl-aget pack-alist pack-key)) (pack-line (vhdl-current-line)) (end-of-unit (vhdl-get-end-of-unit)) comp-name func-name comp-alist func-alist lib-alist) @@ -13867,7 +13884,7 @@ hierarchy otherwise.") (if is-body (push pack-key pack-body-list) (push pack-key pack-list)) - (aput + (vhdl-aput 'pack-alist pack-key (if is-body (list (or (nth 0 pack-entry) pack-name) @@ -13891,9 +13908,9 @@ hierarchy otherwise.") (ent-key (downcase ent-name)) (arch-name (match-string-no-properties 1)) (arch-key (downcase arch-name)) - (ent-entry (aget ent-alist ent-key t)) + (ent-entry (vhdl-aget ent-alist ent-key)) (arch-alist (nth 3 ent-entry)) - (arch-entry (aget arch-alist arch-key t)) + (arch-entry (vhdl-aget arch-alist arch-key)) (beg-of-unit (point)) (end-of-unit (vhdl-get-end-of-unit)) (inst-no 0) @@ -13907,7 +13924,10 @@ hierarchy otherwise.") "\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|" "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") end-of-unit t) (or (not limit-hier-inst-no) - (<= (setq inst-no (1+ inst-no)) + (<= (if (or (match-string 14) + (match-string 16)) + inst-no + (setq inst-no (1+ inst-no))) limit-hier-inst-no))) (cond ;; block/generate beginning found @@ -13988,23 +14008,25 @@ hierarchy otherwise.") (setcar tmp-inst-alist inst-entry)) (setq tmp-inst-alist (cdr tmp-inst-alist))))) ;; save in cache - (aput 'arch-alist arch-key - (list (nth 0 arch-entry) (nth 1 arch-entry) - (nth 2 arch-entry) inst-alist - (nth 4 arch-entry))) - (aput 'ent-alist ent-key - (list (nth 0 ent-entry) (nth 1 ent-entry) - (nth 2 ent-entry) (vhdl-sort-alist arch-alist) - (nth 4 ent-entry) (nth 5 ent-entry))) + (vhdl-aput 'arch-alist arch-key + (list (nth 0 arch-entry) (nth 1 arch-entry) + (nth 2 arch-entry) inst-alist + (nth 4 arch-entry))) + (vhdl-aput 'ent-alist ent-key + (list (nth 0 ent-entry) (nth 1 ent-entry) + (nth 2 ent-entry) + (vhdl-sort-alist arch-alist) + (nth 4 ent-entry) (nth 5 ent-entry))) (when (and limit-hier-inst-no (> inst-no limit-hier-inst-no)) (message "WARNING: Scan limit (hierarchy: instances per architecture) reached in file:\n \"%s\"" file-name) (setq big-files t)) (goto-char end-of-unit)))) ;; remember design units for this file - (aput 'file-alist file-name - (list ent-list arch-list arch-ent-list conf-list - pack-list pack-body-list inst-list inst-ent-list)) + (vhdl-aput 'file-alist file-name + (list ent-list arch-list arch-ent-list conf-list + pack-list pack-body-list + inst-list inst-ent-list)) (setq ent-inst-list (append inst-ent-list ent-inst-list)))))) (setq file-list (cdr file-list)))) (when (or (and (not project) files-exist) @@ -14023,8 +14045,8 @@ hierarchy otherwise.") ;; check whether configuration has a corresponding entity/architecture (setq tmp-list conf-alist) (while tmp-list - (if (setq tmp-entry (aget ent-alist (nth 4 (car tmp-list)) t)) - (unless (aget (nth 3 tmp-entry) (nth 5 (car tmp-list)) t) + (if (setq tmp-entry (vhdl-aget ent-alist (nth 4 (car tmp-list)))) + (unless (vhdl-aget (nth 3 tmp-entry) (nth 5 (car tmp-list))) (setq tmp-entry (car tmp-list)) (vhdl-warning-when-idle "Configuration of non-existing architecture: \"%s\" of \"%s(%s)\"\n in \"%s\" (line %d)" @@ -14053,17 +14075,17 @@ hierarchy otherwise.") (add-to-list 'vhdl-updated-project-list (or project dir-name))) ;; clear directory alists (unless project - (adelete 'vhdl-entity-alist key) - (adelete 'vhdl-config-alist key) - (adelete 'vhdl-package-alist key) - (adelete 'vhdl-ent-inst-alist key) - (adelete 'vhdl-file-alist key)) + (vhdl-adelete 'vhdl-entity-alist key) + (vhdl-adelete 'vhdl-config-alist key) + (vhdl-adelete 'vhdl-package-alist key) + (vhdl-adelete 'vhdl-ent-inst-alist key) + (vhdl-adelete 'vhdl-file-alist key)) ;; put directory contents into cache - (aput 'vhdl-entity-alist key ent-alist) - (aput 'vhdl-config-alist key conf-alist) - (aput 'vhdl-package-alist key pack-alist) - (aput 'vhdl-ent-inst-alist key (list ent-inst-list)) - (aput 'vhdl-file-alist key file-alist) + (vhdl-aput 'vhdl-entity-alist key ent-alist) + (vhdl-aput 'vhdl-config-alist key conf-alist) + (vhdl-aput 'vhdl-package-alist key pack-alist) + (vhdl-aput 'vhdl-ent-inst-alist key (list ent-inst-list)) + (vhdl-aput 'vhdl-file-alist key file-alist) ;; final messages (message "Scanning %s %s\"%s\"...done" (if is-directory "directory" "files") (or num-string "") name) @@ -14079,18 +14101,18 @@ hierarchy otherwise.") (defun vhdl-scan-project-contents (project) "Scan the contents of all VHDL files found in the directories and files of PROJECT." - (let ((dir-list (or (nth 2 (aget vhdl-project-alist project)) '(""))) + (let ((dir-list (or (nth 2 (vhdl-aget vhdl-project-alist project)) '(""))) (default-dir (vhdl-resolve-env-variable - (nth 1 (aget vhdl-project-alist project)))) + (nth 1 (vhdl-aget vhdl-project-alist project)))) (file-exclude-regexp - (or (nth 3 (aget vhdl-project-alist project)) "")) + (or (nth 3 (vhdl-aget vhdl-project-alist project)) "")) dir-list-tmp dir dir-name num-dir act-dir recursive) ;; clear project alists - (adelete 'vhdl-entity-alist project) - (adelete 'vhdl-config-alist project) - (adelete 'vhdl-package-alist project) - (adelete 'vhdl-ent-inst-alist project) - (adelete 'vhdl-file-alist project) + (vhdl-adelete 'vhdl-entity-alist project) + (vhdl-adelete 'vhdl-config-alist project) + (vhdl-adelete 'vhdl-package-alist project) + (vhdl-adelete 'vhdl-ent-inst-alist project) + (vhdl-adelete 'vhdl-file-alist project) ;; expand directory names by default-directory (message "Collecting source files...") (while dir-list @@ -14137,7 +14159,7 @@ of PROJECT." (add-to-list 'dir-list-tmp (file-name-directory dir-name)) (setq dir-list (cdr dir-list) act-dir (1+ act-dir))) - (aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp))) + (vhdl-aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp))) (message "Scanning project \"%s\"...done" project))) (defun vhdl-update-file-contents (file-name) @@ -14150,13 +14172,16 @@ of PROJECT." (when (member dir-name (nth 1 (car directory-alist))) (let* ((vhdl-project (nth 0 (car directory-alist))) (project (vhdl-project-p)) - (ent-alist (aget vhdl-entity-alist (or project dir-name) t)) - (conf-alist (aget vhdl-config-alist (or project dir-name) t)) - (pack-alist (aget vhdl-package-alist (or project dir-name) t)) - (ent-inst-list (car (aget vhdl-ent-inst-alist - (or project dir-name) t))) - (file-alist (aget vhdl-file-alist (or project dir-name) t)) - (file-entry (aget file-alist file-name t)) + (ent-alist (vhdl-aget vhdl-entity-alist + (or project dir-name))) + (conf-alist (vhdl-aget vhdl-config-alist + (or project dir-name))) + (pack-alist (vhdl-aget vhdl-package-alist + (or project dir-name))) + (ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist + (or project dir-name)))) + (file-alist (vhdl-aget vhdl-file-alist (or project dir-name))) + (file-entry (vhdl-aget file-alist file-name)) (ent-list (nth 0 file-entry)) (arch-list (nth 1 file-entry)) (arch-ent-list (nth 2 file-entry)) @@ -14170,57 +14195,57 @@ of PROJECT." ;; entities (while ent-list (setq key (car ent-list) - entry (aget ent-alist key t)) + entry (vhdl-aget ent-alist key)) (when (equal file-name (nth 1 entry)) (if (nth 3 entry) - (aput 'ent-alist key - (list (nth 0 entry) nil nil (nth 3 entry) nil)) - (adelete 'ent-alist key))) + (vhdl-aput 'ent-alist key + (list (nth 0 entry) nil nil (nth 3 entry) nil)) + (vhdl-adelete 'ent-alist key))) (setq ent-list (cdr ent-list))) ;; architectures (while arch-list (setq key (car arch-list) ent-key (car arch-ent-list) - entry (aget ent-alist ent-key t) + entry (vhdl-aget ent-alist ent-key) arch-alist (nth 3 entry)) - (when (equal file-name (nth 1 (aget arch-alist key t))) - (adelete 'arch-alist key) + (when (equal file-name (nth 1 (vhdl-aget arch-alist key))) + (vhdl-adelete 'arch-alist key) (if (or (nth 1 entry) arch-alist) - (aput 'ent-alist ent-key - (list (nth 0 entry) (nth 1 entry) (nth 2 entry) - arch-alist (nth 4 entry) (nth 5 entry))) - (adelete 'ent-alist ent-key))) + (vhdl-aput 'ent-alist ent-key + (list (nth 0 entry) (nth 1 entry) (nth 2 entry) + arch-alist (nth 4 entry) (nth 5 entry))) + (vhdl-adelete 'ent-alist ent-key))) (setq arch-list (cdr arch-list) arch-ent-list (cdr arch-ent-list))) ;; configurations (while conf-list (setq key (car conf-list)) - (when (equal file-name (nth 1 (aget conf-alist key t))) - (adelete 'conf-alist key)) + (when (equal file-name (nth 1 (vhdl-aget conf-alist key))) + (vhdl-adelete 'conf-alist key)) (setq conf-list (cdr conf-list))) ;; package declarations (while pack-list (setq key (car pack-list) - entry (aget pack-alist key t)) + entry (vhdl-aget pack-alist key)) (when (equal file-name (nth 1 entry)) (if (nth 6 entry) - (aput 'pack-alist key - (list (nth 0 entry) nil nil nil nil nil - (nth 6 entry) (nth 7 entry) (nth 8 entry) - (nth 9 entry))) - (adelete 'pack-alist key))) + (vhdl-aput 'pack-alist key + (list (nth 0 entry) nil nil nil nil nil + (nth 6 entry) (nth 7 entry) (nth 8 entry) + (nth 9 entry))) + (vhdl-adelete 'pack-alist key))) (setq pack-list (cdr pack-list))) ;; package bodies (while pack-body-list (setq key (car pack-body-list) - entry (aget pack-alist key t)) + entry (vhdl-aget pack-alist key)) (when (equal file-name (nth 6 entry)) (if (nth 1 entry) - (aput 'pack-alist key - (list (nth 0 entry) (nth 1 entry) (nth 2 entry) - (nth 3 entry) (nth 4 entry) (nth 5 entry) - nil nil nil nil)) - (adelete 'pack-alist key))) + (vhdl-aput 'pack-alist key + (list (nth 0 entry) (nth 1 entry) (nth 2 entry) + (nth 3 entry) (nth 4 entry) (nth 5 entry) + nil nil nil nil)) + (vhdl-adelete 'pack-alist key))) (setq pack-body-list (cdr pack-body-list))) ;; instantiated entities (while inst-ent-list @@ -14228,10 +14253,10 @@ of PROJECT." (vhdl-delete (car inst-ent-list) ent-inst-list)) (setq inst-ent-list (cdr inst-ent-list))) ;; update caches - (vhdl-aput 'vhdl-entity-alist cache-key ent-alist) - (vhdl-aput 'vhdl-config-alist cache-key conf-alist) - (vhdl-aput 'vhdl-package-alist cache-key pack-alist) - (vhdl-aput 'vhdl-ent-inst-alist cache-key (list ent-inst-list)) + (vhdl-aput-delete-if-nil 'vhdl-entity-alist cache-key ent-alist) + (vhdl-aput-delete-if-nil 'vhdl-config-alist cache-key conf-alist) + (vhdl-aput-delete-if-nil 'vhdl-package-alist cache-key pack-alist) + (vhdl-aput-delete-if-nil 'vhdl-ent-inst-alist cache-key (list ent-inst-list)) ;; scan file (vhdl-scan-directory-contents file-name project t) (when (or (and vhdl-speedbar-show-projects project) @@ -14264,8 +14289,8 @@ of PROJECT." &optional include-top ent-hier) "Get instantiation hierarchy beginning in architecture ARCH-KEY of entity ENT-KEY." - (let* ((ent-entry (aget ent-alist ent-key t)) - (arch-entry (if arch-key (aget (nth 3 ent-entry) arch-key t) + (let* ((ent-entry (vhdl-aget ent-alist ent-key)) + (arch-entry (if arch-key (vhdl-aget (nth 3 ent-entry) arch-key) (cdar (last (nth 3 ent-entry))))) (inst-alist (nth 3 arch-entry)) inst-entry inst-ent-entry inst-arch-entry inst-conf-entry comp-entry @@ -14276,9 +14301,6 @@ entity ENT-KEY." (setq level (1+ level))) (when (member ent-key ent-hier) (error "ERROR: Instantiation loop detected, component instantiates itself: \"%s\"" ent-key)) - ;; check configured architecture (already checked during scanning) -; (unless (or (null conf-inst-alist) (assoc arch-key (nth 3 ent-entry))) -; (vhdl-warning-when-idle "Configuration for non-existing architecture used: \"%s\"" conf-key)) ;; process all instances (while inst-alist (setq inst-entry (car inst-alist) @@ -14294,27 +14316,27 @@ entity ENT-KEY." (downcase (or inst-comp-name "")))))) (setq tmp-list (cdr tmp-list))) (setq inst-conf-key (or (nth 4 (car tmp-list)) inst-conf-key)) - (setq inst-conf-entry (aget conf-alist inst-conf-key t)) + (setq inst-conf-entry (vhdl-aget conf-alist inst-conf-key)) (when (and inst-conf-key (not inst-conf-entry)) (vhdl-warning-when-idle "Configuration not found: \"%s\"" inst-conf-key)) ;; determine entity (setq inst-ent-key (or (nth 2 (car tmp-list)) ; from configuration (nth 3 inst-conf-entry) ; from subconfiguration - (nth 3 (aget conf-alist (nth 7 inst-entry) t)) + (nth 3 (vhdl-aget conf-alist (nth 7 inst-entry))) ; from configuration spec. (nth 5 inst-entry))) ; from direct instantiation - (setq inst-ent-entry (aget ent-alist inst-ent-key t)) + (setq inst-ent-entry (vhdl-aget ent-alist inst-ent-key)) ;; determine architecture (setq inst-arch-key (or (nth 3 (car tmp-list)) ; from configuration (nth 4 inst-conf-entry) ; from subconfiguration (nth 6 inst-entry) ; from direct instantiation - (nth 4 (aget conf-alist (nth 7 inst-entry))) + (nth 4 (vhdl-aget conf-alist (nth 7 inst-entry))) ; from configuration spec. (nth 4 inst-ent-entry) ; MRA (caar (nth 3 inst-ent-entry)))) ; first alphabetically - (setq inst-arch-entry (aget (nth 3 inst-ent-entry) inst-arch-key t)) + (setq inst-arch-entry (vhdl-aget (nth 3 inst-ent-entry) inst-arch-key)) ;; set library (setq inst-lib-key (or (nth 5 (car tmp-list)) ; from configuration @@ -14353,7 +14375,8 @@ entity ENT-KEY." (defun vhdl-get-instantiations (ent-key indent) "Get all instantiations of entity ENT-KEY." - (let ((ent-alist (aget vhdl-entity-alist (vhdl-speedbar-line-key indent) t)) + (let ((ent-alist (vhdl-aget vhdl-entity-alist + (vhdl-speedbar-line-key indent))) arch-alist inst-alist ent-inst-list ent-entry arch-entry inst-entry) (while ent-alist @@ -14439,29 +14462,29 @@ entity ENT-KEY." (insert ")\n") (when (member 'hierarchy vhdl-speedbar-save-cache) (insert "\n;; entity and architecture cache\n" - "(aput 'vhdl-entity-alist " key " '") - (print (aget vhdl-entity-alist cache-key t) (current-buffer)) + "(vhdl-aput 'vhdl-entity-alist " key " '") + (print (vhdl-aget vhdl-entity-alist cache-key) (current-buffer)) (insert ")\n\n;; configuration cache\n" - "(aput 'vhdl-config-alist " key " '") - (print (aget vhdl-config-alist cache-key t) (current-buffer)) + "(vhdl-aput 'vhdl-config-alist " key " '") + (print (vhdl-aget vhdl-config-alist cache-key) (current-buffer)) (insert ")\n\n;; package cache\n" - "(aput 'vhdl-package-alist " key " '") - (print (aget vhdl-package-alist cache-key t) (current-buffer)) + "(vhdl-aput 'vhdl-package-alist " key " '") + (print (vhdl-aget vhdl-package-alist cache-key) (current-buffer)) (insert ")\n\n;; instantiated entities cache\n" - "(aput 'vhdl-ent-inst-alist " key " '") - (print (aget vhdl-ent-inst-alist cache-key t) (current-buffer)) + "(vhdl-aput 'vhdl-ent-inst-alist " key " '") + (print (vhdl-aget vhdl-ent-inst-alist cache-key) (current-buffer)) (insert ")\n\n;; design units per file cache\n" - "(aput 'vhdl-file-alist " key " '") - (print (aget vhdl-file-alist cache-key t) (current-buffer)) + "(vhdl-aput 'vhdl-file-alist " key " '") + (print (vhdl-aget vhdl-file-alist cache-key) (current-buffer)) (when project (insert ")\n\n;; source directories in project cache\n" - "(aput 'vhdl-directory-alist " key " '") - (print (aget vhdl-directory-alist cache-key t) (current-buffer))) + "(vhdl-aput 'vhdl-directory-alist " key " '") + (print (vhdl-aget vhdl-directory-alist cache-key) (current-buffer))) (insert ")\n")) (when (member 'display vhdl-speedbar-save-cache) (insert "\n;; shown design units cache\n" - "(aput 'vhdl-speedbar-shown-unit-alist " key " '") - (print (aget vhdl-speedbar-shown-unit-alist cache-key t) + "(vhdl-aput 'vhdl-speedbar-shown-unit-alist " key " '") + (print (vhdl-aget vhdl-speedbar-shown-unit-alist cache-key) (current-buffer)) (insert ")\n")) (setq vhdl-updated-project-list @@ -14528,7 +14551,6 @@ if required." (defun vhdl-speedbar-initialize () "Initialize speedbar." ;; general settings -; (set (make-local-variable 'speedbar-tag-hierarchy-method) nil) ;; VHDL file extensions (extracted from `auto-mode-alist') (let ((mode-alist auto-mode-alist)) (while mode-alist @@ -14626,11 +14648,7 @@ if required." (append '(("vhdl directory" vhdl-speedbar-update-current-unit) ("vhdl project" vhdl-speedbar-update-current-project - vhdl-speedbar-update-current-unit) -; ("files" (lambda () (setq speedbar-ignored-path-regexp -; (speedbar-extension-list-to-regex -; speedbar-ignored-path-expressions)))) - ) + vhdl-speedbar-update-current-unit)) speedbar-stealthy-function-list)) (when (eq vhdl-speedbar-display-mode 'directory) (setq speedbar-initial-expansion-list-name "vhdl directory")) @@ -14724,10 +14742,7 @@ if required." (concat "^\\([0-9]+:\\s-*<\\)[+]>\\s-+" (caar project-alist) "$") nil t) (goto-char (match-end 1)) (speedbar-do-function-pointer))) - (setq project-alist (cdr project-alist)))) -; (vhdl-speedbar-update-current-project) -; (vhdl-speedbar-update-current-unit nil t) - ) + (setq project-alist (cdr project-alist))))) (defun vhdl-speedbar-insert-project-hierarchy (project indent &optional rescan) "Insert hierarchy of PROJECT. Rescan directories if RESCAN is non-nil, @@ -14737,10 +14752,10 @@ otherwise use cached data." (vhdl-scan-project-contents project)) ;; insert design hierarchy (vhdl-speedbar-insert-hierarchy - (aget vhdl-entity-alist project t) - (aget vhdl-config-alist project t) - (aget vhdl-package-alist project t) - (car (aget vhdl-ent-inst-alist project t)) indent) + (vhdl-aget vhdl-entity-alist project) + (vhdl-aget vhdl-config-alist project) + (vhdl-aget vhdl-package-alist project) + (car (vhdl-aget vhdl-ent-inst-alist project)) indent) (insert (int-to-string indent) ":\n") (put-text-property (- (point) 3) (1- (point)) 'invisible t) (put-text-property (1- (point)) (point) 'invisible nil) @@ -14755,13 +14770,13 @@ otherwise use cached data." (vhdl-scan-directory-contents directory)) ;; insert design hierarchy (vhdl-speedbar-insert-hierarchy - (aget vhdl-entity-alist directory t) - (aget vhdl-config-alist directory t) - (aget vhdl-package-alist directory t) - (car (aget vhdl-ent-inst-alist directory t)) depth) + (vhdl-aget vhdl-entity-alist directory) + (vhdl-aget vhdl-config-alist directory) + (vhdl-aget vhdl-package-alist directory) + (car (vhdl-aget vhdl-ent-inst-alist directory)) depth) ;; expand design units (vhdl-speedbar-expand-units directory) - (aput 'vhdl-directory-alist directory (list (list directory)))) + (vhdl-aput 'vhdl-directory-alist directory (list (list directory)))) (defun vhdl-speedbar-insert-hierarchy (ent-alist conf-alist pack-alist ent-inst-list depth) @@ -14849,10 +14864,10 @@ otherwise use cached data." (defun vhdl-speedbar-expand-units (key) "Expand design units in directory/project KEY according to `vhdl-speedbar-shown-unit-alist'." - (let ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)) + (let ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)) (vhdl-speedbar-update-current-unit nil) vhdl-updated-project-list) - (adelete 'vhdl-speedbar-shown-unit-alist key) + (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key) (vhdl-prepare-search-1 (while unit-alist ; expand units (vhdl-speedbar-goto-this-unit key (caar unit-alist)) @@ -14902,7 +14917,7 @@ otherwise use cached data." (progn (setq vhdl-speedbar-shown-project-list nil) (vhdl-speedbar-refresh)) (let ((key (vhdl-speedbar-line-key))) - (adelete 'vhdl-speedbar-shown-unit-alist key) + (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key) (vhdl-speedbar-refresh (and vhdl-speedbar-show-projects key)) (when (memq 'display vhdl-speedbar-save-cache) (add-to-list 'vhdl-updated-project-list key))))) @@ -14911,9 +14926,9 @@ otherwise use cached data." "Expand all design units in current directory/project." (interactive) (let* ((key (vhdl-speedbar-line-key)) - (ent-alist (aget vhdl-entity-alist key t)) - (conf-alist (aget vhdl-config-alist key t)) - (pack-alist (aget vhdl-package-alist key t)) + (ent-alist (vhdl-aget vhdl-entity-alist key)) + (conf-alist (vhdl-aget vhdl-config-alist key)) + (pack-alist (vhdl-aget vhdl-package-alist key)) arch-alist unit-alist subunit-alist) (add-to-list 'vhdl-speedbar-shown-project-list key) (while ent-alist @@ -14930,7 +14945,7 @@ otherwise use cached data." (while pack-alist (push (list (caar pack-alist)) unit-alist) (setq pack-alist (cdr pack-alist))) - (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) + (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) (vhdl-speedbar-refresh) (when (memq 'display vhdl-speedbar-save-cache) (add-to-list 'vhdl-updated-project-list key)))) @@ -14965,8 +14980,8 @@ otherwise use cached data." (cond ((string-match "+" text) ; expand entity (let* ((key (vhdl-speedbar-line-key indent)) - (ent-alist (aget vhdl-entity-alist key t)) - (ent-entry (aget ent-alist token t)) + (ent-alist (vhdl-aget vhdl-entity-alist key)) + (ent-entry (vhdl-aget ent-alist token)) (arch-alist (nth 3 ent-entry)) (inst-alist (vhdl-get-instantiations token indent)) (subpack-alist (nth 5 ent-entry)) @@ -14976,9 +14991,9 @@ otherwise use cached data." (speedbar-change-expand-button-char ??) (speedbar-change-expand-button-char ?-) ;; add entity to `vhdl-speedbar-shown-unit-alist' - (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) - (aput 'unit-alist token nil) - (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) + (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) + (vhdl-aput 'unit-alist token nil) + (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) (speedbar-with-writable (save-excursion (end-of-line) (forward-char 1) @@ -15017,11 +15032,11 @@ otherwise use cached data." (speedbar-change-expand-button-char ?+) ;; remove entity from `vhdl-speedbar-shown-unit-alist' (let* ((key (vhdl-speedbar-line-key indent)) - (unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) - (adelete 'unit-alist token) + (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) + (vhdl-adelete 'unit-alist token) (if unit-alist - (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) - (adelete 'vhdl-speedbar-shown-unit-alist key)) + (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) + (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)) (speedbar-delete-subblock indent) (when (memq 'display vhdl-speedbar-save-cache) (add-to-list 'vhdl-updated-project-list key)))) @@ -15034,23 +15049,24 @@ otherwise use cached data." (cond ((string-match "+" text) ; expand architecture (let* ((key (vhdl-speedbar-line-key (1- indent))) - (ent-alist (aget vhdl-entity-alist key t)) - (conf-alist (aget vhdl-config-alist key t)) + (ent-alist (vhdl-aget vhdl-entity-alist key)) + (conf-alist (vhdl-aget vhdl-config-alist key)) (hier-alist (vhdl-get-hierarchy ent-alist conf-alist (car token) (cdr token) nil nil 0 (1- indent))) - (ent-entry (aget ent-alist (car token) t)) - (arch-entry (aget (nth 3 ent-entry) (cdr token) t)) + (ent-entry (vhdl-aget ent-alist (car token))) + (arch-entry (vhdl-aget (nth 3 ent-entry) (cdr token))) (subpack-alist (nth 4 arch-entry)) entry) (if (not (or hier-alist subpack-alist)) (speedbar-change-expand-button-char ??) (speedbar-change-expand-button-char ?-) ;; add architecture to `vhdl-speedbar-shown-unit-alist' - (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)) - (arch-alist (nth 0 (aget unit-alist (car token) t)))) - (aput 'unit-alist (car token) (list (cons (cdr token) arch-alist))) - (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) + (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)) + (arch-alist (nth 0 (vhdl-aget unit-alist (car token))))) + (vhdl-aput 'unit-alist (car token) + (list (cons (cdr token) arch-alist))) + (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) (speedbar-with-writable (save-excursion (end-of-line) (forward-char 1) @@ -15077,10 +15093,10 @@ otherwise use cached data." (speedbar-change-expand-button-char ?+) ;; remove architecture from `vhdl-speedbar-shown-unit-alist' (let* ((key (vhdl-speedbar-line-key (1- indent))) - (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)) - (arch-alist (nth 0 (aget unit-alist (car token) t)))) - (aput 'unit-alist (car token) (list (delete (cdr token) arch-alist))) - (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) + (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)) + (arch-alist (nth 0 (vhdl-aget unit-alist (car token))))) + (vhdl-aput 'unit-alist (car token) (list (delete (cdr token) arch-alist))) + (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) (speedbar-delete-subblock indent) (when (memq 'display vhdl-speedbar-save-cache) (add-to-list 'vhdl-updated-project-list key)))) @@ -15093,9 +15109,9 @@ otherwise use cached data." (cond ((string-match "+" text) ; expand configuration (let* ((key (vhdl-speedbar-line-key indent)) - (conf-alist (aget vhdl-config-alist key t)) - (conf-entry (aget conf-alist token)) - (ent-alist (aget vhdl-entity-alist key t)) + (conf-alist (vhdl-aget vhdl-config-alist key)) + (conf-entry (vhdl-aget conf-alist token)) + (ent-alist (vhdl-aget vhdl-entity-alist key)) (hier-alist (vhdl-get-hierarchy ent-alist conf-alist (nth 3 conf-entry) (nth 4 conf-entry) token (nth 5 conf-entry) @@ -15106,9 +15122,9 @@ otherwise use cached data." (speedbar-change-expand-button-char ??) (speedbar-change-expand-button-char ?-) ;; add configuration to `vhdl-speedbar-shown-unit-alist' - (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) - (aput 'unit-alist token nil) - (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) + (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) + (vhdl-aput 'unit-alist token nil) + (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) (speedbar-with-writable (save-excursion (end-of-line) (forward-char 1) @@ -15134,11 +15150,11 @@ otherwise use cached data." (speedbar-change-expand-button-char ?+) ;; remove configuration from `vhdl-speedbar-shown-unit-alist' (let* ((key (vhdl-speedbar-line-key indent)) - (unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) - (adelete 'unit-alist token) + (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) + (vhdl-adelete 'unit-alist token) (if unit-alist - (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) - (adelete 'vhdl-speedbar-shown-unit-alist key)) + (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) + (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)) (speedbar-delete-subblock indent) (when (memq 'display vhdl-speedbar-save-cache) (add-to-list 'vhdl-updated-project-list key)))) @@ -15151,8 +15167,8 @@ otherwise use cached data." (cond ((string-match "+" text) ; expand package (let* ((key (vhdl-speedbar-line-key indent)) - (pack-alist (aget vhdl-package-alist key t)) - (pack-entry (aget pack-alist token t)) + (pack-alist (vhdl-aget vhdl-package-alist key)) + (pack-entry (vhdl-aget pack-alist token)) (comp-alist (nth 3 pack-entry)) (func-alist (nth 4 pack-entry)) (func-body-alist (nth 8 pack-entry)) @@ -15162,9 +15178,9 @@ otherwise use cached data." (speedbar-change-expand-button-char ??) (speedbar-change-expand-button-char ?-) ;; add package to `vhdl-speedbar-shown-unit-alist' - (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) - (aput 'unit-alist token nil) - (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) + (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) + (vhdl-aput 'unit-alist token nil) + (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) (speedbar-with-writable (save-excursion (end-of-line) (forward-char 1) @@ -15185,7 +15201,8 @@ otherwise use cached data." (vhdl-speedbar-make-title-line "Subprograms:" (1+ indent))) (while func-alist (setq func-entry (car func-alist) - func-body-entry (aget func-body-alist (car func-entry) t)) + func-body-entry (vhdl-aget func-body-alist + (car func-entry))) (when (nth 2 func-entry) (vhdl-speedbar-make-subprogram-line (nth 1 func-entry) @@ -15203,11 +15220,11 @@ otherwise use cached data." (speedbar-change-expand-button-char ?+) ;; remove package from `vhdl-speedbar-shown-unit-alist' (let* ((key (vhdl-speedbar-line-key indent)) - (unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) - (adelete 'unit-alist token) + (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) + (vhdl-adelete 'unit-alist token) (if unit-alist - (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) - (adelete 'vhdl-speedbar-shown-unit-alist key)) + (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) + (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)) (speedbar-delete-subblock indent) (when (memq 'display vhdl-speedbar-save-cache) (add-to-list 'vhdl-updated-project-list key)))) @@ -15217,15 +15234,15 @@ otherwise use cached data." (defun vhdl-speedbar-insert-subpackages (subpack-alist indent dir-indent) "Insert required packages." - (let* ((pack-alist (aget vhdl-package-alist - (vhdl-speedbar-line-key dir-indent) t)) + (let* ((pack-alist (vhdl-aget vhdl-package-alist + (vhdl-speedbar-line-key dir-indent))) pack-key lib-name pack-entry) (when subpack-alist (vhdl-speedbar-make-title-line "Packages Used:" indent)) (while subpack-alist (setq pack-key (cdar subpack-alist) lib-name (caar subpack-alist)) - (setq pack-entry (aget pack-alist pack-key t)) + (setq pack-entry (vhdl-aget pack-alist pack-key)) (vhdl-speedbar-make-subpack-line (or (nth 0 pack-entry) pack-key) lib-name (cons (nth 1 pack-entry) (nth 2 pack-entry)) @@ -15283,18 +15300,21 @@ NO-POSITION non-nil means do not re-position cursor." (or always (not (equal file-name speedbar-last-selected-file)))) (if vhdl-speedbar-show-projects (while project-list - (setq file-alist (append file-alist (aget vhdl-file-alist - (car project-list) t))) + (setq file-alist (append file-alist + (vhdl-aget vhdl-file-alist + (car project-list)))) (setq project-list (cdr project-list))) - (setq file-alist (aget vhdl-file-alist - (abbreviate-file-name default-directory) t))) + (setq file-alist + (vhdl-aget vhdl-file-alist + (abbreviate-file-name default-directory)))) (select-frame speedbar-frame) (set-buffer speedbar-buffer) (speedbar-with-writable (vhdl-prepare-search-1 (save-excursion ;; unhighlight last units - (let* ((file-entry (aget file-alist speedbar-last-selected-file t))) + (let* ((file-entry (vhdl-aget file-alist + speedbar-last-selected-file))) (vhdl-speedbar-update-units "\\[.\\] " (nth 0 file-entry) speedbar-last-selected-file 'vhdl-speedbar-entity-face) @@ -15314,7 +15334,7 @@ NO-POSITION non-nil means do not re-position cursor." "> " (nth 6 file-entry) speedbar-last-selected-file 'vhdl-speedbar-instantiation-face)) ;; highlight current units - (let* ((file-entry (aget file-alist file-name t))) + (let* ((file-entry (vhdl-aget file-alist file-name))) (setq pos (vhdl-speedbar-update-units "\\[.\\] " (nth 0 file-entry) @@ -15747,7 +15767,8 @@ is already shown in a buffer." (let ((buffer (get-file-buffer (car token)))) (speedbar-find-file-in-frame (car token)) (when (or vhdl-speedbar-jump-to-unit buffer) - (vhdl-goto-line (cdr token)) + (goto-char (point-min)) + (forward-line (1- (cdr token))) (recenter)) (vhdl-speedbar-update-current-unit t t) (speedbar-set-timer dframe-update-speed) @@ -15765,7 +15786,8 @@ is already shown in a buffer." (let ((token (get-text-property (match-beginning 3) 'speedbar-token))) (vhdl-visit-file (car token) t - (progn (vhdl-goto-line (cdr token)) + (progn (goto-char (point-min)) + (forward-line (1- (cdr token))) (end-of-line) (if is-entity (vhdl-port-copy) @@ -15805,9 +15827,11 @@ is already shown in a buffer." (error "ERROR: No architecture under cursor") (let* ((arch-key (downcase (vhdl-speedbar-line-text))) (ent-key (downcase (vhdl-speedbar-higher-text))) - (ent-alist (aget vhdl-entity-alist - (or (vhdl-project-p) default-directory) t)) - (ent-entry (aget ent-alist ent-key t))) + (ent-alist (vhdl-aget + vhdl-entity-alist + (or (vhdl-project-p) + (abbreviate-file-name default-directory)))) + (ent-entry (vhdl-aget ent-alist ent-key))) (setcar (cddr (cddr ent-entry)) arch-key) ; (nth 4 ent-entry) (speedbar-refresh)))) @@ -15946,15 +15970,14 @@ expansion function)." ;; add speedbar (when (fboundp 'speedbar) - (condition-case () - (when (and vhdl-speedbar-auto-open - (not (and (boundp 'speedbar-frame) - (frame-live-p speedbar-frame)))) - (speedbar-frame-mode 1) - (if (fboundp 'speedbar-select-attached-frame) - (speedbar-select-attached-frame) - (select-frame speedbar-attached-frame))) - (error (vhdl-warning-when-idle "ERROR: An error occurred while opening speedbar")))) + (let ((current-frame (selected-frame))) + (condition-case () + (when (and vhdl-speedbar-auto-open + (not (and (boundp 'speedbar-frame) + (frame-live-p speedbar-frame)))) + (speedbar-frame-mode 1)) + (error (vhdl-warning-when-idle "ERROR: An error occurred while opening speedbar"))) + (select-frame current-frame))) ;; initialize speedbar (if (not (boundp 'speedbar-frame)) @@ -16217,7 +16240,7 @@ component instantiation." (setq constant-entry (cons constant-name (if (match-string 1) - (or (aget generic-alist (match-string 2) t) + (or (vhdl-aget generic-alist (match-string 2)) (error "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) (cdar generic-alist)))) (push constant-entry constant-alist) @@ -16235,11 +16258,12 @@ component instantiation." (vhdl-forward-syntactic-ws) (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t) (setq signal-name (match-string-no-properties 3)) - (setq signal-entry (cons signal-name - (if (match-string 1) - (or (aget port-alist (match-string 2) t) - (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) - (cdar port-alist)))) + (setq signal-entry + (cons signal-name + (if (match-string 1) + (or (vhdl-aget port-alist (match-string 2)) + (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) + (cdar port-alist)))) (push signal-entry signal-alist) (setq signal-name (downcase signal-name)) (if (equal (upcase (nth 2 signal-entry)) "IN") @@ -16478,8 +16502,9 @@ current project/directory." (pack-file-name (concat (vhdl-replace-string vhdl-package-file-name pack-name t) "." (file-name-extension (buffer-file-name)))) - (ent-alist (aget vhdl-entity-alist - (or project default-directory) t)) + (ent-alist (vhdl-aget vhdl-entity-alist + (or project + (abbreviate-file-name default-directory)))) (lazy-lock-minimum-size 0) clause-pos component-pos) (message "Generating components package \"%s\"..." pack-name) @@ -16519,7 +16544,8 @@ current project/directory." ;; insert component declarations (while ent-alist (vhdl-visit-file (nth 2 (car ent-alist)) nil - (progn (vhdl-goto-line (nth 3 (car ent-alist))) + (progn (goto-char (point-min)) + (forward-line (1- (nth 3 (car ent-alist)))) (end-of-line) (vhdl-port-copy))) (goto-char component-pos) @@ -16581,7 +16607,7 @@ current project/directory." (when (equal (nth 5 inst-entry) (nth 4 (car tmp-alist))) (setq conf-key (nth 0 (car tmp-alist)))) (setq tmp-alist (cdr tmp-alist))) - (setq conf-entry (aget conf-alist conf-key t)) + (setq conf-entry (vhdl-aget conf-alist conf-key)) ;; insert binding indication ... ;; ... with subconfiguration (if exists) (if (and vhdl-compose-configuration-use-subconfiguration conf-entry) @@ -16591,7 +16617,7 @@ current project/directory." (insert (vhdl-work-library) "." (nth 0 conf-entry)) (insert ";\n")) ;; ... with entity (if exists) - (setq ent-entry (aget ent-alist (nth 5 inst-entry) t)) + (setq ent-entry (vhdl-aget ent-alist (nth 5 inst-entry))) (when ent-entry (indent-to (+ margin vhdl-basic-offset)) (vhdl-insert-keyword "USE ENTITY ") @@ -16601,9 +16627,9 @@ current project/directory." (setq arch-name ;; choose architecture name a) from configuration, ;; b) from mra, or c) from first architecture - (or (nth 0 (aget (nth 3 ent-entry) - (or (nth 6 inst-entry) - (nth 4 ent-entry)) t)) + (or (nth 0 (vhdl-aget (nth 3 ent-entry) + (or (nth 6 inst-entry) + (nth 4 ent-entry)))) (nth 1 (car (nth 3 ent-entry))))) (insert "(" arch-name ")")) (insert ";\n") @@ -16613,7 +16639,7 @@ current project/directory." (indent-to (+ margin vhdl-basic-offset)) (vhdl-compose-configuration-architecture (nth 0 ent-entry) arch-name ent-alist conf-alist - (nth 3 (aget (nth 3 ent-entry) (downcase arch-name) t)))))) + (nth 3 (vhdl-aget (nth 3 ent-entry) (downcase arch-name))))))) ;; insert component configuration end (indent-to margin) (vhdl-insert-keyword "END FOR;\n") @@ -16635,10 +16661,12 @@ current project/directory." "Generate configuration declaration." (interactive) (vhdl-require-hierarchy-info) - (let ((ent-alist (aget vhdl-entity-alist - (or (vhdl-project-p) default-directory) t)) - (conf-alist (aget vhdl-config-alist - (or (vhdl-project-p) default-directory) t)) + (let ((ent-alist (vhdl-aget vhdl-entity-alist + (or (vhdl-project-p) + (abbreviate-file-name default-directory)))) + (conf-alist (vhdl-aget vhdl-config-alist + (or (vhdl-project-p) + (abbreviate-file-name default-directory)))) (from-speedbar ent-name) inst-alist conf-name conf-file-name pos) (vhdl-prepare-search-2 @@ -16654,8 +16682,8 @@ current project/directory." vhdl-compose-configuration-name (concat ent-name " " arch-name))) (setq inst-alist - (nth 3 (aget (nth 3 (aget ent-alist (downcase ent-name) t)) - (downcase arch-name) t)))) + (nth 3 (vhdl-aget (nth 3 (vhdl-aget ent-alist (downcase ent-name))) + (downcase arch-name))))) (message "Generating configuration \"%s\"..." conf-name) (if vhdl-compose-configuration-create-file ;; open configuration file @@ -16721,8 +16749,8 @@ current project/directory." (defun vhdl-makefile-name () "Return the Makefile name of the current project or the current compiler if no project is defined." - (let ((project-alist (aget vhdl-project-alist vhdl-project)) - (compiler-alist (aget vhdl-compiler-alist vhdl-compiler))) + (let ((project-alist (vhdl-aget vhdl-project-alist vhdl-project)) + (compiler-alist (vhdl-aget vhdl-compiler-alist vhdl-compiler))) (vhdl-replace-string (cons "\\(.*\\)\n\\(.*\\)" (or (nth 8 project-alist) (nth 8 compiler-alist))) @@ -16730,8 +16758,8 @@ no project is defined." (defun vhdl-compile-directory () "Return the directory where compilation/make should be run." - (let* ((project (aget vhdl-project-alist (vhdl-project-p t))) - (compiler (aget vhdl-compiler-alist vhdl-compiler)) + (let* ((project (vhdl-aget vhdl-project-alist (vhdl-project-p t))) + (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler)) (directory (vhdl-resolve-env-variable (if project (vhdl-replace-string @@ -16765,9 +16793,10 @@ no project is defined." (defun vhdl-compile-init () "Initialize for compilation." - (when (or (null compilation-error-regexp-alist) - (not (assoc (car (nth 11 (car vhdl-compiler-alist))) - compilation-error-regexp-alist))) + (when (and (not vhdl-emacs-22) + (or (null compilation-error-regexp-alist) + (not (assoc (car (nth 11 (car vhdl-compiler-alist))) + compilation-error-regexp-alist)))) ;; `compilation-error-regexp-alist' (let ((commands-alist vhdl-compiler-alist) regexp-alist sublist) @@ -16810,7 +16839,7 @@ do not print any file names." &optional file-options-only) "Get compiler options. Returning nil means do not compile this file." (let* ((compiler-options (nth 1 compiler)) - (project-entry (aget (nth 4 project) vhdl-compiler)) + (project-entry (vhdl-aget (nth 4 project) vhdl-compiler)) (project-options (nth 0 project-entry)) (exception-list (and file-name (nth 2 project-entry))) (work-library (vhdl-work-library)) @@ -16847,7 +16876,7 @@ do not print any file names." (defun vhdl-get-make-options (project compiler) "Get make options." (let* ((compiler-options (nth 3 compiler)) - (project-entry (aget (nth 4 project) vhdl-compiler)) + (project-entry (vhdl-aget (nth 4 project) vhdl-compiler)) (project-options (nth 1 project-entry)) (makefile-name (vhdl-makefile-name))) ;; insert Makefile name in compiler-specific options @@ -16868,8 +16897,8 @@ do not print any file names." `vhdl-compiler'." (interactive) (vhdl-compile-init) - (let* ((project (aget vhdl-project-alist vhdl-project)) - (compiler (or (aget vhdl-compiler-alist vhdl-compiler nil) + (let* ((project (vhdl-aget vhdl-project-alist vhdl-project)) + (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler) (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) (command (nth 0 compiler)) (default-directory (vhdl-compile-directory)) @@ -16910,8 +16939,8 @@ specified by a target." (or target (read-from-minibuffer "Target: " vhdl-make-target vhdl-minibuffer-local-map))) (vhdl-compile-init) - (let* ((project (aget vhdl-project-alist vhdl-project)) - (compiler (or (aget vhdl-compiler-alist vhdl-compiler) + (let* ((project (vhdl-aget vhdl-project-alist vhdl-project)) + (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler) (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) (command (nth 2 compiler)) (options (vhdl-get-make-options project compiler)) @@ -16928,17 +16957,20 @@ specified by a target." (let ((compiler-alist vhdl-compiler-alist) (error-regexp-alist '((vhdl-directory "^ *Compiling \"\\(.+\\)\"" 1)))) (while compiler-alist - ;; add error message regexps - (setq error-regexp-alist - (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist))))))) - (nth 11 (car compiler-alist))) - error-regexp-alist)) - ;; add filename regexps - (when (/= 0 (nth 1 (nth 12 (car compiler-alist)))) + ;; only add regexps for currently selected compiler + (when (or (not vhdl-compile-use-local-error-regexp) + (equal vhdl-compiler (nth 0 (car compiler-alist)))) + ;; add error message regexps (setq error-regexp-alist - (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))) "-file"))) - (nth 12 (car compiler-alist))) - error-regexp-alist))) + (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist))))))) + (nth 11 (car compiler-alist))) + error-regexp-alist)) + ;; add filename regexps + (when (/= 0 (nth 1 (nth 12 (car compiler-alist)))) + (setq error-regexp-alist + (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))) "-file"))) + (nth 12 (car compiler-alist))) + error-regexp-alist)))) (setq compiler-alist (cdr compiler-alist))) error-regexp-alist) "List of regexps for VHDL compilers. For Emacs 22+.") @@ -16949,6 +16981,10 @@ specified by a target." (interactive) (when (and (boundp 'compilation-error-regexp-alist-alist) (not (assoc 'vhdl-modelsim compilation-error-regexp-alist-alist))) + ;; remove all other compilers + (when vhdl-compile-use-local-error-regexp + (setq compilation-error-regexp-alist nil)) + ;; add VHDL compilers (mapcar (lambda (item) (push (car item) compilation-error-regexp-alist) @@ -16964,7 +17000,7 @@ specified by a target." (defun vhdl-generate-makefile () "Generate `Makefile'." (interactive) - (let* ((compiler (or (aget vhdl-compiler-alist vhdl-compiler) + (let* ((compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler) (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) (command (nth 4 compiler))) ;; generate makefile @@ -16997,15 +17033,19 @@ specified by a target." (vhdl-scan-directory-contents directory)))) (let* ((directory (abbreviate-file-name (vhdl-default-directory))) (project (vhdl-project-p)) - (ent-alist (aget vhdl-entity-alist (or project directory) t)) - (conf-alist (aget vhdl-config-alist (or project directory) t)) - (pack-alist (aget vhdl-package-alist (or project directory) t)) - (regexp-list (nth 12 (aget vhdl-compiler-alist vhdl-compiler))) - (ent-regexp (cons "\\(.*\\)" (nth 0 regexp-list))) - (arch-regexp (cons "\\(.*\\) \\(.*\\)" (nth 1 regexp-list))) - (conf-regexp (cons "\\(.*\\)" (nth 2 regexp-list))) - (pack-regexp (cons "\\(.*\\)" (nth 3 regexp-list))) - (pack-body-regexp (cons "\\(.*\\)" (nth 4 regexp-list))) + (ent-alist (vhdl-aget vhdl-entity-alist (or project directory))) + (conf-alist (vhdl-aget vhdl-config-alist (or project directory))) + (pack-alist (vhdl-aget vhdl-package-alist (or project directory))) + (regexp-list (or (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler)) + '("\\1.vhd" "\\2_\\1.vhd" "\\1.vhd" + "\\1.vhd" "\\1_body.vhd" identity))) + (mapping-exist + (if (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler)) t nil)) + (ent-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 0 regexp-list))) + (arch-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 1 regexp-list))) + (conf-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 2 regexp-list))) + (pack-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 3 regexp-list))) + (pack-body-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 4 regexp-list))) (adjust-case (nth 5 regexp-list)) (work-library (downcase (vhdl-work-library))) (compile-directory (expand-file-name (vhdl-compile-directory) @@ -17022,9 +17062,10 @@ specified by a target." ;; check prerequisites (unless (file-exists-p compile-directory) (make-directory compile-directory t)) - (unless regexp-list - (error "Please contact the VHDL Mode maintainer for support of \"%s\"" - vhdl-compiler)) + (unless mapping-exist + (vhdl-warning + (format "No unit-to-file name mapping found for compiler \"%s\".\n Directory of dummy files is created instead (to be used as dependencies).\n Please contact the VHDL Mode maintainer for full support of \"%s\"" + vhdl-compiler vhdl-compiler) t)) (message "Generating makefile \"%s\"..." makefile-name) ;; rules for all entities (setq tmp-list ent-alist) @@ -17038,13 +17079,15 @@ specified by a target." compile-directory)) arch-alist (nth 4 ent-entry) lib-alist (nth 6 ent-entry) - rule (aget rule-alist ent-file-name) + rule (vhdl-aget rule-alist ent-file-name) target-list (nth 0 rule) depend-list (nth 1 rule) second-list nil subcomp-list nil) (setq tmp-key (vhdl-replace-string - ent-regexp (funcall adjust-case ent-key))) + ent-regexp + (funcall adjust-case + (concat ent-key " " work-library)))) (push (cons ent-key tmp-key) unit-list) ;; rule target for this entity (push ent-key target-list) @@ -17053,7 +17096,7 @@ specified by a target." (setq depend-list (append depend-list pack-list)) (setq all-pack-list pack-list) ;; add rule - (aput 'rule-alist ent-file-name (list target-list depend-list)) + (vhdl-aput 'rule-alist ent-file-name (list target-list depend-list)) ;; rules for all corresponding architectures (while arch-alist (setq arch-entry (car arch-alist) @@ -17065,12 +17108,14 @@ specified by a target." compile-directory)) inst-alist (nth 4 arch-entry) lib-alist (nth 5 arch-entry) - rule (aget rule-alist arch-file-name) + rule (vhdl-aget rule-alist arch-file-name) target-list (nth 0 rule) depend-list (nth 1 rule)) (setq tmp-key (vhdl-replace-string arch-regexp - (funcall adjust-case (concat arch-key " " ent-key)))) + (funcall adjust-case + (concat arch-key " " ent-key " " + work-library)))) (setq unit-list (cons (cons ent-arch-key tmp-key) unit-list)) (push ent-arch-key second-list) @@ -17093,7 +17138,7 @@ specified by a target." (setq depend-list (append depend-list pack-list)) (setq all-pack-list (append all-pack-list pack-list)) ;; add rule - (aput 'rule-alist arch-file-name (list target-list depend-list)) + (vhdl-aput 'rule-alist arch-file-name (list target-list depend-list)) (setq arch-alist (cdr arch-alist))) (push (list ent-key second-list (append subcomp-list all-pack-list)) prim-list)) @@ -17112,12 +17157,14 @@ specified by a target." arch-key (nth 5 conf-entry) inst-alist (nth 6 conf-entry) lib-alist (nth 7 conf-entry) - rule (aget rule-alist conf-file-name) + rule (vhdl-aget rule-alist conf-file-name) target-list (nth 0 rule) depend-list (nth 1 rule) subcomp-list (list ent-key)) (setq tmp-key (vhdl-replace-string - conf-regexp (funcall adjust-case conf-key))) + conf-regexp + (funcall adjust-case + (concat conf-key " " work-library)))) (push (cons conf-key tmp-key) unit-list) ;; rule target for this configuration (push conf-key target-list) @@ -17131,20 +17178,17 @@ specified by a target." (while inst-alist (setq inst-entry (car inst-alist)) (setq inst-ent-key (nth 2 inst-entry) -; comp-arch-key (nth 2 inst-entry)) inst-conf-key (nth 4 inst-entry)) (when (equal (downcase (nth 5 inst-entry)) work-library) (when inst-ent-key (setq depend-list (cons inst-ent-key depend-list) subcomp-list (cons inst-ent-key subcomp-list))) -; (when comp-arch-key -; (push (concat comp-ent-key "-" comp-arch-key) depend-list)) (when inst-conf-key (setq depend-list (cons inst-conf-key depend-list) subcomp-list (cons inst-conf-key subcomp-list)))) (setq inst-alist (cdr inst-alist))) ;; add rule - (aput 'rule-alist conf-file-name (list target-list depend-list)) + (vhdl-aput 'rule-alist conf-file-name (list target-list depend-list)) (push (list conf-key nil (append subcomp-list pack-list)) prim-list) (setq conf-alist (cdr conf-alist))) (setq conf-alist tmp-list) @@ -17160,10 +17204,12 @@ specified by a target." (file-relative-name (nth 2 pack-entry) compile-directory)) lib-alist (nth 6 pack-entry) lib-body-alist (nth 10 pack-entry) - rule (aget rule-alist pack-file-name) + rule (vhdl-aget rule-alist pack-file-name) target-list (nth 0 rule) depend-list (nth 1 rule)) (setq tmp-key (vhdl-replace-string - pack-regexp (funcall adjust-case pack-key))) + pack-regexp + (funcall adjust-case + (concat pack-key " " work-library)))) (push (cons pack-key tmp-key) unit-list) ;; rule target for this package (push pack-key target-list) @@ -17172,7 +17218,7 @@ specified by a target." (setq depend-list (append depend-list pack-list)) (setq all-pack-list pack-list) ;; add rule - (aput 'rule-alist pack-file-name (list target-list depend-list)) + (vhdl-aput 'rule-alist pack-file-name (list target-list depend-list)) ;; rules for this package's body (when (nth 7 pack-entry) (setq pack-body-key (concat pack-key "-body") @@ -17180,11 +17226,13 @@ specified by a target." (nth 7 pack-entry) (file-relative-name (nth 7 pack-entry) compile-directory)) - rule (aget rule-alist pack-body-file-name) + rule (vhdl-aget rule-alist pack-body-file-name) target-list (nth 0 rule) depend-list (nth 1 rule)) (setq tmp-key (vhdl-replace-string - pack-body-regexp (funcall adjust-case pack-key))) + pack-body-regexp + (funcall adjust-case + (concat pack-key " " work-library)))) (setq unit-list (cons (cons pack-body-key tmp-key) unit-list)) ;; rule target for this package's body @@ -17196,8 +17244,8 @@ specified by a target." (setq depend-list (append depend-list pack-list)) (setq all-pack-list (append all-pack-list pack-list)) ;; add rule - (aput 'rule-alist pack-body-file-name - (list target-list depend-list))) + (vhdl-aput 'rule-alist pack-body-file-name + (list target-list depend-list))) (setq prim-list (cons (list pack-key (when pack-body-key (list pack-body-key)) all-pack-list) @@ -17205,8 +17253,8 @@ specified by a target." (setq pack-alist (cdr pack-alist))) (setq pack-alist tmp-list) ;; generate Makefile - (let* ((project (aget vhdl-project-alist project)) - (compiler (aget vhdl-compiler-alist vhdl-compiler)) + (let* ((project (vhdl-aget vhdl-project-alist project)) + (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler)) (compiler-id (nth 9 compiler)) (library-directory (vhdl-resolve-env-variable @@ -17259,12 +17307,16 @@ specified by a target." compile-directory)))) (insert "\n\n# Define library paths\n" "\nLIBRARY-" work-library " = " library-directory "\n") + (unless mapping-exist + (insert "LIBRARY-" work-library "-make = " "$(LIBRARY-" work-library + ")/make" "\n")) ;; insert variable definitions for all library unit files (insert "\n\n# Define library unit files\n") (setq tmp-list unit-list) (while unit-list (insert "\nUNIT-" work-library "-" (caar unit-list) - " = \\\n\t$(LIBRARY-" work-library ")/" (cdar unit-list)) + " = \\\n\t$(LIBRARY-" work-library + (if mapping-exist "" "-make") ")/" (cdar unit-list)) (setq unit-list (cdr unit-list))) ;; insert variable definition for list of all library unit files (insert "\n\n\n# Define list of all library unit files\n" @@ -17287,13 +17339,20 @@ specified by a target." ;; insert `make library' rule (insert "\n\n# Rule for creating library directory\n" "\n" (nth 2 vhdl-makefile-default-targets) " :" - " \\\n\t\t$(LIBRARY-" work-library ")\n" + " \\\n\t\t$(LIBRARY-" work-library ")" + (if mapping-exist "" + (concat " \\\n\t\t$(LIBRARY-" work-library "-make)\n")) + "\n" "\n$(LIBRARY-" work-library ") :" "\n\t" (vhdl-replace-string (cons "\\(.*\\)\n\\(.*\\)" (nth 5 compiler)) (concat "$(LIBRARY-" work-library ")\n" (vhdl-work-library))) "\n") + (unless mapping-exist + (insert "\n$(LIBRARY-" work-library "-make) :" + "\n\t" + "mkdir -p $(LIBRARY-" work-library "-make)\n")) ;; insert '.PHONY' declaration (insert "\n\n.PHONY : " (nth 0 vhdl-makefile-default-targets) " " @@ -17306,9 +17365,9 @@ specified by a target." (setq subcomp-list (sort (vhdl-uniquify (nth 2 (car prim-list))) 'string<)) (setq unit-key (caar prim-list) - unit-name (or (nth 0 (aget ent-alist unit-key t)) - (nth 0 (aget conf-alist unit-key t)) - (nth 0 (aget pack-alist unit-key t)))) + unit-name (or (nth 0 (vhdl-aget ent-alist unit-key)) + (nth 0 (vhdl-aget conf-alist unit-key)) + (nth 0 (vhdl-aget pack-alist unit-key)))) (insert "\n" unit-key) (unless (equal unit-key unit-name) (insert " \\\n" unit-name)) @@ -17358,13 +17417,15 @@ specified by a target." (nth 0 rule) (if (equal vhdl-compile-post-command "") "" " $(POST-COMPILE)") "\n") + (insert "\n")) + (unless (and options mapping-exist) (setq tmp-list target-list) (while target-list - (insert "\n\t@touch $(UNIT-" work-library "-" (car target-list) ")" - (if (cdr target-list) " \\" "\n")) + (insert "\t@touch $(UNIT-" work-library "-" (car target-list) ")\n") (setq target-list (cdr target-list))) (setq target-list tmp-list)) (setq rule-alist (cdr rule-alist))) + (insert "\n\n### " makefile-name " ends here\n") ;; run Makefile generation hook (run-hooks 'vhdl-makefile-generation-hook) @@ -17374,7 +17435,8 @@ specified by a target." (progn (save-buffer) (kill-buffer (current-buffer)) (set-buffer orig-buffer) - (add-to-history 'file-name-history makefile-path-name)) + (when (fboundp 'add-to-history) + (add-to-history 'file-name-history makefile-path-name))) (vhdl-warning-when-idle (format "File not writable: \"%s\"" (abbreviate-file-name makefile-path-name))) diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 62118578d98..81f3b8ff9b2 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -187,21 +187,20 @@ and you want to simplify them for the mode line which-func-unknown)))) ;;;###autoload (put 'which-func-current 'risky-local-variable t) -(defvar which-func-mode nil +(defvar-local which-func-mode nil "Non-nil means display current function name in mode line. This makes a difference only if `which-function-mode' is non-nil.") -(make-variable-buffer-local 'which-func-mode) -;;(put 'which-func-mode 'permanent-local t) (add-hook 'find-file-hook 'which-func-ff-hook t) (defun which-func-ff-hook () "File find hook for Which Function mode. It creates the Imenu index for the buffer, if necessary." - (setq which-func-mode - (and which-function-mode - (or (eq which-func-modes t) - (member major-mode which-func-modes)))) + (unless (local-variable-p 'which-func-mode) + (setq which-func-mode + (and which-function-mode + (or (eq which-func-modes t) + (member major-mode which-func-modes))))) (condition-case err (if (and which-func-mode @@ -259,15 +258,13 @@ in certain major modes." ;;Turn it on (progn (setq which-func-update-timer - (run-with-idle-timer idle-update-delay t 'which-func-update)) + (run-with-idle-timer idle-update-delay t #'which-func-update)) (dolist (buf (buffer-list)) (with-current-buffer buf - (setq which-func-mode - (or (eq which-func-modes t) - (member major-mode which-func-modes)))))) - ;; Turn it off - (dolist (buf (buffer-list)) - (with-current-buffer buf (setq which-func-mode nil))))) + (unless (local-variable-p 'which-func-mode) + (setq which-func-mode + (or (eq which-func-modes t) + (member major-mode which-func-modes))))))))) (defvar which-function-imenu-failed nil "Locally t in a buffer if `imenu--make-index-alist' found nothing there.") @@ -347,10 +344,11 @@ If no function name is found, return nil." (defvar ediff-window-B) (defvar ediff-window-C) +;; FIXME: Why does ediff require special support? (defun which-func-update-ediff-windows () "Update Which-Function mode display for Ediff windows. This function is meant to be called from `ediff-select-hook'." - (when (eq major-mode 'ediff-mode) + (when (and (derived-mode-p 'ediff-mode) which-function-mode) (when ediff-window-A (which-func-update-1 ediff-window-A)) (when ediff-window-B diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el new file mode 100644 index 00000000000..55405b63fe0 --- /dev/null +++ b/lisp/progmodes/xref.el @@ -0,0 +1,633 @@ +;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*- + +;; Copyright (C) 2014-2015 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file provides a somewhat generic infrastructure for cross +;; referencing commands, in particular "find-definition". +;; +;; Some part of the functionality must be implemented in a language +;; dependent way and that's done by defining `xref-find-function', +;; `xref-identifier-at-point-function' and +;; `xref-identifier-completion-table-function', which see. +;; +;; A major mode should make these variables buffer-local first. +;; +;; `xref-find-function' can be called in several ways, see its +;; description. It has to operate with "xref" and "location" values. +;; +;; One would usually call `make-xref' and `xref-make-file-location', +;; `xref-make-buffer-location' or `xref-make-bogus-location' to create +;; them. More generally, a location must be an instance of an EIEIO +;; class inheriting from `xref-location' and implementing +;; `xref-location-group' and `xref-location-marker'. +;; +;; Each identifier must be represented as a string. Implementers can +;; use string properties to store additional information about the +;; identifier, but they should keep in mind that values returned from +;; `xref-identifier-completion-table-function' should still be +;; distinct, because the user can't see the properties when making the +;; choice. +;; +;; See the functions `etags-xref-find' and `elisp-xref-find' for full +;; examples. + +;;; Code: + +(require 'cl-lib) +(require 'eieio) +(require 'ring) +(require 'pcase) + +(defgroup xref nil "Cross-referencing commands" + :group 'tools) + + +;;; Locations + +(defclass xref-location () () + :documentation "A location represents a position in a file or buffer.") + +;; If a backend decides to subclass xref-location it can provide +;; methods for some of the following functions: +(cl-defgeneric xref-location-marker (location) + "Return the marker for LOCATION.") + +(cl-defgeneric xref-location-group (location) + "Return a string used to group a set of locations. +This is typically the filename.") + +;;;; Commonly needed location classes are defined here: + +;; FIXME: might be useful to have an optional "hint" i.e. a string to +;; search for in case the line number is sightly out of date. +(defclass xref-file-location (xref-location) + ((file :type string :initarg :file) + (line :type fixnum :initarg :line) + (column :type fixnum :initarg :column)) + :documentation "A file location is a file/line/column triple. +Line numbers start from 1 and columns from 0.") + +(defun xref-make-file-location (file line column) + "Create and return a new xref-file-location." + (make-instance 'xref-file-location :file file :line line :column column)) + +(cl-defmethod xref-location-marker ((l xref-file-location)) + (with-slots (file line column) l + (with-current-buffer + (or (get-file-buffer file) + (let ((find-file-suppress-same-file-warnings t)) + (find-file-noselect file))) + (save-restriction + (widen) + (save-excursion + (goto-char (point-min)) + (beginning-of-line line) + (move-to-column column) + (point-marker)))))) + +(cl-defmethod xref-location-group ((l xref-file-location)) + (oref l :file)) + +(defclass xref-buffer-location (xref-location) + ((buffer :type buffer :initarg :buffer) + (position :type fixnum :initarg :position))) + +(defun xref-make-buffer-location (buffer position) + "Create and return a new xref-buffer-location." + (make-instance 'xref-buffer-location :buffer buffer :position position)) + +(cl-defmethod xref-location-marker ((l xref-buffer-location)) + (with-slots (buffer position) l + (let ((m (make-marker))) + (move-marker m position buffer)))) + +(cl-defmethod xref-location-group ((l xref-buffer-location)) + (with-slots (buffer) l + (or (buffer-file-name buffer) + (format "(buffer %s)" (buffer-name buffer))))) + +(defclass xref-bogus-location (xref-location) + ((message :type string :initarg :message + :reader xref-bogus-location-message)) + :documentation "Bogus locations are sometimes useful to +indicate errors, e.g. when we know that a function exists but the +actual location is not known.") + +(defun xref-make-bogus-location (message) + "Create and return a new xref-bogus-location." + (make-instance 'xref-bogus-location :message message)) + +(cl-defmethod xref-location-marker ((l xref-bogus-location)) + (user-error "%s" (oref l :message))) + +(cl-defmethod xref-location-group ((_ xref-bogus-location)) "(No location)") + +;; This should be in elisp-mode.el, but it's preloaded, and we can't +;; preload defclass and defmethod (at least, not yet). +(defclass xref-elisp-location (xref-location) + ((symbol :type symbol :initarg :symbol) + (type :type symbol :initarg :type) + (file :type string :initarg :file + :reader xref-location-group)) + :documentation "Location of an Emacs Lisp symbol definition.") + +(defun xref-make-elisp-location (symbol type file) + (make-instance 'xref-elisp-location :symbol symbol :type type :file file)) + +(cl-defmethod xref-location-marker ((l xref-elisp-location)) + (with-slots (symbol type file) l + (let ((buffer-point + (pcase type + (`defun (find-function-search-for-symbol symbol nil file)) + ((or `defvar `defface) + (find-function-search-for-symbol symbol type file)) + (`feature + (cons (find-file-noselect file) 1))))) + (with-current-buffer (car buffer-point) + (goto-char (or (cdr buffer-point) (point-min))) + (point-marker))))) + + +;;; Cross-reference + +(defclass xref--xref () + ((description :type string :initarg :description + :reader xref--xref-description) + (location :type xref-location :initarg :location + :reader xref--xref-location)) + :comment "An xref is used to display and locate constructs like +variables or functions.") + +(defun xref-make (description location) + "Create and return a new xref. +DESCRIPTION is a short string to describe the xref. +LOCATION is an `xref-location'." + (make-instance 'xref--xref :description description :location location)) + + +;;; API + +(declare-function etags-xref-find "etags" (action id)) +(declare-function tags-lazy-completion-table "etags" ()) + +;; For now, make the etags backend the default. +(defvar xref-find-function #'etags-xref-find + "Function to look for cross-references. +It can be called in several ways: + + (definitions IDENTIFIER): Find definitions of IDENTIFIER. The +result must be a list of xref objects. If no definitions can be +found, return nil. + + (references IDENTIFIER): Find references of IDENTIFIER. The +result must be a list of xref objects. If no references can be +found, return nil. + + (apropos PATTERN): Find all symbols that match PATTERN. PATTERN +is a regexp. + +IDENTIFIER can be any string returned by +`xref-identifier-at-point-function', or from the table returned +by `xref-identifier-completion-table-function'. + +To create an xref object, call `xref-make'.") + +(defvar xref-identifier-at-point-function #'xref-default-identifier-at-point + "Function to get the relevant identifier at point. + +The return value must be a string or nil. nil means no +identifier at point found. + +If it's hard to determine the identifier precisely (e.g., because +it's a method call on unknown type), the implementation can +return a simple string (such as symbol at point) marked with a +special text property which `xref-find-function' would recognize +and then delegate the work to an external process.") + +(defvar xref-identifier-completion-table-function #'tags-lazy-completion-table + "Function that returns the completion table for identifiers.") + +(defun xref-default-identifier-at-point () + (let ((thing (thing-at-point 'symbol))) + (and thing (substring-no-properties thing)))) + + +;;; misc utilities +(defun xref--alistify (list key test) + "Partition the elements of LIST into an alist. +KEY extracts the key from an element and TEST is used to compare +keys." + (let ((alist '())) + (dolist (e list) + (let* ((k (funcall key e)) + (probe (cl-assoc k alist :test test))) + (if probe + (setcdr probe (cons e (cdr probe))) + (push (cons k (list e)) alist)))) + ;; Put them back in order. + (cl-loop for (key . value) in (reverse alist) + collect (cons key (reverse value))))) + +(defun xref--insert-propertized (props &rest strings) + "Insert STRINGS with text properties PROPS." + (let ((start (point))) + (apply #'insert strings) + (add-text-properties start (point) props))) + +(defun xref--search-property (property &optional backward) + "Search the next text range where text property PROPERTY is non-nil. +Return the value of PROPERTY. If BACKWARD is non-nil, search +backward." + (let ((next (if backward + #'previous-single-char-property-change + #'next-single-char-property-change)) + (start (point)) + (value nil)) + (while (progn + (goto-char (funcall next (point) property)) + (not (or (setq value (get-text-property (point) property)) + (eobp) + (bobp))))) + (cond (value) + (t (goto-char start) nil)))) + + +;;; Marker stack (M-. pushes, M-, pops) + +(defcustom xref-marker-ring-length 16 + "Length of the xref marker ring." + :type 'integer + :version "25.1") + +(defvar xref--marker-ring (make-ring xref-marker-ring-length) + "Ring of markers to implement the marker stack.") + +(defun xref-push-marker-stack () + "Add point to the marker stack." + (ring-insert xref--marker-ring (point-marker))) + +;;;###autoload +(defun xref-pop-marker-stack () + "Pop back to where \\[xref-find-definitions] was last invoked." + (interactive) + (let ((ring xref--marker-ring)) + (when (ring-empty-p ring) + (error "Marker stack is empty")) + (let ((marker (ring-remove ring 0))) + (switch-to-buffer (or (marker-buffer marker) + (error "The marked buffer has been deleted"))) + (goto-char (marker-position marker)) + (set-marker marker nil nil)))) + +;; etags.el needs this +(defun xref-clear-marker-stack () + "Discard all markers from the marker stack." + (let ((ring xref--marker-ring)) + (while (not (ring-empty-p ring)) + (let ((marker (ring-remove ring))) + (set-marker marker nil nil))))) + +;;;###autoload +(defun xref-marker-stack-empty-p () + "Return t if the marker stack is empty; nil otherwise." + (ring-empty-p xref--marker-ring)) + + +(defun xref--goto-location (location) + "Set buffer and point according to xref-location LOCATION." + (let ((marker (xref-location-marker location))) + (set-buffer (marker-buffer marker)) + (cond ((and (<= (point-min) marker) (<= marker (point-max)))) + (widen-automatically (widen)) + (t (error "Location is outside accessible part of buffer"))) + (goto-char marker))) + +(defun xref--pop-to-location (location &optional window) + "Goto xref-location LOCATION and display the buffer. +WINDOW controls how the buffer is displayed: + nil -- switch-to-buffer + 'window -- pop-to-buffer (other window) + 'frame -- pop-to-buffer (other frame)" + (xref--goto-location location) + (cl-ecase window + ((nil) (switch-to-buffer (current-buffer))) + (window (pop-to-buffer (current-buffer) t)) + (frame (let ((pop-up-frames t)) (pop-to-buffer (current-buffer) t))))) + + +;;; XREF buffer (part of the UI) + +;; The xref buffer is used to display a set of xrefs. + +(defvar-local xref--display-history nil + "List of pairs (BUFFER . WINDOW), for temporarily displayed buffers.") + +(defvar-local xref--temporary-buffers nil + "List of buffers created by xref code.") + +(defvar-local xref--current nil + "Non-nil if this buffer was once current, except while displaying xrefs. +Used for temporary buffers.") + +(defvar xref--inhibit-mark-current nil) + +(defun xref--mark-selected () + (unless xref--inhibit-mark-current + (setq xref--current t)) + (remove-hook 'buffer-list-update-hook #'xref--mark-selected t)) + +(defun xref--save-to-history (buf win) + (let ((restore (window-parameter win 'quit-restore))) + ;; Save the new entry if the window displayed another buffer + ;; previously. + (when (and restore (not (eq (car restore) 'same))) + (push (cons buf win) xref--display-history)))) + +(defun xref--display-position (pos other-window recenter-arg xref-buf) + ;; Show the location, but don't hijack focus. + (with-selected-window (display-buffer (current-buffer) other-window) + (goto-char pos) + (recenter recenter-arg) + (let ((buf (current-buffer)) + (win (selected-window))) + (with-current-buffer xref-buf + (setq-local other-window-scroll-buffer buf) + (xref--save-to-history buf win))))) + +(defun xref--show-location (location) + (condition-case err + (let ((xref-buf (current-buffer)) + (bl (buffer-list)) + (xref--inhibit-mark-current t)) + (xref--goto-location location) + (let ((buf (current-buffer))) + (unless (memq buf bl) + ;; Newly created. + (add-hook 'buffer-list-update-hook #'xref--mark-selected nil t) + (with-current-buffer xref-buf + (push buf xref--temporary-buffers)))) + (xref--display-position (point) t 1 xref-buf)) + (user-error (message (error-message-string err))))) + +(defun xref-show-location-at-point () + "Display the source of xref at point in the other window, if any." + (interactive) + (let ((loc (xref--location-at-point))) + (when loc + (xref--show-location loc)))) + +(defun xref-next-line () + "Move to the next xref and display its source in the other window." + (interactive) + (xref--search-property 'xref-location) + (xref-show-location-at-point)) + +(defun xref-prev-line () + "Move to the previous xref and display its source in the other window." + (interactive) + (xref--search-property 'xref-location t) + (xref-show-location-at-point)) + +(defun xref--location-at-point () + (get-text-property (point) 'xref-location)) + +(defvar-local xref--window nil + "ACTION argument to call `display-buffer' with.") + +(defun xref-goto-xref () + "Jump to the xref on the current line and bury the xref buffer." + (interactive) + (back-to-indentation) + (let ((loc (or (xref--location-at-point) + (user-error "No reference at point"))) + (window xref--window)) + (xref-quit) + (xref--pop-to-location loc window))) + +(defvar xref--xref-buffer-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [remap quit-window] #'xref-quit) + (define-key map (kbd "n") #'xref-next-line) + (define-key map (kbd "p") #'xref-prev-line) + (define-key map (kbd "RET") #'xref-goto-xref) + (define-key map (kbd "C-o") #'xref-show-location-at-point) + ;; suggested by Johan Claesson "to further reduce finger movement": + (define-key map (kbd ".") #'xref-next-line) + (define-key map (kbd ",") #'xref-prev-line) + map)) + +(define-derived-mode xref--xref-buffer-mode special-mode "XREF" + "Mode for displaying cross-references." + (setq buffer-read-only t)) + +(defun xref-quit (&optional kill) + "Bury temporarily displayed buffers, then quit the current window. + +If KILL is non-nil, kill all buffers that were created in the +process of showing xrefs, and also kill the current buffer. + +The buffers that the user has otherwise interacted with in the +meantime are preserved." + (interactive "P") + (let ((window (selected-window)) + (history xref--display-history)) + (setq xref--display-history nil) + (pcase-dolist (`(,buf . ,win) history) + (when (and (window-live-p win) + (eq buf (window-buffer win))) + (quit-window nil win))) + (when kill + (let ((xref--inhibit-mark-current t) + kill-buffer-query-functions) + (dolist (buf xref--temporary-buffers) + (unless (buffer-local-value 'xref--current buf) + (kill-buffer buf))) + (setq xref--temporary-buffers nil))) + (quit-window kill window))) + +(defconst xref-buffer-name "*xref*" + "The name of the buffer to show xrefs.") + +(defvar xref--button-map + (let ((map (make-sparse-keymap))) + (define-key map [(control ?m)] #'xref-goto-xref) + (define-key map [mouse-1] #'xref-goto-xref) + (define-key map [mouse-2] #'xref--mouse-2) + map)) + +(defun xref--mouse-2 (event) + "Move point to the button and show the xref definition." + (interactive "e") + (mouse-set-point event) + (forward-line 0) + (xref--search-property 'xref-location) + (xref-show-location-at-point)) + +(defun xref--insert-xrefs (xref-alist) + "Insert XREF-ALIST in the current-buffer. +XREF-ALIST is of the form ((GROUP . (XREF ...)) ...). Where +GROUP is a string for decoration purposes and XREF is an +`xref--xref' object." + (cl-loop for ((group . xrefs) . more1) on xref-alist do + (xref--insert-propertized '(face bold) group "\n") + (cl-loop for (xref . more2) on xrefs do + (insert " ") + (with-slots (description location) xref + (xref--insert-propertized + (list 'xref-location location + 'face 'font-lock-keyword-face + 'mouse-face 'highlight + 'keymap xref--button-map + 'help-echo + (concat "mouse-2: display in another window, " + "RET or mouse-1: follow reference")) + description)) + (when (or more1 more2) + (insert "\n"))))) + +(defun xref--analyze (xrefs) + "Find common filenames in XREFS. +Return an alist of the form ((FILENAME . (XREF ...)) ...)." + (xref--alistify xrefs + (lambda (x) + (xref-location-group (xref--xref-location x))) + #'equal)) + +(defun xref--show-xref-buffer (xrefs alist) + (let ((xref-alist (xref--analyze xrefs))) + (with-current-buffer (get-buffer-create xref-buffer-name) + (let ((inhibit-read-only t)) + (erase-buffer) + (xref--insert-xrefs xref-alist) + (xref--xref-buffer-mode) + (pop-to-buffer (current-buffer)) + (goto-char (point-min)) + (setq xref--window (assoc-default 'window alist)) + (setq xref--temporary-buffers (assoc-default 'temporary-buffers alist)) + (dolist (buf xref--temporary-buffers) + (with-current-buffer buf + (add-hook 'buffer-list-update-hook #'xref--mark-selected nil t))) + (current-buffer))))) + + +;; This part of the UI seems fairly uncontroversial: it reads the +;; identifier and deals with the single definition case. +;; +;; The controversial multiple definitions case is handed off to +;; xref-show-xrefs-function. + +(defvar xref-show-xrefs-function 'xref--show-xref-buffer + "Function to display a list of xrefs.") + +(defvar xref--read-identifier-history nil) + +(defvar xref--read-pattern-history nil) + +(defun xref--show-xrefs (input kind arg window) + (let* ((bl (buffer-list)) + (xrefs (funcall xref-find-function kind arg)) + (tb (cl-set-difference (buffer-list) bl))) + (cond + ((null xrefs) + (user-error "No known %s for: %s" (symbol-name kind) input)) + ((not (cdr xrefs)) + (xref-push-marker-stack) + (xref--pop-to-location (xref--xref-location (car xrefs)) window)) + (t + (xref-push-marker-stack) + (funcall xref-show-xrefs-function xrefs + `((window . ,window) + (temporary-buffers . ,tb))))))) + +(defun xref--read-identifier (prompt) + "Return the identifier at point or read it from the minibuffer." + (let ((id (funcall xref-identifier-at-point-function))) + (cond ((or current-prefix-arg (not id)) + (completing-read prompt + (funcall xref-identifier-completion-table-function) + nil t id + 'xref--read-identifier-history)) + (t id)))) + + +;;; Commands + +(defun xref--find-definitions (id window) + (xref--show-xrefs id 'definitions id window)) + +;;;###autoload +(defun xref-find-definitions (identifier) + "Find the definition of the identifier at point. +With prefix argument or when there's no identifier at point, +prompt for it." + (interactive (list (xref--read-identifier "Find definitions of: "))) + (xref--find-definitions identifier nil)) + +;;;###autoload +(defun xref-find-definitions-other-window (identifier) + "Like `xref-find-definitions' but switch to the other window." + (interactive (list (xref--read-identifier "Find definitions of: "))) + (xref--find-definitions identifier 'window)) + +;;;###autoload +(defun xref-find-definitions-other-frame (identifier) + "Like `xref-find-definitions' but switch to the other frame." + (interactive (list (xref--read-identifier "Find definitions of: "))) + (xref--find-definitions identifier 'frame)) + +;;;###autoload +(defun xref-find-references (identifier) + "Find references to the identifier at point. +With prefix argument, prompt for the identifier." + (interactive (list (xref--read-identifier "Find references of: "))) + (xref--show-xrefs identifier 'references identifier nil)) + +(declare-function apropos-parse-pattern "apropos" (pattern)) + +;;;###autoload +(defun xref-find-apropos (pattern) + "Find all meaningful symbols that match PATTERN. +The argument has the same meaning as in `apropos'." + (interactive (list (read-from-minibuffer + "Search for pattern (word list or regexp): " + nil nil nil 'xref--read-pattern-history))) + (require 'apropos) + (xref--show-xrefs pattern 'apropos + (apropos-parse-pattern + (if (string-equal (regexp-quote pattern) pattern) + ;; Split into words + (or (split-string pattern "[ \t]+" t) + (user-error "No word list given")) + pattern)) + nil)) + + +;;; Key bindings + +;;;###autoload (define-key esc-map "." #'xref-find-definitions) +;;;###autoload (define-key esc-map "," #'xref-pop-marker-stack) +;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos) +;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window) +;;;###autoload (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame) + + +(provide 'xref) + +;;; xref.el ends here diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el index f0ba3d48515..d5243dac769 100644 --- a/lisp/progmodes/xscheme.el +++ b/lisp/progmodes/xscheme.el @@ -1,4 +1,4 @@ -;;; xscheme.el --- run MIT Scheme under Emacs +;;; xscheme.el --- run MIT Scheme under Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1986-1987, 1989-1990, 2001-2015 Free Software ;; Foundation, Inc. @@ -49,13 +49,13 @@ (defvar xscheme-expressions-ring-max 30 "Maximum length of Scheme expressions ring.") -(defvar xscheme-expressions-ring nil +(defvar-local xscheme-expressions-ring nil "List of expressions recently transmitted to the Scheme process.") -(defvar xscheme-expressions-ring-yank-pointer nil +(defvar-local xscheme-expressions-ring-yank-pointer nil "The tail of the Scheme expressions ring whose car is the last thing yanked.") -(defvar xscheme-running-p nil +(defvar-local xscheme-running-p nil "This variable, if nil, indicates that the scheme process is waiting for input. Otherwise, it is busy evaluating something.") @@ -64,7 +64,7 @@ waiting for input. Otherwise, it is busy evaluating something.") control-g interrupts were signaled. Do not allow more control-g's to be signaled until the scheme process acknowledges receipt.") -(defvar xscheme-control-g-disabled-p nil +(defvar-local xscheme-control-g-disabled-p nil "This variable, if non-nil, indicates that a control-g is being processed by the scheme process, so additional control-g's are to be ignored.") @@ -78,37 +78,26 @@ by the scheme process, so additional control-g's are to be ignored.") (defvar xscheme-runlight "") (defvar xscheme-runlight-string nil) -(defvar xscheme-process-filter-state 'idle +(defvar-local xscheme-process-filter-state 'idle "State of scheme process escape reader state machine: idle waiting for an escape sequence reading-type received an altmode but nothing else reading-string reading prompt string") -(defvar xscheme-allow-output-p t +(defvar-local xscheme-allow-output-p t "This variable, if nil, prevents output from the scheme process from being inserted into the process-buffer.") -(defvar xscheme-prompt "" +(defvar-local xscheme-prompt "" "The current scheme prompt string.") -(defvar xscheme-string-accumulator "" +(defvar-local xscheme-string-accumulator "" "Accumulator for the string being received from the scheme process.") -(defvar xscheme-mode-string nil) -(setq-default scheme-mode-line-process - '("" xscheme-runlight)) - -(mapc 'make-variable-buffer-local - '(xscheme-expressions-ring - xscheme-expressions-ring-yank-pointer - xscheme-process-filter-state - xscheme-running-p - xscheme-control-g-disabled-p - xscheme-allow-output-p - xscheme-prompt - xscheme-string-accumulator - xscheme-mode-string - scheme-mode-line-process)) +(defvar-local xscheme-mode-string nil) +(setq-default scheme-mode-line-process '("" xscheme-runlight)) +(make-variable-buffer-local 'scheme-mode-line-process) + (defgroup xscheme nil "Major mode for editing Scheme and interacting with MIT's C-Scheme." diff --git a/lisp/ps-print.el b/lisp/ps-print.el index eddd786e65f..0a2c214690f 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -3822,6 +3822,7 @@ If `ps-prefix-quote' is nil, it's set to t after generating string." (defun ps-get (alist-sym key) "Return element from association list ALIST-SYM which car is `eq' to KEY." + (declare (obsolete alist-get "25.1")) (assq key (symbol-value alist-sym))) @@ -3829,6 +3830,7 @@ If `ps-prefix-quote' is nil, it's set to t after generating string." "Store element (KEY . VALUE) into association list ALIST-SYM. If KEY already exists in ALIST-SYM, modify cdr to VALUE. It can be retrieved with `(ps-get ALIST-SYM KEY)'." + (declare (obsolete "use (setf (alist-get ..) ..) instead" "25.1")) (let ((elt: (assq key (symbol-value alist-sym)))) ; to avoid name conflict (if elt: (setcdr elt: value) @@ -3839,6 +3841,7 @@ It can be retrieved with `(ps-get ALIST-SYM KEY)'." (defun ps-del (alist-sym key) "Delete by side effect element KEY from association list ALIST-SYM." + (declare (obsolete "use (setf (alist-get k alist nil t) nil) instead" "25.1")) (let ((a:list: (symbol-value alist-sym)) ; to avoid name conflict old) (while a:list: diff --git a/lisp/ps-samp.el b/lisp/ps-samp.el index 5e40bf054d4..581ca366aa7 100644 --- a/lisp/ps-samp.el +++ b/lisp/ps-samp.el @@ -29,18 +29,7 @@ ;;; Commentary: -;; See ps-print.el for documentation. - -;;; Code: - - -(require 'ps-print) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Sample Setup Code: - - +;; Some example hacks for ps-print.el. ;; This stuff is for anybody that's brave enough to look this far, ;; and able to figure out how to use it. It isn't really part of ;; ps-print, but I'll leave it here in hopes it might be useful: @@ -48,20 +37,23 @@ ;; WARNING!!! The following code is *sample* code only. ;; Don't use it unless you understand what it does! -;; The key `f22' should probably be replaced by `print'. --Stef +;;; Code: -;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the -;; `ps-left-headers' specially for mail messages. -(defun ps-rmail-mode-hook () - (local-set-key [(f22)] 'ps-rmail-print-message-from-summary) - (setq ps-header-lines 3 - ps-left-header - ;; The left headers will display the message's subject, its - ;; author, and the name of the folder it was in. - '(ps-article-subject ps-article-author buffer-name))) +(require 'ps-print) + + -;; See `ps-gnus-print-article-from-summary'. This function does the -;; same thing for rmail. +;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set +;; `ps-left-header' specially for mail messages. +(defun ps-rmail-mode-hook () + (local-set-key [print] 'ps-rmail-print-message-from-summary) + (setq-local ps-header-lines 3) + ;; The left header will display the message's subject, its + ;; author, and the name of the folder it was in. + (setq-local ps-left-header + '(ps-article-subject ps-article-author buffer-name))) + +;; Like `ps-gnus-print-article-from-summary', but for rmail. (defun ps-rmail-print-message-from-summary () (interactive) (ps-print-message-from-summary 'rmail-summary-buffer "RMAIL")) @@ -76,61 +68,57 @@ (with-current-buffer ps-buf (ps-spool-buffer-with-faces))))) -;; Look in an article or mail message for the Subject: line. To be -;; placed in `ps-left-headers'. +;; Look in an article or mail message for the Subject: line. (defun ps-article-subject () (save-excursion - (goto-char (point-min)) - (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t) - (buffer-substring (match-beginning 1) (match-end 1)) - "Subject ???"))) + (save-restriction + (narrow-to-region (point-min) (progn (rfc822-goto-eoh) (point))) + (concat "Subject: " (or (mail-fetch-field "Subject") "???"))))) ;; Look in an article or mail message for the From: line. Sorta-kinda ;; understands RFC-822 addresses and can pull the real name out where -;; it's provided. To be placed in `ps-left-headers'. +;; it's provided. (defun ps-article-author () (save-excursion - (goto-char (point-min)) - (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t) - (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1)))) - (cond - - ;; Try first to match addresses that look like - ;; thompson@wg2.waii.com (Jim Thompson) - ((string-match ".*[ \t]+(\\(.*\\))" fromstring) - (substring fromstring (match-beginning 1) (match-end 1))) - - ;; Next try to match addresses that look like - ;; Jim Thompson <thompson@wg2.waii.com> or - ;; "Jim Thompson" <thompson@wg2.waii.com> - ((string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring) - (substring fromstring (match-beginning 2) (match-end 2))) - - ;; Couldn't find a real name -- show the address instead. - (t fromstring))) - "From ???"))) - -;; A hook to bind to `gnus-article-prepare-hook'. This will set the -;; `ps-left-headers' specially for gnus articles. Unfortunately, + (save-restriction + (narrow-to-region (point-min) (progn (rfc822-goto-eoh) (point))) + (let ((fromstring (mail-fetch-field "From"))) + (cond + ;; Try first to match addresses that look like + ;; thompson@wg2.waii.com (Jim Thompson) + ((and fromstring (string-match ".*[ \t]+(\\(.*\\))" fromstring)) + (match-string 1 fromstring)) + ;; Next try to match addresses that look like + ;; Jim Thompson <thompson@wg2.waii.com> or + ;; "Jim Thompson" <thompson@wg2.waii.com> + ((and fromstring + (string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring)) + (match-string 2 fromstring)) + ;; Couldn't find a real name -- show the address instead. + (fromstring) + (t "From ???")))))) + +;; A hook to bind to `gnus-article-prepare-hook'. This will set +;; `ps-left-header' specially for gnus articles. Unfortunately, ;; `gnus-article-mode-hook' is called only once, the first time the *Article* ;; buffer enters that mode, so it would only work for the first time ;; we ran gnus. The second time, this hook wouldn't get set up. The ;; only alternative is `gnus-article-prepare-hook'. (defun ps-gnus-article-prepare-hook () - (setq ps-header-lines 3 - ps-left-header - ;; The left headers will display the article's subject, its - ;; author, and the newsgroup it was in. - '(ps-article-subject ps-article-author gnus-newsgroup-name))) - -;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the -;; `ps-left-headers' specially for mail messages. + (setq-local ps-header-lines 3) + ;; The left headers will display the article's subject, its + ;; author, and the newsgroup it was in. + (setq-local ps-left-header + '(ps-article-subject ps-article-author gnus-newsgroup-name))) + +;; A hook to bind to `vm-mode-hook' to locally bind prsc and set +;; `ps-left-header' specially for mail messages. (defun ps-vm-mode-hook () - (local-set-key [(f22)] 'ps-vm-print-message-from-summary) - (setq ps-header-lines 3 - ps-left-header - ;; The left headers will display the message's subject, its - ;; author, and the name of the folder it was in. + (local-set-key [print] 'ps-vm-print-message-from-summary) + (setq-local ps-header-lines 3) + ;; The left headers will display the message's subject, its + ;; author, and the name of the folder it was in. + (setq-local ps-left-header '(ps-article-subject ps-article-author buffer-name))) ;; Every now and then I forget to switch from the *Summary* buffer to @@ -138,55 +126,43 @@ ;; article subjects shows up at the printer. This function, bound to ;; prsc for the gnus *Summary* buffer means I don't have to switch ;; buffers first. -;; sb: Updated for Gnus 5. (defun ps-gnus-print-article-from-summary () (interactive) (ps-print-message-from-summary 'gnus-article-buffer "*Article*")) -;; See `ps-gnus-print-article-from-summary'. This function does the -;; same thing for vm. +;; Like `ps-gnus-print-article-from-summary', but for vm. (defun ps-vm-print-message-from-summary () (interactive) (ps-print-message-from-summary 'vm-mail-buffer "")) -;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind -;; prsc. +;; A hook to bind to `gnus-summary-setup-buffer' to locally bind prsc. (defun ps-gnus-summary-setup () - (local-set-key [(f22)] 'ps-gnus-print-article-from-summary)) + (local-set-key [print] 'ps-gnus-print-article-from-summary)) -;; Look in an article or mail message for the Subject: line. To be -;; placed in `ps-left-headers'. (defun ps-info-file () (save-excursion (goto-char (point-min)) (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t) - (buffer-substring (match-beginning 1) (match-end 1)) + (match-string 1) "File ???"))) -;; Look in an article or mail message for the Subject: line. To be -;; placed in `ps-left-headers'. (defun ps-info-node () (save-excursion (goto-char (point-min)) (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t) - (buffer-substring (match-beginning 1) (match-end 1)) + (match-string 1) "Node ???"))) (defun ps-info-mode-hook () - (setq ps-left-header - ;; The left headers will display the node name and file name. - '(ps-info-node ps-info-file))) - -;; WARNING! The following function is a *sample* only, and is *not* -;; meant to be used as a whole unless you understand what the effects -;; will be! (In fact, this is a copy of Jim's setup for ps-print -- -;; I'd be very surprised if it was useful to *anybody*, without -;; modification.) - -(defun ps-jts-ps-setup () - (global-set-key [(f22)] 'ps-spool-buffer-with-faces) ;f22 is prsc - (global-set-key [(shift f22)] 'ps-spool-region-with-faces) - (global-set-key [(control f22)] 'ps-despool) + ;; The left headers will display the node name and file name. + (setq-local ps-left-header '(ps-info-node ps-info-file))) + +;; WARNING! The following function is a *sample* only, and is *not* meant +;; to be used as a whole unless you understand what the effects will be! +(defun ps-samp-ps-setup () + (global-set-key [print] 'ps-spool-buffer-with-faces) + (global-set-key [S-print] 'ps-spool-region-with-faces) + (global-set-key [C-print] 'ps-despool) (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook) (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup) (add-hook 'vm-mode-hook 'ps-vm-mode-hook) @@ -195,24 +171,10 @@ (setq ps-spool-duplex t ps-print-color-p nil ps-lpr-command "lpr" - ps-lpr-switches '("-Jjct,duplex_long")) - 'ps-jts-ps-setup) - -;; WARNING! The following function is a *sample* only, and is *not* -;; meant to be used as a whole unless it corresponds to your needs. -;; (In fact, this is a copy of Jack's setup for ps-print -- -;; I would not be that surprised if it was useful to *anybody*, -;; without modification.) - -(defun ps-jack-setup () - (setq ps-print-color-p nil - ps-lpr-command "lpr" - ps-lpr-switches nil - + ps-lpr-switches '("-Jjct,duplex_long") ps-paper-type 'a4 ps-landscape-mode t ps-number-of-columns 2 - ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm @@ -225,13 +187,11 @@ ps-header-lines 2 ps-show-n-of-n t ps-spool-duplex nil - ps-font-family 'Courier ps-font-size 5.5 ps-header-font-family 'Helvetica ps-header-font-size 6 - ps-header-title-font-size 8) - 'ps-jack-setup) + ps-header-title-font-size 8)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/lisp/rect.el b/lisp/rect.el index a60de916406..c5a548647f3 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -31,6 +31,13 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + +(defgroup rectangle nil + "Operations on rectangles." + :version "25.1" + :group 'editing) + ;; FIXME: this function should be replaced by `apply-on-rectangle' (defun operate-on-rectangle (function start end coerce-tabs) "Call FUNCTION for each line of rectangle with corners at START, END. @@ -42,42 +49,95 @@ FUNCTION is called with three arguments: number of columns that belong to rectangle but are before that position, number of columns that belong to rectangle but are after point. Point is at the end of the segment of this line within the rectangle." - (let (startcol startlinepos endcol endlinepos) - (save-excursion - (goto-char start) - (setq startcol (current-column)) - (beginning-of-line) - (setq startlinepos (point))) - (save-excursion - (goto-char end) - (setq endcol (current-column)) - (forward-line 1) - (setq endlinepos (point-marker))) - (if (< endcol startcol) - (setq startcol (prog1 endcol (setq endcol startcol)))) - (save-excursion - (goto-char startlinepos) - (while (< (point) endlinepos) - (let (startpos begextra endextra) - (if coerce-tabs - (move-to-column startcol t) - (move-to-column startcol)) - (setq begextra (- (current-column) startcol)) - (setq startpos (point)) - (if coerce-tabs - (move-to-column endcol t) - (move-to-column endcol)) - ;; If we overshot, move back one character - ;; so that endextra will be positive. - (if (and (not coerce-tabs) (> (current-column) endcol)) - (backward-char 1)) - (setq endextra (- endcol (current-column))) - (if (< begextra 0) - (setq endextra (+ endextra begextra) - begextra 0)) - (funcall function startpos begextra endextra)) - (forward-line 1))) - (- endcol startcol))) + (apply-on-rectangle + (lambda (startcol endcol) + (let (startpos begextra endextra) + (move-to-column startcol coerce-tabs) + (setq begextra (- (current-column) startcol)) + (setq startpos (point)) + (move-to-column endcol coerce-tabs) + ;; If we overshot, move back one character + ;; so that endextra will be positive. + (if (and (not coerce-tabs) (> (current-column) endcol)) + (backward-char 1)) + (setq endextra (- endcol (current-column))) + (if (< begextra 0) + (setq endextra (+ endextra begextra) + begextra 0)) + (funcall function startpos begextra endextra))) + start end)) + +;;; Crutches to let rectangle's corners be where point can't be +;; (e.g. in the middle of a TAB, or past the EOL). + +(defvar-local rectangle--mark-crutches nil + "(POS . COL) to override the column to use for the mark.") + +(defun rectangle--pos-cols (start end &optional window) + ;; At this stage, we don't know which of start/end is point/mark :-( + ;; And in case start=end, it might still be that point and mark have + ;; different crutches! + (let ((cw (window-parameter window 'rectangle--point-crutches))) + (cond + ((eq start (car cw)) + (let ((sc (cdr cw)) + (ec (if (eq end (car rectangle--mark-crutches)) + (cdr rectangle--mark-crutches) + (if rectangle--mark-crutches + (setq rectangle--mark-crutches nil)) + (goto-char end) (current-column)))) + (if (eq start end) (cons (min sc ec) (max sc ec)) (cons sc ec)))) + ((eq end (car cw)) + (if (eq start (car rectangle--mark-crutches)) + (cons (cdr rectangle--mark-crutches) (cdr cw)) + (if rectangle--mark-crutches (setq rectangle--mark-crutches nil)) + (cons (progn (goto-char start) (current-column)) (cdr cw)))) + ((progn + (if cw (setf (window-parameter nil 'rectangle--point-crutches) nil)) + (eq start (car rectangle--mark-crutches))) + (let ((sc (cdr rectangle--mark-crutches)) + (ec (progn (goto-char end) (current-column)))) + (if (eq start end) (cons (min sc ec) (max sc ec)) (cons sc ec)))) + ((eq end (car rectangle--mark-crutches)) + (cons (progn (goto-char start) (current-column)) + (cdr rectangle--mark-crutches))) + (t + (if rectangle--mark-crutches (setq rectangle--mark-crutches nil)) + (cons (progn (goto-char start) (current-column)) + (progn (goto-char end) (current-column))))))) + +(defun rectangle--col-pos (col kind) + (let ((c (move-to-column col))) + (if (= c col) + (if (eq kind 'point) + (if (window-parameter nil 'rectangle--point-crutches) + (setf (window-parameter nil 'rectangle--point-crutches) nil)) + (if rectangle--mark-crutches (setq rectangle--mark-crutches nil))) + ;; If move-to-column overshot, move back one char so we're + ;; at the position where rectangle--highlight-for-redisplay + ;; will add the overlay (so that the cursor can be drawn at the + ;; right place). + (when (> c col) (forward-char -1)) + (setf (if (eq kind 'point) + (window-parameter nil 'rectangle--point-crutches) + rectangle--mark-crutches) + (cons (point) col))))) + +(defun rectangle--point-col (pos) + (let ((pc (window-parameter nil 'rectangle--point-crutches))) + (if (eq pos (car pc)) (cdr pc) + (goto-char pos) + (current-column)))) + +(defun rectangle--crutches () + (cons rectangle--mark-crutches + (window-parameter nil 'rectangle--point-crutches))) +(defun rectangle--reset-crutches () + (kill-local-variable 'rectangle--mark-crutches) + (if (window-parameter nil 'rectangle--point-crutches) + (setf (window-parameter nil 'rectangle--point-crutches) nil))) + +;;; Rectangle operations. (defun apply-on-rectangle (function start end &rest args) "Call FUNCTION for each line of rectangle with corners at START, END. @@ -85,27 +145,27 @@ FUNCTION is called with two arguments: the start and end columns of the rectangle, plus ARGS extra arguments. Point is at the beginning of line when the function is called. The final point after the last operation will be returned." - (let (startcol startpt endcol endpt final-point) - (save-excursion - (goto-char start) - (setq startcol (current-column)) - (beginning-of-line) - (setq startpt (point)) - (goto-char end) - (setq endcol (current-column)) - (forward-line 1) - (setq endpt (point-marker)) - ;; ensure the start column is the left one. + (save-excursion + (let* ((cols (rectangle--pos-cols start end)) + (startcol (car cols)) + (endcol (cdr cols)) + (startpt (progn (goto-char start) (line-beginning-position))) + (endpt (progn (goto-char end) + (copy-marker (line-end-position)))) + final-point) + ;; Ensure the start column is the left one. (if (< endcol startcol) (let ((col startcol)) (setq startcol endcol endcol col))) - ;; start looping over lines + ;; Start looping over lines. (goto-char startpt) - (while (< (point) endpt) - (apply function startcol endcol args) - (setq final-point (point)) - (forward-line 1))) - final-point)) + (while + (progn + (apply function startcol endcol args) + (setq final-point (point)) + (and (zerop (forward-line 1)) (bolp) + (<= (point) endpt)))) + final-point))) (defun delete-rectangle-line (startcol endcol fill) (when (= (move-to-column startcol (if fill t 'coerce)) startcol) @@ -310,6 +370,67 @@ With a prefix (or a FILL) argument, also fill too short lines." (delete-rectangle-line startcol endcol nil)) (insert string)) +(defvar-local rectangle--string-preview-state nil) +(defvar-local rectangle--string-preview-window nil) + +(defun rectangle--string-flush-preview () + (mapc #'delete-overlay (nthcdr 3 rectangle--string-preview-state)) + (setf (nthcdr 3 rectangle--string-preview-state) nil)) + +(defun rectangle--string-erase-preview () + (with-selected-window rectangle--string-preview-window + (rectangle--string-flush-preview))) + +(defun rectangle--space-to (col) + (propertize " " 'display `(space :align-to ,col))) + +(defface rectangle-preview-face '((t :inherit region)) + "The face to use for the `string-rectangle' preview.") + +(defcustom rectangle-preview t + "If non-nil, `string-rectangle' will show an-the-fly preview." + :type 'boolean) + +(defun rectangle--string-preview () + (let ((str (minibuffer-contents))) + (when (equal str "") + (setq str (or (car-safe minibuffer-default) + (if (stringp minibuffer-default) minibuffer-default)))) + (when str (setq str (propertize str 'face 'region))) + (with-selected-window rectangle--string-preview-window + (unless (or (null rectangle--string-preview-state) + (equal str (car rectangle--string-preview-state))) + (rectangle--string-flush-preview) + (apply-on-rectangle + (lambda (startcol endcol) + (let* ((sc (move-to-column startcol)) + (start (if (<= sc startcol) (point) + (forward-char -1) + (setq sc (current-column)) + (point))) + (ec (move-to-column endcol)) + (end (point)) + (ol (make-overlay start end))) + (push ol (nthcdr 3 rectangle--string-preview-state)) + ;; FIXME: The extra spacing doesn't interact correctly with + ;; the extra spacing added by the rectangular-region-highlight. + (when (< sc startcol) + (overlay-put ol 'before-string (rectangle--space-to startcol))) + (let ((as (when (< endcol ec) + ;; (rectangle--space-to ec) + (spaces-string (- ec endcol)) + ))) + (if (= start end) + (overlay-put ol 'after-string (if as (concat str as) str)) + (overlay-put ol 'display str) + (if as (overlay-put ol 'after-string as)))))) + (nth 1 rectangle--string-preview-state) + (nth 2 rectangle--string-preview-state)))))) + +;; FIXME: Should this be turned into inhibit-region-highlight and made to apply +;; to non-rectangular regions as well? +(defvar rectangle--inhibit-region-highlight nil) + ;;;###autoload (defun string-rectangle (start end string) "Replace rectangle contents with STRING on each line. @@ -317,14 +438,31 @@ The length of STRING need not be the same as the rectangle width. Called from a program, takes three args; START, END and STRING." (interactive - (progn (barf-if-buffer-read-only) - (list - (region-beginning) - (region-end) + (progn + (make-local-variable 'rectangle--string-preview-state) + (make-local-variable 'rectangle--inhibit-region-highlight) + (let* ((buf (current-buffer)) + (win (if (eq (window-buffer) buf) (selected-window))) + (start (region-beginning)) + (end (region-end)) + (rectangle--string-preview-state `(nil ,start ,end)) + ;; Rectangle-region-highlighting doesn't work well in the presence + ;; of the preview overlays. We could work harder to try and make + ;; it work better, but it's easier to just disable it temporarily. + (rectangle--inhibit-region-highlight t)) + (barf-if-buffer-read-only) + (list start end + (minibuffer-with-setup-hook + (lambda () + (setq rectangle--string-preview-window win) + (add-hook 'minibuffer-exit-hook + #'rectangle--string-erase-preview nil t) + (add-hook 'post-command-hook + #'rectangle--string-preview nil t)) (read-string (format "String rectangle (default %s): " (or (car string-rectangle-history) "")) nil 'string-rectangle-history - (car string-rectangle-history))))) + (car string-rectangle-history))))))) (goto-char (apply-on-rectangle 'string-rectangle-line start end string t))) @@ -382,7 +520,7 @@ rectangle which were empty." (setq rectangle-number-line-counter (1+ rectangle-number-line-counter))) -(defun rectange--default-line-number-format (start end start-at) +(defun rectangle--default-line-number-format (start end start-at) (concat "%" (int-to-string (length (int-to-string (+ (count-lines start end) start-at)))) @@ -403,11 +541,11 @@ with a prefix argument, prompt for START-AT and FORMAT." (start-at (read-number "Number to count from: " 1))) (list start end start-at (read-string "Format string: " - (rectange--default-line-number-format + (rectangle--default-line-number-format start end start-at)))) (list (region-beginning) (region-end) 1 nil))) (unless format - (setq format (rectange--default-line-number-format start end start-at))) + (setq format (rectangle--default-line-number-format start end start-at))) (let ((rectangle-number-line-counter start-at)) (apply-on-rectangle 'rectangle-number-line-callback start end format))) @@ -429,8 +567,12 @@ with a prefix argument, prompt for START-AT and FORMAT." (let ((map (make-sparse-keymap))) (define-key map [?\C-o] 'open-rectangle) (define-key map [?\C-t] 'string-rectangle) - ;; (define-key map [remap open-line] 'open-rectangle) - ;; (define-key map [remap transpose-chars] 'string-rectangle) + (define-key map [remap exchange-point-and-mark] + 'rectangle-exchange-point-and-mark) + (dolist (cmd '(right-char left-char forward-char backward-char + next-line previous-line)) + (define-key map (vector 'remap cmd) + (intern (format "rectangle-%s" cmd)))) map) "Keymap used while marking a rectangular region.") @@ -439,6 +581,7 @@ with a prefix argument, prompt for START-AT and FORMAT." "Toggle the region as rectangular. Activates the region if needed. Only lasts until the region is deactivated." nil nil nil + (rectangle--reset-crutches) (when rectangle-mark-mode (add-hook 'deactivate-mark-hook (lambda () (rectangle-mark-mode -1))) @@ -447,6 +590,96 @@ Activates the region if needed. Only lasts until the region is deactivated." (activate-mark) (message "Mark set (rectangle mode)")))) +(defun rectangle-exchange-point-and-mark (&optional arg) + "Like `exchange-point-and-mark' but cycles through the rectangle's corners." + (interactive "P") + (if arg + (progn + (setq this-command 'exchange-point-and-mark) + (exchange-point-and-mark arg)) + (let* ((p (point)) + (repeat (eq this-command last-command)) + (m (mark)) + (p<m (< p m)) + (cols (if p<m (rectangle--pos-cols p m) (rectangle--pos-cols m p))) + (cp (if p<m (car cols) (cdr cols))) + (cm (if p<m (cdr cols) (car cols)))) + (if repeat (setq this-command 'exchange-point-and-mark)) + (rectangle--reset-crutches) + (goto-char p) + (rectangle--col-pos (if repeat cm cp) 'mark) + (set-mark (point)) + (goto-char m) + (rectangle--col-pos (if repeat cp cm) 'point)))) + +(defun rectangle--*-char (cmd n &optional other-cmd) + ;; Part of the complexity here is that I'm trying to avoid making assumptions + ;; about the L2R/R2L direction of text around point, but this is largely + ;; useless since the rectangles implemented in this file are "logical + ;; rectangles" and not "visual rectangles", so in the presence of + ;; bidirectional text things won't work well anyway. + (if (< n 0) (rectangle--*-char other-cmd (- n)) + (let ((col (rectangle--point-col (point)))) + (while (> n 0) + (let* ((bol (line-beginning-position)) + (eol (line-end-position)) + (curcol (current-column)) + (nextcol + (condition-case nil + (save-excursion + (funcall cmd 1) + (cond + ((> bol (point)) (- curcol 1)) + ((< eol (point)) (+ col (1+ n))) + (t (current-column)))) + (end-of-buffer (+ col (1+ n))) + (beginning-of-buffer (- curcol 1)))) + (diff (abs (- nextcol col)))) + (cond + ((and (< nextcol curcol) (< curcol col)) + (let ((curdiff (- col curcol))) + (if (<= curdiff n) + (progn (cl-decf n curdiff) (setq col curcol)) + (setq col (- col n) n 0)))) + ((< nextcol 0) (ding) (setq n 0 col 0)) ;Bumping into BOL! + ((= nextcol curcol) (funcall cmd 1)) + (t ;; (> nextcol curcol) + (if (<= diff n) + (progn (cl-decf n diff) (setq col nextcol)) + (setq col (if (< col nextcol) (+ col n) (- col n)) n 0)))))) + ;; FIXME: This rectangle--col-pos's move-to-column is wasted! + (rectangle--col-pos col 'point)))) + +(defun rectangle-right-char (&optional n) + "Like `right-char' but steps into wide chars and moves past EOL." + (interactive "p") (rectangle--*-char #'right-char n #'left-char)) +(defun rectangle-left-char (&optional n) + "Like `left-char' but steps into wide chars and moves past EOL." + (interactive "p") (rectangle--*-char #'left-char n #'right-char)) + +(defun rectangle-forward-char (&optional n) + "Like `forward-char' but steps into wide chars and moves past EOL." + (interactive "p") (rectangle--*-char #'forward-char n #'backward-char)) +(defun rectangle-backward-char (&optional n) + "Like `backward-char' but steps into wide chars and moves past EOL." + (interactive "p") (rectangle--*-char #'backward-char n #'forward-char)) + +(defun rectangle-next-line (&optional n) + "Like `next-line' but steps into wide chars and moves past EOL. +Ignores `line-move-visual'." + (interactive "p") + (let ((col (rectangle--point-col (point)))) + (forward-line n) + (rectangle--col-pos col 'point))) +(defun rectangle-previous-line (&optional n) + "Like `previous-line' but steps into wide chars and moves past EOL. +Ignores `line-move-visual'." + (interactive "p") + (let ((col (rectangle--point-col (point)))) + (forward-line (- n)) + (rectangle--col-pos col 'point))) + + (defun rectangle--extract-region (orig &optional delete) (if (not rectangle-mark-mode) (funcall orig delete) @@ -476,100 +709,118 @@ Activates the region if needed. Only lasts until the region is deactivated." (while (not (eq pending-undo-list (cdr undo-at-start))) (undo-more 1)))))) +(defun rectangle--place-cursor (leftcol left str) + (let ((pc (window-parameter nil 'rectangle--point-crutches))) + (if (and (eq left (car pc)) (eq leftcol (cdr pc))) + (put-text-property 0 1 'cursor 1 str)))) + (defun rectangle--highlight-for-redisplay (orig start end window rol) (cond ((not rectangle-mark-mode) (funcall orig start end window rol)) + (rectangle--inhibit-region-highlight + (funcall redisplay-unhighlight-region-function rol) + nil) ((and (eq 'rectangle (car-safe rol)) (eq (nth 1 rol) (buffer-chars-modified-tick)) (eq start (nth 2 rol)) - (eq end (nth 3 rol))) + (eq end (nth 3 rol)) + (equal (rectangle--crutches) (nth 4 rol))) rol) (t (save-excursion (let* ((nrol nil) (old (if (eq 'rectangle (car-safe rol)) - (nthcdr 4 rol) + (nthcdr 5 rol) (funcall redisplay-unhighlight-region-function rol) - nil)) - (ptcol (progn (goto-char start) (current-column))) - (markcol (progn (goto-char end) (current-column))) - (leftcol (min ptcol markcol)) - (rightcol (max ptcol markcol))) - (goto-char start) - (while - (let* ((mleft (move-to-column leftcol)) - (left (point)) - (mright (move-to-column rightcol)) - (right (point)) - (ol - (if (not old) - (let ((ol (make-overlay left right))) - (overlay-put ol 'window window) - (overlay-put ol 'face 'region) - ol) - (let ((ol (pop old))) - (move-overlay ol left right (current-buffer)) - ol)))) - ;; `move-to-column' may stop before the column (if bumping into - ;; EOL) or overshoot it a little, when column is in the middle - ;; of a char. - (cond - ((< mleft leftcol) ;`leftcol' is past EOL. - (overlay-put ol 'before-string - (spaces-string (- leftcol mleft))) - (setq mright (max mright leftcol))) - ((and (> mleft leftcol) ;`leftcol' is in the middle of a char. - (eq (char-before left) ?\t)) - (setq left (1- left)) - (move-overlay ol left right) - (goto-char left) - (overlay-put ol 'before-string - (spaces-string (- leftcol (current-column))))) - ((overlay-get ol 'before-string) - (overlay-put ol 'before-string nil))) - (cond - ((< mright rightcol) ;`rightcol' is past EOL. - (let ((str (make-string (- rightcol mright) ?\s))) - (put-text-property 0 (length str) 'face 'region str) - ;; If cursor happens to be here, draw it *before* rather than - ;; after this highlighted pseudo-text. - (put-text-property 0 1 'cursor t str) - (overlay-put ol 'after-string str))) - ((and (> mright rightcol) ;`rightcol's in the middle of a char. - (eq (char-before right) ?\t)) - (setq right (1- right)) - (move-overlay ol left right) - (if (= rightcol leftcol) - (overlay-put ol 'after-string nil) - (goto-char right) - (let ((str (make-string - (- rightcol (max leftcol (current-column))) - ?\s))) - (put-text-property 0 (length str) 'face 'region str) - (when (= left right) - ;; If cursor happens to be here, draw it *before* rather - ;; than after this highlighted pseudo-text. - (put-text-property 0 1 'cursor 1 str)) - (overlay-put ol 'after-string str)))) - ((overlay-get ol 'after-string) - (overlay-put ol 'after-string nil))) - (when (and (= leftcol rightcol) (display-graphic-p)) - ;; Make zero-width rectangles visible! - (overlay-put ol 'after-string - (concat (propertize " " - 'face '(region (:height 0.2))) - (overlay-get ol 'after-string)))) - (push ol nrol) - (and (zerop (forward-line 1)) - (<= (point) end)))) + nil))) + (cl-assert (eq (window-buffer window) (current-buffer))) + ;; `rectangle--pos-cols' looks up the `selected-window's parameter! + (with-selected-window window + (apply-on-rectangle + (lambda (leftcol rightcol) + (let* ((mleft (move-to-column leftcol)) + (left (point)) + ;; BEWARE: In the presence of other overlays with + ;; before/after/display-strings, this happens to move to + ;; the column "as if the overlays were not applied", which + ;; is sometimes what we want, tho it can be + ;; considered a bug in move-to-column (it should arguably + ;; pay attention to the before/after-string/display + ;; properties when computing the column). + (mright (move-to-column rightcol)) + (right (point)) + (ol + (if (not old) + (let ((ol (make-overlay left right))) + (overlay-put ol 'window window) + (overlay-put ol 'face 'region) + ol) + (let ((ol (pop old))) + (move-overlay ol left right (current-buffer)) + ol)))) + ;; `move-to-column' may stop before the column (if bumping into + ;; EOL) or overshoot it a little, when column is in the middle + ;; of a char. + (cond + ((< mleft leftcol) ;`leftcol' is past EOL. + (overlay-put ol 'before-string (rectangle--space-to leftcol)) + (setq mright (max mright leftcol))) + ((and (> mleft leftcol) ;`leftcol' is in the middle of a char. + (eq (char-before left) ?\t)) + (setq left (1- left)) + (move-overlay ol left right) + (goto-char left) + (overlay-put ol 'before-string (rectangle--space-to leftcol))) + ((overlay-get ol 'before-string) + (overlay-put ol 'before-string nil))) + (cond + ;; While doing rectangle--string-preview, the two sets of + ;; overlays steps on the other's toes. I fixed some of the + ;; problems, but others remain. The main one is the two + ;; (rectangle--space-to rightcol) below which try to virtually + ;; insert missing text, but during "preview", the text is not + ;; missing (it's provided by preview's own overlay). + (rectangle--string-preview-state + (if (overlay-get ol 'after-string) + (overlay-put ol 'after-string nil))) + ((< mright rightcol) ;`rightcol' is past EOL. + (let ((str (rectangle--space-to rightcol))) + (put-text-property 0 (length str) 'face 'region str) + ;; If cursor happens to be here, draw it at the right place. + (rectangle--place-cursor leftcol left str) + (overlay-put ol 'after-string str))) + ((and (> mright rightcol) ;`rightcol's in the middle of a char. + (eq (char-before right) ?\t)) + (setq right (1- right)) + (move-overlay ol left right) + (if (= rightcol leftcol) + (overlay-put ol 'after-string nil) + (goto-char right) + (let ((str (rectangle--space-to rightcol))) + (put-text-property 0 (length str) 'face 'region str) + (when (= left right) + (rectangle--place-cursor leftcol left str)) + (overlay-put ol 'after-string str)))) + ((overlay-get ol 'after-string) + (overlay-put ol 'after-string nil))) + (when (and (= leftcol rightcol) (display-graphic-p)) + ;; Make zero-width rectangles visible! + (overlay-put ol 'after-string + (concat (propertize " " + 'face '(region (:height 0.2))) + (overlay-get ol 'after-string)))) + (push ol nrol))) + start end)) (mapc #'delete-overlay old) - `(rectangle ,(buffer-chars-modified-tick) ,start ,end ,@nrol)))))) + `(rectangle ,(buffer-chars-modified-tick) + ,start ,end ,(rectangle--crutches) + ,@nrol)))))) (defun rectangle--unhighlight-for-redisplay (orig rol) (if (not (eq 'rectangle (car-safe rol))) (funcall orig rol) - (mapc #'delete-overlay (nthcdr 4 rol)) + (mapc #'delete-overlay (nthcdr 5 rol)) (setcar (cdr rol) nil))) (provide 'rect) diff --git a/lisp/register.el b/lisp/register.el index b8fe613f921..a60181e43c6 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -27,12 +27,14 @@ ;; This package of functions emulates and somewhat extends the venerable ;; TECO's `register' feature, which permits you to save various useful ;; pieces of buffer state to named variables. The entry points are -;; documented in the Emacs user's manual. +;; documented in the Emacs user's manual: (info "(emacs) Registers"). (eval-when-compile (require 'cl-lib)) ;;; Code: +;; FIXME: Clean up namespace usage! + (cl-defstruct (registerv (:constructor nil) (:constructor registerv--make (&optional data print-func @@ -98,16 +100,12 @@ If nil, do not show register previews, unless `help-char' (or a member of (defun get-register (register) "Return contents of Emacs register named REGISTER, or nil if none." - (cdr (assq register register-alist))) + (alist-get register register-alist)) (defun set-register (register value) "Set contents of Emacs register named REGISTER to VALUE. Returns VALUE. See the documentation of the variable `register-alist' for possible VALUEs." - (let ((aelt (assq register register-alist))) - (if aelt - (setcdr aelt value) - (push (cons register value) register-alist)) - value)) + (setf (alist-get register register-alist) value)) (defun register-describe-oneline (c) "One-line description of register C." @@ -137,7 +135,8 @@ Format of each entry is controlled by the variable `register-preview-function'." (with-current-buffer-window buffer (cons 'display-buffer-below-selected - '((window-height . fit-window-to-buffer))) + '((window-height . fit-window-to-buffer) + (preserve-size . (nil . t)))) nil (with-current-buffer standard-output (setq cursor-in-non-selected-windows nil) @@ -161,7 +160,7 @@ display such a window regardless." collect c))) (unwind-protect (progn - (while (memq (read-event (propertize prompt 'face 'minibuffer-prompt)) + (while (memq (read-key (propertize prompt 'face 'minibuffer-prompt)) help-chars) (unless (get-buffer-window buffer) (register-preview buffer 'show-empty))) @@ -425,13 +424,14 @@ Interactively, reads the register using `register-read-with-preview'." "Insert contents of register REGISTER. (REGISTER is a character.) Normally puts point before and mark after the inserted text. If optional second arg is non-nil, puts mark before and point after. -Interactively, second arg is non-nil if prefix arg is supplied. +Interactively, second arg is nil if prefix arg is supplied and t +otherwise. Interactively, reads the register using `register-read-with-preview'." (interactive (progn (barf-if-buffer-read-only) (list (register-read-with-preview "Insert register: ") - current-prefix-arg))) + (not current-prefix-arg)))) (push-mark) (let ((val (get-register register))) (cond diff --git a/lisp/replace.el b/lisp/replace.el index 72dbf0c588b..e0636e0728c 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -56,8 +56,8 @@ See `query-replace-from-history-variable' and (defvar query-replace-defaults nil "Default values of FROM-STRING and TO-STRING for `query-replace'. -This is a cons cell (FROM-STRING . TO-STRING), or nil if there is -no default value.") +This is a list of cons cells (FROM-STRING . TO-STRING), or nil +if there are no default values.") (defvar query-replace-interactive nil "Non-nil means `query-replace' uses the last search string. @@ -67,6 +67,19 @@ That becomes the \"string to replace\".") to the minibuffer that reads the string to replace, or invoke replacements from Isearch by using a key sequence like `C-s C-s M-%'." "24.3") +(defcustom query-replace-from-to-separator + (propertize + (or (ignore-errors + ;; Ignore errors when attempt to autoload char-displayable-p + ;; fails while preparing to dump. + (if (char-displayable-p ?\u2192) " \u2192 " " -> ")) + " -> ") + 'face 'minibuffer-prompt) + "String that separates FROM and TO in the history of replacement pairs." + :group 'matching + :type 'sexp + :version "25.1") + (defcustom query-replace-from-history-variable 'query-replace-history "History list to use for the FROM argument of `query-replace' commands. The value of this variable should be a symbol; that symbol @@ -131,12 +144,28 @@ The return value can also be a pair (FROM . TO) indicating that the user wants to replace FROM with TO." (if query-replace-interactive (car (if regexp-flag regexp-search-ring search-ring)) + ;; Reevaluating will check char-displayable-p that is + ;; unavailable while preparing to dump. + (custom-reevaluate-setting 'query-replace-from-to-separator) (let* ((history-add-new-input nil) + (separator + (when query-replace-from-to-separator + (propertize "\0" + 'display query-replace-from-to-separator + 'separator t))) + (query-replace-from-to-history + (append + (when separator + (mapcar (lambda (from-to) + (concat (query-replace-descr (car from-to)) + separator + (query-replace-descr (cdr from-to)))) + query-replace-defaults)) + (symbol-value query-replace-from-history-variable))) + (minibuffer-allow-text-properties t) ; separator uses text-properties (prompt - (if query-replace-defaults - (format "%s (default %s -> %s): " prompt - (query-replace-descr (car query-replace-defaults)) - (query-replace-descr (cdr query-replace-defaults))) + (if (and query-replace-defaults separator) + (format "%s (default %s): " prompt (car query-replace-from-to-history)) (format "%s: " prompt))) (from ;; The save-excursion here is in case the user marks and copies @@ -144,26 +173,35 @@ wants to replace FROM with TO." ;; That should not clobber the region for the query-replace itself. (save-excursion (if regexp-flag - (read-regexp prompt nil query-replace-from-history-variable) + (read-regexp prompt nil 'query-replace-from-to-history) (read-from-minibuffer - prompt nil nil nil query-replace-from-history-variable + prompt nil nil nil 'query-replace-from-to-history (car (if regexp-flag regexp-search-ring search-ring)) t))))) (if (and (zerop (length from)) query-replace-defaults) - (cons (car query-replace-defaults) + (cons (caar query-replace-defaults) (query-replace-compile-replacement - (cdr query-replace-defaults) regexp-flag)) - (add-to-history query-replace-from-history-variable from nil t) - ;; Warn if user types \n or \t, but don't reject the input. - (and regexp-flag - (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from) - (let ((match (match-string 3 from))) - (cond - ((string= match "\\n") - (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead")) - ((string= match "\\t") - (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB"))) - (sit-for 2))) - from)))) + (cdar query-replace-defaults) regexp-flag)) + (let* ((to (if (and (string-match separator from) + (get-text-property (match-beginning 0) 'separator from)) + (substring-no-properties from (match-end 0)))) + (from (if to (substring-no-properties from 0 (match-beginning 0)) + (substring-no-properties from)))) + (add-to-history query-replace-from-history-variable from nil t) + ;; Warn if user types \n or \t, but don't reject the input. + (and regexp-flag + (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from) + (let ((match (match-string 3 from))) + (cond + ((string= match "\\n") + (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead")) + ((string= match "\\t") + (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB"))) + (sit-for 2))) + (if (not to) + from + (add-to-history query-replace-to-history-variable to nil t) + (add-to-history 'query-replace-defaults (cons from to) nil t) + (cons from (query-replace-compile-replacement to regexp-flag)))))))) (defun query-replace-compile-replacement (to regexp-flag) "Maybe convert a regexp replacement TO to Lisp. @@ -216,7 +254,7 @@ the original string if not." nil nil nil query-replace-to-history-variable from t))) (add-to-history query-replace-to-history-variable to nil t) - (setq query-replace-defaults (cons from to)) + (add-to-history 'query-replace-defaults (cons from to) nil t) to)) regexp-flag)) @@ -266,7 +304,7 @@ replace backward. Fourth and fifth arg START and END specify the region to operate on. -To customize possible responses, change the \"bindings\" in `query-replace-map'." +To customize possible responses, change the bindings in `query-replace-map'." (interactive (let ((common (query-replace-read-args @@ -421,7 +459,7 @@ for Lisp calls." "22.1")) ;; Let-bind the history var to disable the "foo -> bar" ;; default. Maybe we shouldn't disable this default, but ;; for now I'll leave it off. --Stef - (let ((query-replace-to-history-variable nil)) + (let ((query-replace-defaults nil)) (query-replace-read-from "Query replace regexp" t))) (to (list (read-from-minibuffer (format "Query replace regexp %s with eval: " @@ -523,6 +561,8 @@ What you probably want is a loop like this: which will run faster and will not set the mark or print anything. \(You may need a more complex loop if FROM-STRING can match the null string and TO-STRING is also null.)" + (declare (interactive-only + "use `search-forward' and `replace-match' instead.")) (interactive (let ((common (query-replace-read-args @@ -540,8 +580,6 @@ and TO-STRING is also null.)" (region-end)) (nth 3 common)))) (perform-replace from-string to-string nil nil delimited nil nil start end backward)) -(put 'replace-string 'interactive-only - "use `search-forward' and `replace-match' instead.") (defun replace-regexp (regexp to-string &optional delimited start end backward) "Replace things after point matching REGEXP with TO-STRING. @@ -597,6 +635,8 @@ What you probably want is a loop like this: (while (re-search-forward REGEXP nil t) (replace-match TO-STRING nil nil)) which will run faster and will not set the mark or print anything." + (declare (interactive-only + "use `re-search-forward' and `replace-match' instead.")) (interactive (let ((common (query-replace-read-args @@ -614,8 +654,6 @@ which will run faster and will not set the mark or print anything." (region-end)) (nth 3 common)))) (perform-replace regexp to-string nil t delimited nil nil start end backward)) -(put 'replace-regexp 'interactive-only - "use `re-search-forward' and `replace-match' instead.") (defvar regexp-history nil diff --git a/lisp/reveal.el b/lisp/reveal.el index 3e7952fb894..b71df964aec 100644 --- a/lisp/reveal.el +++ b/lisp/reveal.el @@ -83,7 +83,8 @@ Each element has the form (WINDOW . OVERLAY).") (cond ((eq (car x) (selected-window)) (cdr x)) ((not (and (window-live-p (car x)) - (eq (window-buffer (car x)) (current-buffer)))) + (eq (window-buffer (car x)) + (current-buffer)))) ;; Adopt this since it's owned by a window that's ;; either not live or at least not showing this ;; buffer any more. @@ -135,8 +136,9 @@ Each element has the form (WINDOW . OVERLAY).") old-ols) (defun reveal-close-old-overlays (old-ols) - (if (not (eq reveal-last-tick - (setq reveal-last-tick (buffer-modified-tick)))) + (if (or track-mouse ;Don't close in the middle of a click. + (not (eq reveal-last-tick + (setq reveal-last-tick (buffer-modified-tick))))) ;; The buffer was modified since last command: let's refrain from ;; closing any overlay because it tends to behave poorly when ;; inserting text at the end of an overlay (basically the overlay diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index f863eea9137..f0b012ed2f1 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -306,7 +306,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or "Return a column number relative to the selected window. N is a column number relative to selected frame." (- n - (car (window-edges)) (or (car (window-margins)) 0) (fringe-columns 'left) (scroll-bar-columns 'left))) @@ -321,7 +320,7 @@ START-EVENT is the mouse click event." (when (eq start end) ;; mouse click (save-selected-window (select-window (posn-window start)) - (setq col (- (car (posn-col-row start)) (car (window-edges)) + (setq col (- (car (posn-col-row start)) (scroll-bar-columns 'left)) w (- (ruler-mode-full-window-width) (scroll-bar-columns 'left) @@ -343,7 +342,7 @@ START-EVENT is the mouse click event." (when (eq start end) ;; mouse click (save-selected-window (select-window (posn-window start)) - (setq col (- (car (posn-col-row start)) (car (window-edges)) + (setq col (- (car (posn-col-row start)) (scroll-bar-columns 'left)) w (- (ruler-mode-full-window-width) (scroll-bar-columns 'left) diff --git a/lisp/savehist.el b/lisp/savehist.el index 00dac4b578a..692ee2e586f 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -278,13 +278,6 @@ If AUTO-SAVE is non-nil, compare the saved contents to the one last saved, (print-level nil) (print-readably t) (print-quoted t)) - ;; During the 24.3 development, read-passwd had a bug which resulted in - ;; the passwords being saved by savehist. Trim them, retroactively. - ;; This code can be removed after the 24.3 release. - (dolist (sym savehist-minibuffer-history-variables) - (if (and (symbolp sym) (equal (symbol-name sym) "forget-history")) - (setq savehist-minibuffer-history-variables - (delq sym savehist-minibuffer-history-variables)))) ;; Save the minibuffer histories, along with the value of ;; savehist-minibuffer-history-variables itself. (when savehist-save-minibuffer-history diff --git a/lisp/saveplace.el b/lisp/saveplace.el index b77cc7f293e..4c53632affd 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el @@ -138,6 +138,8 @@ disabled, i.e., the position is recorded for all files." :version "24.1" :type 'regexp :group 'save-place) +(declare-function dired-current-directory "dired" (&optional localp)) + (defun toggle-save-place (&optional parg) "Toggle whether to save your place in this file between sessions. If this mode is enabled, point is recorded when you kill the buffer @@ -153,7 +155,7 @@ file: \(setq-default save-place t)" (interactive "P") (if (not (or buffer-file-name (and (derived-mode-p 'dired-mode) - dired-directory))) + (dired-current-directory)))) (message "Buffer `%s' not visiting a file or directory" (buffer-name)) (setq save-place (if parg (> (prefix-numeric-value parg) 0) @@ -172,12 +174,13 @@ file: ;; file. If not, do so, then feel free to modify the alist. It ;; will be saved again when Emacs is killed. (or save-place-loaded (load-save-place-alist-from-file)) - (let ((item (or buffer-file-name - (and (derived-mode-p 'dired-mode) - dired-directory - (expand-file-name (if (consp dired-directory) - (car dired-directory) - dired-directory)))))) + (let* ((directory (and (derived-mode-p 'dired-mode) + (dired-current-directory))) + (item (or buffer-file-name + (and directory + (expand-file-name (if (consp directory) + (car directory) + directory)))))) (when (and item (or (not save-place-ignore-files-regexp) (not (string-match save-place-ignore-files-regexp @@ -186,8 +189,7 @@ file: (position (cond ((eq major-mode 'hexl-mode) (with-no-warnings (1+ (hexl-current-address)))) - ((and (derived-mode-p 'dired-mode) - dired-directory) + ((and (derived-mode-p 'dired-mode) directory) (let ((filename (dired-get-filename nil t))) (if filename `((dired-filename . ,filename)) @@ -305,7 +307,7 @@ may have changed) back to `save-place-alist'." ;; save-place checks buffer-file-name too, but we can avoid ;; overhead of function call by checking here too. (and (or buffer-file-name (and (derived-mode-p 'dired-mode) - dired-directory)) + (dired-current-directory))) (save-place-to-alist)) (setq buf-list (cdr buf-list)))))) @@ -325,19 +327,21 @@ may have changed) back to `save-place-alist'." (defun save-place-dired-hook () "Position the point in a Dired buffer." (or save-place-loaded (load-save-place-alist-from-file)) - (let ((cell (assoc (and (derived-mode-p 'dired-mode) - dired-directory - (expand-file-name (if (consp dired-directory) - (car dired-directory) - dired-directory))) - save-place-alist))) + (let* ((directory (and (derived-mode-p 'dired-mode) + (dired-current-directory))) + (cell (assoc (and directory + (expand-file-name (if (consp directory) + (car directory) + directory))) + save-place-alist))) (if cell (progn (or revert-buffer-in-progress-p - (if (integerp (cdr cell)) - (goto-char (cdr cell)) - (and (assq 'dired-filename (cdr cell)) - (dired-goto-file (cdr (assq 'dired-filename (cdr cell))))))) + (cond + ((integerp (cdr cell)) + (goto-char (cdr cell))) + ((and (listp (cdr cell)) (assq 'dired-filename (cdr cell))) + (dired-goto-file (cdr (assq 'dired-filename (cdr cell))))))) ;; and make sure it will be saved again for later (setq save-place t))))) diff --git a/lisp/scroll-all.el b/lisp/scroll-all.el index a0472d5b5ce..9c2d1fb44ba 100644 --- a/lisp/scroll-all.el +++ b/lisp/scroll-all.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc. ;; Author: Gary D. Foster <Gary.Foster@corp.sun.com> -;; Keywords: scroll crisp brief lock +;; Keywords: convenience scroll lock ;; This file is part of GNU Emacs. diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index efade00031f..635990a7825 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el @@ -70,10 +70,25 @@ SIDE must be the symbol `left' or `right'." (frame-char-width))) (0)))) +(defun scroll-bar-lines () + "Return the height, measured in lines, of the horizontal scrollbar." + (let* ((wsb (window-scroll-bars)) + (htype (nth 5 wsb)) + (lines (nth 4 wsb))) + (cond + (htype lines) + ((frame-parameter nil 'horizontal-scroll-bars) + ;; nil means it's a non-toolkit scroll bar (which is currently + ;; impossible), and its height in lines is 14 pixels rounded up. + (ceiling (or (frame-parameter nil 'scroll-bar-height) 14) + (frame-char-width))) + (0)))) + ;;;; Helpful functions for enabling and disabling scroll bars. (defvar scroll-bar-mode) +(defvar horizontal-scroll-bar-mode) (defvar previous-scroll-bar-mode nil) (defvar scroll-bar-mode-explicit nil @@ -126,12 +141,44 @@ This command applies to all frames that exist and frames to be created in the future." :variable ((get-scroll-bar-mode) . (lambda (v) (set-scroll-bar-mode - (if v (or previous-scroll-bar-mode - default-frame-scroll-bars)))))) + (if v (or previous-scroll-bar-mode + default-frame-scroll-bars)))))) + +(defun horizontal-scroll-bars-available-p () + "Return non-nil when horizontal scroll bars are available on this system." + (and (display-graphic-p) + (boundp 'x-toolkit-scroll-bars) + x-toolkit-scroll-bars + (not (eq (window-system) 'ns)))) + +(define-minor-mode horizontal-scroll-bar-mode + "Toggle horizontal scroll bars on all frames (Horizontal Scroll Bar mode). +With a prefix argument ARG, enable Horizontal Scroll Bar mode if +ARG is positive, and disable it otherwise. If called from Lisp, +enable the mode if ARG is omitted or nil. + +This command applies to all frames that exist and frames to be +created in the future." + :init-value nil + :global t + :group 'frames + (if (and horizontal-scroll-bar-mode + (not (horizontal-scroll-bars-available-p))) + (progn + (setq horizontal-scroll-bar-mode nil) + (message "Horizontal scroll bars are not implemented on this system")) + (dolist (frame (frame-list)) + (set-frame-parameter + frame 'horizontal-scroll-bars horizontal-scroll-bar-mode)) + ;; Handle `default-frame-alist' entry. + (setq default-frame-alist + (cons (cons 'horizontal-scroll-bars horizontal-scroll-bar-mode) + (assq-delete-all 'horizontal-scroll-bars + default-frame-alist))))) (defun toggle-scroll-bar (arg) "Toggle whether or not the selected frame has vertical scroll bars. -With arg, turn vertical scroll bars on if and only if arg is positive. +With ARG, turn vertical scroll bars on if and only if ARG is positive. The variable `scroll-bar-mode' controls which side the scroll bars are on when they are turned on; if it is nil, they go on the left." (interactive "P") @@ -147,12 +194,20 @@ when they are turned on; if it is nil, they go on the left." (if (> arg 0) (or scroll-bar-mode default-frame-scroll-bars)))))) -(defun toggle-horizontal-scroll-bar (_arg) +(defun toggle-horizontal-scroll-bar (arg) "Toggle whether or not the selected frame has horizontal scroll bars. -With arg, turn horizontal scroll bars on if and only if arg is positive. -Horizontal scroll bars aren't implemented yet." +With ARG, turn vertical scroll bars on if and only if ARG is positive." (interactive "P") - (error "Horizontal scroll bars aren't implemented yet")) + (if (null arg) + (setq arg + (if (cdr (assq 'horizontal-scroll-bars + (frame-parameters (selected-frame)))) + -1 1)) + (setq arg (prefix-numeric-value arg))) + (modify-frame-parameters + (selected-frame) + (list (cons 'horizontal-scroll-bars + (when (> arg 0) 'bottom))))) ;;;; Buffer navigation using the scroll bar. @@ -249,6 +304,51 @@ If you click outside the slider, the window scrolls to bring the slider there." (with-current-buffer (window-buffer window) (setq point-before-scroll before-scroll)))) +;; Scroll the window to the proper position for EVENT. +(defun scroll-bar-horizontal-drag-1 (event) + (let* ((start-position (event-start event)) + (window (nth 0 start-position)) + (portion-whole (nth 2 start-position)) + (unit (frame-char-width (window-frame window)))) + (if (eq (current-bidi-paragraph-direction (window-buffer window)) + 'left-to-right) + (set-window-hscroll + window (/ (+ (car portion-whole) (1- unit)) unit)) + (set-window-hscroll + window (/ (+ (- (cdr portion-whole) (car portion-whole)) + (1- unit)) + unit))))) + +(defun scroll-bar-horizontal-drag (event) + "Scroll the window horizontally by dragging the scroll bar slider. +If you click outside the slider, the window scrolls to bring the slider there." + (interactive "e") + (let* (done + (echo-keystrokes 0) + (end-position (event-end event)) + (window (nth 0 end-position)) + (before-scroll)) + (with-current-buffer (window-buffer window) + (setq before-scroll point-before-scroll)) + (save-selected-window + (select-window window) + (setq before-scroll + (or before-scroll (point)))) + (scroll-bar-horizontal-drag-1 event) + (track-mouse + (while (not done) + (setq event (read-event)) + (if (eq (car-safe event) 'mouse-movement) + (setq event (read-event))) + (cond ((eq (car-safe event) 'scroll-bar-movement) + (scroll-bar-horizontal-drag-1 event)) + (t + ;; Exit when we get the drag event; ignore that event. + (setq done t))))) + (sit-for 0) + (with-current-buffer (window-buffer window) + (setq point-before-scroll before-scroll)))) + (defun scroll-bar-scroll-down (event) "Scroll the window's top line down to the location of the scroll bar click. EVENT should be a scroll bar click." @@ -295,52 +395,109 @@ EVENT should be a scroll bar click." ;;; Tookit scroll bars. (defun scroll-bar-toolkit-scroll (event) + "Handle event EVENT on vertical scroll bar." (interactive "e") (let* ((end-position (event-end event)) (window (nth 0 end-position)) (part (nth 4 end-position)) before-scroll) - (cond ((eq part 'end-scroll)) - (t - (with-current-buffer (window-buffer window) - (setq before-scroll point-before-scroll)) - (save-selected-window - (select-window window) - (setq before-scroll (or before-scroll (point))) - (cond ((eq part 'above-handle) - (scroll-up '-)) - ((eq part 'below-handle) - (scroll-up nil)) - ((eq part 'ratio) - (let* ((portion-whole (nth 2 end-position)) - (lines (scroll-bar-scale portion-whole - (1- (window-height))))) - (scroll-up (cond ((not (zerop lines)) lines) - ((< (car portion-whole) 0) -1) - (t 1))))) - ((eq part 'up) - (scroll-up -1)) - ((eq part 'down) - (scroll-up 1)) - ((eq part 'top) - (set-window-start window (point-min))) - ((eq part 'bottom) - (goto-char (point-max)) - (recenter)) - ((eq part 'handle) - (scroll-bar-drag-1 event)))) - (sit-for 0) - (with-current-buffer (window-buffer window) - (setq point-before-scroll before-scroll)))))) - + (cond + ((eq part 'end-scroll)) + (t + (with-current-buffer (window-buffer window) + (setq before-scroll point-before-scroll)) + (save-selected-window + (select-window window) + (setq before-scroll (or before-scroll (point))) + (cond + ((eq part 'above-handle) + (scroll-up '-)) + ((eq part 'below-handle) + (scroll-up nil)) + ((eq part 'ratio) + (let* ((portion-whole (nth 2 end-position)) + (lines (scroll-bar-scale portion-whole + (1- (window-height))))) + (scroll-up (cond ((not (zerop lines)) lines) + ((< (car portion-whole) 0) -1) + (t 1))))) + ((eq part 'up) + (scroll-up -1)) + ((eq part 'down) + (scroll-up 1)) + ((eq part 'top) + (set-window-start window (point-min))) + ((eq part 'bottom) + (goto-char (point-max)) + (recenter)) + ((eq part 'handle) + (scroll-bar-drag-1 event)))) + (sit-for 0) + (with-current-buffer (window-buffer window) + (setq point-before-scroll before-scroll)))))) +(defun scroll-bar-toolkit-horizontal-scroll (event) + "Handle event EVENT on horizontal scroll bar." + (interactive "e") + (let* ((end-position (event-end event)) + (window (nth 0 end-position)) + (part (nth 4 end-position)) + (bidi-factor + (if (eq (current-bidi-paragraph-direction (window-buffer window)) + 'left-to-right) + 1 + -1)) + before-scroll) + (cond + ((eq part 'end-scroll)) + (t + (with-current-buffer (window-buffer window) + (setq before-scroll point-before-scroll)) + (save-selected-window + (select-window window) + (setq before-scroll (or before-scroll (point))) + (cond + ((eq part 'before-handle) + (scroll-right (* bidi-factor 4))) + ((eq part 'after-handle) + (scroll-left (* bidi-factor 4))) + ((eq part 'ratio) + (let* ((portion-whole (nth 2 end-position)) + (columns (scroll-bar-scale portion-whole + (1- (window-width))))) + (scroll-right + (* (cond + ((not (zerop columns)) + columns) + ((< (car portion-whole) 0) -1) + (t 1)) + bidi-factor)))) + ((eq part 'left) + (scroll-right (* bidi-factor 1))) + ((eq part 'right) + (scroll-left (* bidi-factor 1))) + ((eq part 'leftmost) + (goto-char (if (eq bidi-factor 1) + (line-beginning-position) + (line-end-position)))) + ((eq part 'rightmost) + (goto-char (if (eq bidi-factor 1) + (line-end-position) + (line-beginning-position)))) + ((eq part 'horizontal-handle) + (scroll-bar-horizontal-drag-1 event)))) + (sit-for 0) + (with-current-buffer (window-buffer window) + (setq point-before-scroll before-scroll)))))) ;;;; Bindings. ;; For now, we'll set things up to work like xterm. (cond ((and (boundp 'x-toolkit-scroll-bars) x-toolkit-scroll-bars) (global-set-key [vertical-scroll-bar mouse-1] - 'scroll-bar-toolkit-scroll)) + 'scroll-bar-toolkit-scroll) + (global-set-key [horizontal-scroll-bar mouse-1] + 'scroll-bar-toolkit-horizontal-scroll)) (t (global-set-key [vertical-scroll-bar mouse-1] 'scroll-bar-scroll-up) diff --git a/lisp/select.el b/lisp/select.el index 6282cb2441d..f68d3d6c47b 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -1,4 +1,4 @@ -;;; select.el --- lisp portion of standard selection support +;;; select.el --- lisp portion of standard selection support -*- lexical-binding:t -*- ;; Copyright (C) 1993-1994, 2001-2015 Free Software Foundation, Inc. @@ -24,6 +24,18 @@ ;; Based partially on earlier release by Lucid. +;; The functionality here is divided in two parts: +;; - Low-level: gui-get-selection, gui-set-selection, gui-selection-owner-p, +;; gui-selection-exists-p are the backend-dependent functions meant to access +;; various kinds of selections (CLIPBOARD, PRIMARY, SECONDARY). +;; - Higher-level: gui-select-text and gui-selection-value go together to +;; access the general notion of "GUI selection" for interoperation with other +;; applications. This can use either the clipboard or the primary selection, +;; or both or none according to select-enable-clipboard/primary. These are +;; the default values of interprogram-cut/paste-function. +;; Additionally, there's gui-get-primary-selection which is used to get the +;; PRIMARY selection, specifically for mouse-yank-primary. + ;;; Code: (defcustom selection-coding-system nil @@ -71,13 +83,204 @@ other programs (X Windows clients or MS Windows programs). But, if this variable is set, it is used for the next communication only. After the communication, this variable is set to nil.") -(declare-function x-get-selection-internal "xselect.c" - (selection-symbol target-type &optional time-stamp terminal)) - ;; Only declared obsolete in 23.3. (define-obsolete-function-alias 'x-selection 'x-get-selection "at least 19.34") -(defun x-get-selection (&optional type data-type) +(defcustom select-enable-clipboard t + "Non-nil means cutting and pasting uses the clipboard. +This can be in addition to, but in preference to, the primary selection, +if applicable (i.e. under X11)." + :type 'boolean + :group 'killing + ;; The GNU/Linux version changed in 24.1, the MS-Windows version did not. + :version "24.1") +(define-obsolete-variable-alias 'x-select-enable-clipboard + 'select-enable-clipboard "25.1") + +(defcustom select-enable-primary nil + "Non-nil means cutting and pasting uses the primary selection +The existence of a primary selection depends on the underlying GUI you use. +E.g. it doesn't exist under MS-Windows." + :type 'boolean + :group 'killing + :version "24.1") +(define-obsolete-variable-alias 'x-select-enable-primary + 'select-enable-primary "25.1") + +;; We keep track of the last text selected here, so we can check the +;; current selection against it, and avoid passing back our own text +;; from gui-selection-value. We track both +;; separately in case another X application only sets one of them +;; we aren't fooled by the PRIMARY or CLIPBOARD selection staying the same. + +(defvar gui--last-selected-text-clipboard nil + "The value of the CLIPBOARD selection last seen.") +(defvar gui--last-selected-text-primary nil + "The value of the PRIMARY selection last seen.") + +(defun gui-select-text (text) + "Select TEXT, a string, according to the window system. +if `select-enable-clipboard' is non-nil, copy TEXT to the system's clipboard. +If `select-enable-primary' is non-nil, put TEXT in the primary selection. + +MS-Windows does not have a \"primary\" selection." + (when select-enable-primary + (gui-set-selection 'PRIMARY text) + (setq gui--last-selected-text-primary text)) + (when select-enable-clipboard + ;; When cutting, the selection is cleared and PRIMARY + ;; set to the empty string. Prevent that, PRIMARY + ;; should not be reset by cut (Bug#16382). + (setq saved-region-selection text) + (gui-set-selection 'CLIPBOARD text) + (setq gui--last-selected-text-clipboard text))) +(define-obsolete-function-alias 'x-select-text 'gui-select-text "25.1") + +(defcustom x-select-request-type nil + "Data type request for X selection. +The value is one of the following data types, a list of them, or nil: + `COMPOUND_TEXT', `UTF8_STRING', `STRING', `TEXT' + +If the value is one of the above symbols, try only the specified type. + +If the value is a list of them, try each of them in the specified +order until succeed. + +The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)." + :type '(choice (const :tag "Default" nil) + (const COMPOUND_TEXT) + (const UTF8_STRING) + (const STRING) + (const TEXT) + (set :tag "List of values" + (const COMPOUND_TEXT) + (const UTF8_STRING) + (const STRING) + (const TEXT))) + :group 'killing) + +;; Get a selection value of type TYPE by calling gui-get-selection with +;; an appropriate DATA-TYPE argument decided by `x-select-request-type'. +;; The return value is already decoded. If gui-get-selection causes an +;; error, this function return nil. + +(defun gui--selection-value-internal (type) + (let ((request-type (if (eq window-system 'x) + (or x-select-request-type + '(UTF8_STRING COMPOUND_TEXT STRING)) + 'STRING)) + text) + (with-demoted-errors "gui-get-selection: %S" + (if (consp request-type) + (while (and request-type (not text)) + (setq text (gui-get-selection type (car request-type))) + (setq request-type (cdr request-type))) + (setq text (gui-get-selection type request-type)))) + (if text + (remove-text-properties 0 (length text) '(foreign-selection nil) text)) + text)) + +(defun gui-selection-value () + (let ((clip-text + (when select-enable-clipboard + (let ((text (gui--selection-value-internal 'CLIPBOARD))) + (if (string= text "") (setq text nil)) + + ;; Check the CLIPBOARD selection for 'newness', is it different + ;; from what we remembered them to be last time we did a + ;; cut/paste operation. + (prog1 + (unless (equal text gui--last-selected-text-clipboard) + text) + (setq gui--last-selected-text-clipboard text))))) + (primary-text + (when select-enable-primary + (let ((text (gui--selection-value-internal 'PRIMARY))) + (if (string= text "") (setq text nil)) + ;; Check the PRIMARY selection for 'newness', is it different + ;; from what we remembered them to be last time we did a + ;; cut/paste operation. + (prog1 + (unless (equal text gui--last-selected-text-primary) + text) + (setq gui--last-selected-text-primary text)))))) + + ;; As we have done one selection, clear this now. + (setq next-selection-coding-system nil) + + ;; At this point we have recorded the current values for the + ;; selection from clipboard (if we are supposed to) and primary. + ;; So return the first one that has changed + ;; (which is the first non-null one). + ;; + ;; NOTE: There will be cases where more than one of these has + ;; changed and the new values differ. This indicates that + ;; something like the following has happened since the last time + ;; we looked at the selections: Application X set all the + ;; selections, then Application Y set only one of them. + ;; In this case since we don't have + ;; timestamps there is no way to know what the 'correct' value to + ;; return is. The nice thing to do would be to tell the user we + ;; saw multiple possible selections and ask the user which was the + ;; one they wanted. + (or clip-text primary-text) + )) + +(define-obsolete-function-alias 'x-selection-value 'gui-selection-value "25.1") + +(defun x-get-clipboard () + "Return text pasted to the clipboard." + (declare (obsolete gui-get-selection "25.1")) + (gui-call gui-get-selection 'CLIPBOARD 'STRING)) + +(defun gui-get-primary-selection () + "Return the PRIMARY selection, or the best emulation thereof." + (or (gui-get-selection 'PRIMARY) + (and (fboundp 'w32-get-selection-value) + (eq (framep (selected-frame)) 'w32) + ;; MS-Windows emulates PRIMARY in x-get-selection, but only + ;; within the Emacs session, so consult the clipboard if + ;; primary is not found. + (w32-get-selection-value)) + (error "No selection is available"))) +(define-obsolete-function-alias 'x-get-selection-value + 'gui-get-primary-selection "25.1") + +;;; Lower-level, backend dependent selection handling. + +(gui-method-declare gui-get-selection #'ignore + "Return selected text. +Called with 2 arguments: (SELECTION-SYMBOL TARGET-TYPE) +SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. +\(Those are literal upper-case symbol names, since that's what X expects.) +TARGET-TYPE is the type of data desired, typically `STRING'.") + +(gui-method-declare gui-set-selection #'ignore + "Method to assert a selection of type SELECTION and value VALUE. +SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. +If VALUE is nil and we own the selection SELECTION, disown it instead. +Disowning it means there is no such selection. +\(Those are literal upper-case symbol names, since that's what X expects.) +VALUE is typically a string, or a cons of two markers, but may be +anything that the functions on `selection-converter-alist' know about. + +Called with 2 args: (SELECTION VALUE).") + +(gui-method-declare gui-selection-owner-p #'ignore + "Whether the current Emacs process owns the given X Selection. +Called with one argument: (SELECTION). +The arg should be the name of the selection in question, typically one of +the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. +\(Those are literal upper-case symbol names, since that's what X expects.)") + +(gui-method-declare gui-selection-exists-p #'ignore + "Whether there is an owner for the given X Selection. +Called with one argument: (SELECTION). +The arg should be the name of the selection in question, typically one of +the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. +\(Those are literal upper-case symbol names, since that's what X expects.)") + +(defun gui-get-selection (&optional type data-type) "Return the value of an X Windows selection. The argument TYPE (default `PRIMARY') says which selection, and the argument DATA-TYPE (default `STRING') says @@ -90,40 +293,28 @@ all upper-case names. The most often used ones, in addition to DATA-TYPE is usually `STRING', but can also be one of the symbols in `selection-converter-alist', which see. This argument is -ignored on MS-Windows and MS-DOS." - (let ((data (x-get-selection-internal (or type 'PRIMARY) - (or data-type 'STRING))) - coding) +ignored on NS, MS-Windows and MS-DOS." + (let ((data (gui-call gui-get-selection (or type 'PRIMARY) + (or data-type 'STRING)))) (when (and (stringp data) (setq data-type (get-text-property 0 'foreign-selection data))) - (setq coding (or next-selection-coding-system - selection-coding-system - (cond ((eq data-type 'UTF8_STRING) - 'utf-8) - ((eq data-type 'COMPOUND_TEXT) - 'compound-text-with-extensions) - ((eq data-type 'C_STRING) - nil) - ((eq data-type 'STRING) - 'iso-8859-1) - (t - (error "Unknown selection data type: %S" type)))) - data (if coding (decode-coding-string data coding) - (string-to-multibyte data))) + (let ((coding (or next-selection-coding-system + selection-coding-system + (pcase data-type + ('UTF8_STRING 'utf-8) + ('COMPOUND_TEXT 'compound-text-with-extensions) + ('C_STRING nil) + ('STRING 'iso-8859-1) + (_ (error "Unknown selection data type: %S" + type)))))) + (setq data (if coding (decode-coding-string data coding) + (string-to-multibyte data)))) (setq next-selection-coding-system nil) (put-text-property 0 (length data) 'foreign-selection data-type data)) data)) +(define-obsolete-function-alias 'x-get-selection 'gui-get-selection "25.1") -(defun x-get-clipboard () - "Return text pasted to the clipboard." - (x-get-selection-internal 'CLIPBOARD 'STRING)) - -(declare-function x-own-selection-internal "xselect.c" - (selection-name selection-value &optional frame)) -(declare-function x-disown-selection-internal "xselect.c" - (selection &optional time terminal)) - -(defun x-set-selection (type data) +(defun gui-set-selection (type data) "Make an X selection of type TYPE and value DATA. The argument TYPE (nil means `PRIMARY') says which selection, and DATA specifies the contents. TYPE must be a symbol. \(It can also @@ -151,35 +342,32 @@ are not available to other programs." (list 'PRIMARY (read-string "Set text for pasting: ")) (list 'PRIMARY (buffer-substring (region-beginning) (region-end))))) (if (stringp type) (setq type (intern type))) - (or (x-valid-simple-selection-p data) + (or (gui--valid-simple-selection-p data) (and (vectorp data) - (let ((valid t) - (i (1- (length data)))) - (while (>= i 0) - (or (x-valid-simple-selection-p (aref data i)) - (setq valid nil)) - (setq i (1- i))) + (let ((valid t)) + (dotimes (i (length data)) + (or (gui--valid-simple-selection-p (aref data i)) + (setq valid nil))) valid)) (signal 'error (list "invalid selection" data))) (or type (setq type 'PRIMARY)) - (if data - (x-own-selection-internal type data) - (x-disown-selection-internal type)) + (gui-call gui-set-selection type data) data) +(define-obsolete-function-alias 'x-set-selection 'gui-set-selection "25.1") -(defun x-valid-simple-selection-p (data) +(defun gui--valid-simple-selection-p (data) (or (bufferp data) (and (consp data) (markerp (car data)) (markerp (cdr data)) (marker-buffer (car data)) - (buffer-name (marker-buffer (car data))) + (buffer-live-p (marker-buffer (car data))) (eq (marker-buffer (car data)) (marker-buffer (cdr data)))) (stringp data) (and (overlayp data) (overlay-buffer data) - (buffer-name (overlay-buffer data))) + (buffer-live-p (overlay-buffer data))) (symbolp data) (integerp data))) @@ -323,7 +511,7 @@ two markers or an overlay. Otherwise, it is nil." (apply 'vector all))) (defun xselect-convert-to-delete (selection _type _value) - (x-disown-selection-internal selection) + (gui-call gui-set-selection selection nil) ;; A return value of nil means that we do not know how to do this conversion, ;; and replies with an "error". A return value of NULL means that we have ;; done the conversion (and any side-effects) but have no value to return. diff --git a/lisp/server.el b/lisp/server.el index 3cc5fe40b1d..166cd44bb2e 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -642,8 +642,6 @@ server or call `M-x server-force-delete' to forcibly disconnect it.") (cl-letf (((default-file-modes) ?\700)) (add-hook 'suspend-tty-functions 'server-handle-suspend-tty) (add-hook 'delete-frame-functions 'server-handle-delete-frame) - (add-hook 'kill-buffer-query-functions - 'server-kill-buffer-query-function) (add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function) (add-hook 'kill-emacs-hook 'server-force-stop) ;Cleanup upon exit. @@ -796,32 +794,33 @@ This handles splitting the command if it would be bigger than (error "Invalid terminal type")) (add-to-list 'frame-inherited-parameters 'client) (let ((frame - (server-with-environment (process-get proc 'env) - '("LANG" "LC_CTYPE" "LC_ALL" - ;; For tgetent(3); list according to ncurses(3). - "BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES" - "NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING" - "NCURSES_NO_SETBUF" "TERM" "TERMCAP" "TERMINFO" - "TERMINFO_DIRS" "TERMPATH" - ;; rxvt wants these - "COLORFGBG" "COLORTERM") - (make-frame `((window-system . nil) - (tty . ,tty) - (tty-type . ,type) - ;; Ignore nowait here; we always need to - ;; clean up opened ttys when the client dies. - (client . ,proc) - ;; This is a leftover from an earlier - ;; attempt at making it possible for process - ;; run in the server process to use the - ;; environment of the client process. - ;; It has no effect now and to make it work - ;; we'd need to decide how to make - ;; process-environment interact with client - ;; envvars, and then to change the - ;; C functions `child_setup' and - ;; `getenv_internal' accordingly. - (environment . ,(process-get proc 'env))))))) + (server-with-environment + (process-get proc 'env) + '("LANG" "LC_CTYPE" "LC_ALL" + ;; For tgetent(3); list according to ncurses(3). + "BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES" + "NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING" + "NCURSES_NO_SETBUF" "TERM" "TERMCAP" "TERMINFO" + "TERMINFO_DIRS" "TERMPATH" + ;; rxvt wants these + "COLORFGBG" "COLORTERM") + (make-frame `((window-system . nil) + (tty . ,tty) + (tty-type . ,type) + ;; Ignore nowait here; we always need to + ;; clean up opened ttys when the client dies. + (client . ,proc) + ;; This is a leftover from an earlier + ;; attempt at making it possible for process + ;; run in the server process to use the + ;; environment of the client process. + ;; It has no effect now and to make it work + ;; we'd need to decide how to make + ;; process-environment interact with client + ;; envvars, and then to change the + ;; C functions `child_setup' and + ;; `getenv_internal' accordingly. + (environment . ,(process-get proc 'env))))))) ;; ttys don't use the `display' parameter, but callproc.c does to set ;; the DISPLAY environment on subprocesses. @@ -1472,22 +1471,6 @@ specifically for the clients and did not exist before their request for it." (save-buffer))) (server-buffer-done (current-buffer)))) -;; Ask before killing a server buffer. -;; It was suggested to release its client instead, -;; but I think that is dangerous--the client would proceed -;; using whatever is on disk in that file. -- rms. -(defun server-kill-buffer-query-function () - "Ask before killing a server buffer." - (or (not server-buffer-clients) - (let ((res t)) - (dolist (proc server-buffer-clients) - (when (and (memq proc server-clients) - (eq (process-status proc) 'open)) - (setq res nil))) - res) - (yes-or-no-p (format "Buffer `%s' still has clients; kill it? " - (buffer-name (current-buffer)))))) - (defun server-kill-emacs-query-function () "Ask before exiting Emacs if it has live clients." (or (not server-clients) diff --git a/lisp/ses.el b/lisp/ses.el index 05dcf27ef9e..b0a09fff057 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -1,4 +1,4 @@ -;;; ses.el -- Simple Emacs Spreadsheet -*- coding: utf-8 -*- +;;; ses.el -- Simple Emacs Spreadsheet -*- lexical-binding:t -*- ;; Copyright (C) 2002-2015 Free Software Foundation, Inc. @@ -56,6 +56,7 @@ ;;; Code: (require 'unsafep) +(require 'macroexp) (eval-when-compile (require 'cl-lib)) @@ -239,6 +240,10 @@ Each function is called with ARG=1." "\n( ;Global parameters (these are read first)\n 2 ;SES file-format\n 1 ;numrows\n 1 ;numcols\n)\n\n" "Initial contents for the three-element list at the bottom of the data area.") +(defconst ses-initial-global-parameters-re + "\n( ;Global parameters (these are read first)\n [23] ;SES file-format\n [0-9]+ ;numrows\n [0-9]+ ;numcols\n\\( [0-9]+ ;numlocprn\n\\)?)\n\n" + "Match Global parameters for .") + (defconst ses-initial-file-trailer ";; Local Variables:\n;; mode: ses\n;; End:\n" "Initial contents for the file-trailer area at the bottom of the file.") @@ -277,6 +282,8 @@ default printer and then modify its output.") '(ses--blank-line ses--cells ses--col-printers ses--col-widths ses--curcell ses--curcell-overlay ses--default-printer + (ses--local-printer-hashmap . :hashmap) + (ses--numlocprn . 0); count of local printers ses--deferred-narrow ses--deferred-recalc ses--deferred-write ses--file-format ses--named-cell-hashmap @@ -290,7 +297,11 @@ default printer and then modify its output.") ses--renamed-cell-symb-list ;; Global variables that we override mode-line-process next-line-add-newlines transient-mark-mode) - "Buffer-local variables used by SES.") + "Buffer-local variables used by SES.")) + +(defmacro ses--metaprogramming (exp) (declare (debug t)) (eval exp t)) +(ses--metaprogramming + `(progn ,@(mapcar (lambda (x) `(defvar ,(or (car-safe x) x))) ses-localvars))) (defun ses-set-localvars () "Set buffer-local and initialize some SES variables." @@ -299,11 +310,14 @@ default printer and then modify its output.") ((symbolp x) (set (make-local-variable x) nil)) ((consp x) - (set (make-local-variable (car x)) (cdr x))) - (t (error "Unexpected elements `%S' in list `ses-localvars'" x)))))) - -(eval-when-compile ; silence compiler - (ses-set-localvars)) + (cond + ((integerp (cdr x)) + (set (make-local-variable (car x)) (cdr x))) + ((eq (cdr x) :hashmap) + (set (make-local-variable (car x)) (make-hash-table :test 'eq))) + (t (error "Unexpected initializer `%S' in list `ses-localvars' for entry %S" + (cdr x) (car x)) ) )) + (t (error "Unexpected elements `%S' in list `ses-localvars'" x))))) ;;; This variable is documented as being permitted in file-locals: (put 'ses--symbolic-formulas 'safe-local-variable 'consp) @@ -311,10 +325,21 @@ default printer and then modify its output.") (defconst ses-paramlines-plist '(ses--col-widths -5 ses--col-printers -4 ses--default-printer -3 ses--header-row -2 ses--file-format 1 ses--numrows 2 - ses--numcols 3) + ses--numcols 3 ses--numlocprn 4) "Offsets from 'Global parameters' line to various parameter lines in the data area of a spreadsheet.") +(defconst ses-paramfmt-plist + '(ses--col-widths "(ses-column-widths %S)" + ses--col-printers "(ses-column-printers %S)" + ses--default-printer "(ses-default-printer %S)" + ses--header-row "(ses-header-row %S)" + ses--file-format " %S ;SES file-format" + ses--numrows " %S ;numrows" + ses--numcols " %S ;numcols" + ses--numlocprn " %S ;numlocprn") + "Formats of 'Global parameters' various parameters in the data +area of a spreadsheet.") ;; ;; "Side-effect variables". They are set in one function, altered in @@ -347,158 +372,88 @@ when to emit a progress message.") (defmacro ses-get-cell (row col) "Return the cell structure that stores information about cell (ROW,COL)." + (declare (debug t)) `(aref (aref ses--cells ,row) ,col)) -;; We might want to use defstruct here, but cells are explicitly used as -;; arrays in ses-set-cell, so we'd need to fix this first. --Stef -(defsubst ses-make-cell (&optional symbol formula printer references - property-list) - (vector symbol formula printer references property-list)) +(cl-defstruct (ses-cell + (:constructor nil) + (:constructor ses-make-cell + (&optional symbol formula printer references)) + (:copier nil) + ;; This is treated as an 4-elem array in various places. + ;; Mostly in ses-set-cell. + (:type vector) ;Not named. + (:conc-name ses-cell--)) + symbol formula printer references properties) + +(cl-defstruct (ses--locprn + (:constructor) + (:constructor ses-make-local-printer-info + (def &optional (compiled (ses-local-printer-compile def)) + (number ses--numlocprn)))) + def + compiled + number + local-printer-list) (defmacro ses-cell-symbol (row &optional col) "From a CELL or a pair (ROW,COL), get the symbol that names the local-variable holding its value. (0,0) => A1." - `(aref ,(if col `(ses-get-cell ,row ,col) row) 0)) + (declare (debug t)) + `(ses-cell--symbol ,(if col `(ses-get-cell ,row ,col) row))) (put 'ses-cell-symbol 'safe-function t) (defmacro ses-cell-formula (row &optional col) "From a CELL or a pair (ROW,COL), get the function that computes its value." - `(aref ,(if col `(ses-get-cell ,row ,col) row) 1)) - -(defmacro ses-cell-formula-aset (cell formula) - "From a CELL set the function that computes its value." - `(aset ,cell 1 ,formula)) + (declare (debug t)) + `(ses-cell--formula ,(if col `(ses-get-cell ,row ,col) row))) (defmacro ses-cell-printer (row &optional col) "From a CELL or a pair (ROW,COL), get the function that prints its value." - `(aref ,(if col `(ses-get-cell ,row ,col) row) 2)) + (declare (debug t)) + `(ses-cell--printer ,(if col `(ses-get-cell ,row ,col) row))) (defmacro ses-cell-references (row &optional col) "From a CELL or a pair (ROW,COL), get the list of symbols for cells whose functions refer to its value." - `(aref ,(if col `(ses-get-cell ,row ,col) row) 3)) - -(defmacro ses-cell-references-aset (cell references) - "From a CELL set the list REFERENCES of symbols for cells the -function of which refer to its value." - `(aset ,cell 3 ,references)) + (declare (debug t)) + `(ses-cell--references ,(if col `(ses-get-cell ,row ,col) row))) (defun ses-cell-p (cell) - "Return non `nil' is CELL is a cell of current buffer." + "Return non-nil if CELL is a cell of current buffer." (and (vectorp cell) (= (length cell) 5) (eq cell (let ((rowcol (ses-sym-rowcol (ses-cell-symbol cell)))) (and (consp rowcol) (ses-get-cell (car rowcol) (cdr rowcol))))))) -(defun ses-cell-property-get-fun (property-name cell) - ;; To speed up property fetching, each time a property is found it is placed - ;; in the first position. This way, after the first get, the full property - ;; list needs to be scanned only when the property does not exist for that - ;; cell. - (let* ((plist (aref cell 4)) - (ret (plist-member plist property-name))) - (if ret - ;; Property was found. - (let ((val (cadr ret))) - (if (eq ret plist) - ;; Property found is already in the first position, so just return - ;; its value. - val - ;; Property is not in the first position, the following will move it - ;; there before returning its value. - (let ((next (cddr ret))) - (if next - (progn - (setcdr ret (cdr next)) - (setcar ret (car next))) - (setcdr (last plist 1) nil))) - (aset cell 4 - `(,property-name ,val ,@plist)) - val))))) - -(defmacro ses-cell-property-get (property-name row &optional col) - "Get property named PROPERTY-NAME from a CELL or a pair (ROW,COL). + +(defmacro ses--letref (vars place &rest body) + (declare (indent 2) (debug (sexp form &rest body))) + (gv-letplace (getter setter) place + `(cl-macrolet ((,(nth 0 vars) () ',getter) + (,(nth 1 vars) (v) (funcall ',setter v))) + ,@body))) + +(defmacro ses-cell-property (property-name row &optional col) + "Get property named PROPERTY-NAME from a CELL or a pair (ROW,COL). When COL is omitted, CELL=ROW is a cell object. When COL is present ROW and COL are the integer coordinates of the cell of interest." - (declare (debug t)) - `(ses-cell-property-get-fun - ,property-name - ,(if col `(ses-get-cell ,row ,col) row))) - -(defun ses-cell-property-delq-fun (property-name cell) - (let ((ret (plist-get (aref cell 4) property-name))) - (if ret - (setcdr ret (cddr ret))))) - -(defun ses-cell-property-set-fun (property-name property-val cell) - (let* ((plist (aref cell 4)) - (ret (plist-member plist property-name))) - (if ret - (setcar (cdr ret) property-val) - (aset cell 4 `(,property-name ,property-val ,@plist))))) - -(defmacro ses-cell-property-set (property-name property-value row &optional col) - "From a CELL or a pair (ROW,COL), set the property value of -the corresponding cell with name PROPERTY-NAME to PROPERTY-VALUE." - (if property-value - `(ses-cell-property-set-fun ,property-name ,property-value - ,(if col `(ses-get-cell ,row ,col) row)) - `(ses-cell-property-delq-fun ,property-name - ,(if col `(ses-get-cell ,row ,col) row)))) - -(defun ses-cell-property-pop-fun (property-name cell) - (let* ((plist (aref cell 4)) - (ret (plist-member plist property-name))) - (if ret - (prog1 (cadr ret) - (let ((next (cddr ret))) - (if next - (progn - (setcdr ret (cdr next)) - (setcar ret (car next))) - (if (eq plist ret) - (aset cell 4 nil) - (setcdr (last plist 2) nil)))))))) - + (declare (debug t)) + `(alist-get ,property-name + (ses-cell--properties + ,(if col `(ses-get-cell ,row ,col) row)))) (defmacro ses-cell-property-pop (property-name row &optional col) - "From a CELL or a pair (ROW,COL), get and remove the property value of + "From a CELL or a pair (ROW,COL), get and remove the property value of the corresponding cell with name PROPERTY-NAME." - `(ses-cell-property-pop-fun ,property-name - ,(if col `(ses-get-cell ,row ,col) row))) - -(defun ses-cell-property-get-handle-fun (property-name cell) - (let* ((plist (aref cell 4)) - (ret (plist-member plist property-name))) - (if ret - (if (eq ret plist) - (cdr ret) - (let ((val (cadr ret)) - (next (cddr ret))) - (if next - (progn - (setcdr ret (cdr next)) - (setcar ret (car next))) - (setcdr (last plist 2) nil)) - (setq ret (cons val plist)) - (aset cell 4 (cons property-name ret)) - ret)) - (setq ret (cons nil plist)) - (aset cell 4 (cons property-name ret)) - ret))) - -(defmacro ses-cell-property-get-handle (property-name row &optional col) - "From a CELL or a pair (ROW,COL), get a cons cell whose car is -the property value of the corresponding cell property with name -PROPERTY-NAME." - `(ses-cell-property-get-handle-fun ,property-name - ,(if col `(ses-get-cell ,row ,col) row))) - - -(defalias 'ses-cell-property-handle-car 'car) -(defalias 'ses-cell-property-handle-setcar 'setcar) + `(ses--letref (pget pset) + (alist-get ,property-name + (ses-cell--properties + ,(if col `(ses-get-cell ,row ,col) row)) + nil t) + (prog1 (pget) (pset nil)))) (defmacro ses-cell-value (row &optional col) "From a CELL or a pair (ROW,COL), get the current value for that cell." @@ -530,14 +485,15 @@ is nil if SYM is not a symbol that names a cell." (< (cdr rowcol) ses--numcols) (eq (ses-cell-symbol (car rowcol) (cdr rowcol)) sym)))))) -(defmacro ses-cell (sym value formula printer references) +(defun ses--cell (sym value formula printer references) "Load a cell SYM from the spreadsheet file. Does not recompute VALUE from -FORMULA, does not reprint using PRINTER, does not check REFERENCES. This is a -macro to prevent propagate-on-load viruses. Safety-checking for FORMULA and -PRINTER are deferred until first use." +FORMULA, does not reprint using PRINTER, does not check REFERENCES. +Safety-checking for FORMULA and PRINTER are deferred until first use." (let ((rowcol (ses-sym-rowcol sym))) (ses-formula-record formula) (ses-printer-record printer) + (unless (or formula (eq value '*skip*)) + (setq formula (macroexp-quote value))) (or (atom formula) (eq safe-functions t) (setq formula `(ses-safe-formula ,formula))) @@ -545,11 +501,32 @@ PRINTER are deferred until first use." (stringp printer) (eq safe-functions t) (setq printer `(ses-safe-printer ,printer))) - (aset (aref ses--cells (car rowcol)) - (cdr rowcol) + (setf (ses-get-cell (car rowcol) (cdr rowcol)) (ses-make-cell sym formula printer references))) - (set sym value) - sym) + (set sym value)) + +(defun ses-local-printer-compile (printer) + "Convert local printer function into faster printer +definition." + (cond + ((functionp printer) printer) + ((stringp printer) + `(lambda (x) (format ,printer x))) + (t (error "Invalid printer %S" printer)))) + +(defun ses--local-printer (name def) + "Define a local printer with name NAME and definition DEF. +Return the printer info." + (or + (and (symbolp name) + (ses-printer-validate def)) + (error "Invalid local printer definition")) + (and (gethash name ses--local-printer-hashmap) + (error "Duplicate printer definition %S" name)) + (add-to-list 'ses-read-printer-history (symbol-name name)) + (puthash name + (ses-make-local-printer-info (ses-safe-printer def)) + ses--local-printer-hashmap)) (defmacro ses-column-widths (widths) "Load the vector of column widths from the spreadsheet file. This is a @@ -559,7 +536,7 @@ macro to prevent propagate-on-load viruses." ;;To save time later, we also calculate the total width of each line in the ;;print area (excluding the terminating newline) (setq ses--col-widths widths - ses--linewidth (apply '+ -1 (mapcar '1+ widths)) + ses--linewidth (apply #'+ -1 (mapcar #'1+ widths)) ses--blank-line (concat (make-string ses--linewidth ?\s) "\n")) t) @@ -571,7 +548,7 @@ them for safety. This is a macro to prevent propagate-on-load viruses." (dotimes (x ses--numcols) (aset printers x (ses-safe-printer (aref printers x)))) (setq ses--col-printers printers) - (mapc 'ses-printer-record printers) + (mapc #'ses-printer-record printers) t) (defmacro ses-default-printer (def) @@ -605,23 +582,24 @@ variables `minrow', `maxrow', `mincol', and `maxcol'." (let ((minrow (car ,min)) (maxrow (car ,max)) (mincol (cdr ,min)) - (maxcol (cdr ,max)) - row col) + (maxcol (cdr ,max))) (if (or (> minrow maxrow) (> mincol maxcol)) (error "Empty range")) (dotimes (,r (- maxrow minrow -1)) - (setq row (+ ,r minrow)) - (dotimes (,c (- maxcol mincol -1)) - (setq col (+ ,c mincol)) - ,@body)))))) + (let ((row (+ ,r minrow))) + (dotimes (,c (- maxcol mincol -1)) + (let ((col (+ ,c mincol))) + ,@body)))))))) ;;Support for coverage testing. (defmacro 1value (form) "For code-coverage testing, indicate that FORM is expected to always have the same value." + (declare (debug t)) form) (defmacro noreturn (form) "For code-coverage testing, indicate that FORM will always signal an error." + (declare (debug t)) form) @@ -664,9 +642,11 @@ is a vector--if a symbol, the new vector is assigned as the symbol's value." "Signal an error if PRINTER is not a valid SES cell printer." (or (not printer) (stringp printer) + ;; printer is a local printer + (and (symbolp printer) (gethash printer ses--local-printer-hashmap)) (functionp printer) (and (stringp (car-safe printer)) (not (cdr printer))) - (error "Invalid printer function")) + (error "Invalid printer function %S" printer)) printer) (defun ses-printer-record (printer) @@ -698,20 +678,22 @@ for this spreadsheet." (intern (concat (ses-column-letter col) (number-to-string (1+ row))))) (defun ses-decode-cell-symbol (str) - "Decode a symbol \"A1\" => (0,0). Returns `nil' if STR is not a - canonical cell name. Does not save match data." + "Decode a symbol \"A1\" => (0,0). Return nil if STR is not a +canonical cell name." (let (case-fold-search) (and (string-match "\\`\\([A-Z]+\\)\\([0-9]+\\)\\'" str) (let* ((col-str (match-string-no-properties 1 str)) - (col 0) - (col-base 1) - (col-idx (1- (length col-str))) - (row (1- (string-to-number (match-string-no-properties 2 str))))) + (col 0) + (col-base 1) + (col-idx (1- (length col-str))) + (row (1- (string-to-number + (match-string-no-properties 2 str))))) (and (>= row 0) (progn (while (progn - (setq col (+ col (* (- (aref col-str col-idx) ?A) col-base)) + (setq col (+ col (* (- (aref col-str col-idx) ?A) + col-base)) col-base (* col-base 26) col-idx (1- col-idx)) (and (>= col-idx 0) @@ -772,34 +754,47 @@ updated again." (setq ses--header-hscroll -1)) ;;Split this code off into a function to avoid coverage-testing difficulties -(defun ses-time-check (format arg) +(defmacro ses--time-check (format &rest args) "If `ses-start-time' is more than a second ago, call `message' with FORMAT -and (eval ARG) and reset `ses-start-time' to the current time." - (when (> (- (float-time) ses-start-time) 1.0) - (message format (eval arg)) - (setq ses-start-time (float-time))) - nil) +and ARGS and reset `ses-start-time' to the current time." + `(when (> (- (float-time) ses-start-time) 1.0) + (message ,format ,@args) + (setq ses-start-time (float-time)))) ;;---------------------------------------------------------------------------- ;; The cells ;;---------------------------------------------------------------------------- -(defun ses-set-cell (row col field val) +(defmacro ses-set-cell (row col field val) "Install VAL as the contents for field FIELD (named by a quoted symbol) of cell (ROW,COL). This is undoable. The cell's data will be updated through `post-command-hook'." - (let ((cell (ses-get-cell row col)) - (elt (plist-get '(value t symbol 0 formula 1 printer 2 references 3) - field)) - change) - (or elt (signal 'args-out-of-range nil)) - (setq change (if (eq elt t) - (ses-set-with-undo (ses-cell-symbol cell) val) - (ses-aset-with-undo cell elt val))) - (if change - (add-to-list 'ses--deferred-write (cons row col)))) - nil) ; Make coverage-tester happy. + `(let ((row ,row) + (col ,col) + (val ,val)) + (let* ((cell (ses-get-cell row col)) + (change + ,(let ((field (progn (cl-assert (eq (car field) 'quote)) + (cadr field)))) + (if (eq field 'value) + `(ses-set-with-undo (ses-cell-symbol cell) val) + ;; (let* ((slots (get 'ses-cell 'cl-struct-slots)) + ;; (slot (or (assq field slots) + ;; (error "Unknown field %S" field))) + ;; (idx (- (length slots) + ;; (length (memq slot slots))))) + ;; `(ses-aset-with-undo cell ,idx val)) + (let ((getter (intern-soft (format "ses-cell--%s" field)))) + `(ses-setter-with-undo + (eval-when-compile + (cons #',getter + (lambda (newval cell) + (setf (,getter cell) newval)))) + val cell)))))) + (if change + (add-to-list 'ses--deferred-write (cons row col)))) + nil)) ; Make coverage-tester happy. (defun ses-cell-set-formula (row col formula) "Store a new formula for (ROW . COL) and enqueue the cell for @@ -814,7 +809,7 @@ means Emacs will crash if FORMULA contains a circular list." (newref (ses-formula-references formula)) (inhibit-quit t) x xrow xcol) - (add-to-list 'ses--deferred-recalc sym) + (cl-pushnew sym ses--deferred-recalc) ;;Delete old references from this cell. Skip the ones that are also ;;in the new list. (dolist (ref oldref) @@ -845,11 +840,11 @@ means Emacs will crash if FORMULA contains a circular list." (dotimes (col ses--numcols) (let ((references (ses-cell-property-pop :ses-repair-reference row col))) - (when references - (push (list - (ses-cell-symbol row col) - :corrupt-property - references) errors))))) + (when references + (push (list (ses-cell-symbol row col) + :corrupt-property + references) + errors))))) ;; Step 2, build new. (dotimes (row ses--numrows) @@ -859,21 +854,17 @@ means Emacs will crash if FORMULA contains a circular list." (formula (ses-cell-formula cell)) (new-ref (ses-formula-references formula))) (dolist (ref new-ref) - (let* ((rowcol (ses-sym-rowcol ref)) - (h (ses-cell-property-get-handle :ses-repair-reference - (car rowcol) (cdr rowcol)))) - (unless (memq ref (ses-cell-property-handle-car h)) - (ses-cell-property-handle-setcar - h - (cons sym - (ses-cell-property-handle-car h))))))))) + (let ((rowcol (ses-sym-rowcol ref))) + (cl-pushnew sym (ses-cell-property :ses-repair-reference + (car rowcol) + (cdr rowcol)))))))) ;; Step 3, overwrite with check. (dotimes (row ses--numrows) (dotimes (col ses--numcols) (let* ((cell (ses-get-cell row col)) (irrelevant (ses-cell-references cell)) - (new-ref (ses-cell-property-pop :ses-repair-reference cell)) + (new-ref (ses-cell-property-pop :ses-repair-reference cell)) missing) (dolist (ref new-ref) (if (memq ref irrelevant) @@ -886,7 +877,7 @@ means Emacs will crash if FORMULA contains a circular list." ,@(and irrelevant (list :irrelevant irrelevant))) errors))))) (if errors - (warn "---------------------------------------------------------------- + (warn "---------------------------------------------------------------- Some references were corrupted. The following is a list where each element ELT is such @@ -917,17 +908,12 @@ the old and FORCE is nil." (let ((oldval (ses-cell-value cell)) (formula (ses-cell-formula cell)) newval - this-cell-Dijkstra-attempt-h - this-cell-Dijkstra-attempt - this-cell-Dijkstra-attempt+1 - ref-cell-Dijkstra-attempt-h - ref-cell-Dijkstra-attempt - ref-rowcol) + this-cell-Dijkstra-attempt+1) (when (eq (car-safe formula) 'ses-safe-formula) (setq formula (ses-safe-formula (cadr formula))) (ses-set-cell row col 'formula formula)) (condition-case sig - (setq newval (eval formula)) + (setq newval (eval formula t)) (error ;; Variable `sig' can't be nil. (nconc sig (list (ses-cell-symbol cell))) @@ -938,46 +924,42 @@ the old and FORCE is nil." (setq newval '*skip*)) (catch 'cycle (when (or force (not (eq newval oldval))) - (add-to-list 'ses--deferred-write (cons row col)) ; In case force=t. - (setq this-cell-Dijkstra-attempt-h - (ses-cell-property-get-handle :ses-Dijkstra-attempt cell); - this-cell-Dijkstra-attempt - (ses-cell-property-handle-car this-cell-Dijkstra-attempt-h)) - (if (null this-cell-Dijkstra-attempt) - (ses-cell-property-handle-setcar - this-cell-Dijkstra-attempt-h - (setq this-cell-Dijkstra-attempt - (cons ses--Dijkstra-attempt-nb 0))) - (unless (= ses--Dijkstra-attempt-nb - (car this-cell-Dijkstra-attempt)) - (setcar this-cell-Dijkstra-attempt ses--Dijkstra-attempt-nb) - (setcdr this-cell-Dijkstra-attempt 0))) - (setq this-cell-Dijkstra-attempt+1 - (1+ (cdr this-cell-Dijkstra-attempt))) + (cl-pushnew (cons row col) ses--deferred-write :test #'equal) ; In case force=t. + (ses--letref (pget pset) + (ses-cell-property :ses-Dijkstra-attempt cell) + (let ((this-cell-Dijkstra-attempt (pget))) + (if (null this-cell-Dijkstra-attempt) + (pset + (setq this-cell-Dijkstra-attempt + (cons ses--Dijkstra-attempt-nb 0))) + (unless (= ses--Dijkstra-attempt-nb + (car this-cell-Dijkstra-attempt)) + (setcar this-cell-Dijkstra-attempt ses--Dijkstra-attempt-nb) + (setcdr this-cell-Dijkstra-attempt 0))) + (setq this-cell-Dijkstra-attempt+1 + (1+ (cdr this-cell-Dijkstra-attempt))))) (ses-set-cell row col 'value newval) (dolist (ref (ses-cell-references cell)) - (add-to-list 'ses--deferred-recalc ref) - (setq ref-rowcol (ses-sym-rowcol ref) - ref-cell-Dijkstra-attempt-h - (ses-cell-property-get-handle - :ses-Dijkstra-attempt - (car ref-rowcol) (cdr ref-rowcol)) - ref-cell-Dijkstra-attempt - (ses-cell-property-handle-car ref-cell-Dijkstra-attempt-h)) - - (if (null ref-cell-Dijkstra-attempt) - (ses-cell-property-handle-setcar - ref-cell-Dijkstra-attempt-h - (setq ref-cell-Dijkstra-attempt - (cons ses--Dijkstra-attempt-nb - this-cell-Dijkstra-attempt+1))) - (if (= (car ref-cell-Dijkstra-attempt) ses--Dijkstra-attempt-nb) - (setcdr ref-cell-Dijkstra-attempt - (max (cdr ref-cell-Dijkstra-attempt) - this-cell-Dijkstra-attempt+1)) - (setcar ref-cell-Dijkstra-attempt ses--Dijkstra-attempt-nb) - (setcdr ref-cell-Dijkstra-attempt - this-cell-Dijkstra-attempt+1))) + (cl-pushnew ref ses--deferred-recalc) + (ses--letref (pget pset) + (let ((ref-rowcol (ses-sym-rowcol ref))) + (ses-cell-property + :ses-Dijkstra-attempt + (car ref-rowcol) (cdr ref-rowcol))) + (let ((ref-cell-Dijkstra-attempt (pget))) + + (if (null ref-cell-Dijkstra-attempt) + (pset + (setq ref-cell-Dijkstra-attempt + (cons ses--Dijkstra-attempt-nb + this-cell-Dijkstra-attempt+1))) + (if (= (car ref-cell-Dijkstra-attempt) ses--Dijkstra-attempt-nb) + (setcdr ref-cell-Dijkstra-attempt + (max (cdr ref-cell-Dijkstra-attempt) + this-cell-Dijkstra-attempt+1)) + (setcar ref-cell-Dijkstra-attempt ses--Dijkstra-attempt-nb) + (setcdr ref-cell-Dijkstra-attempt + this-cell-Dijkstra-attempt+1))))) (when (> this-cell-Dijkstra-attempt+1 ses--Dijkstra-weight-bound) ;; Update print of this cell. @@ -1036,7 +1018,7 @@ if the cell's value is unchanged and FORCE is nil." (when (or (memq ref curlist) (memq ref ses--deferred-recalc)) ;; This cell refers to another that isn't done yet - (add-to-list 'ses--deferred-recalc this-sym) + (cl-pushnew this-sym ses--deferred-recalc :test #'equal) (throw 'ref t))))) ;; ses-update-cells is called from post-command-hook, so ;; inhibit-quit is implicitly bound to t. @@ -1045,7 +1027,7 @@ if the cell's value is unchanged and FORCE is nil." (error "Quit")) (ses-calculate-cell (car this-rowcol) (cdr this-rowcol) force))) (dolist (ref ses--deferred-recalc) - (add-to-list 'nextlist ref))) + (cl-pushnew ref nextlist :test #'equal))) (when ses--deferred-recalc ;; Just couldn't finish these. (dolist (x ses--deferred-recalc) @@ -1123,6 +1105,9 @@ A single cell is appropriate unless some argument is 'needrange." ((memq 'needrange args) (error "Need a range")))) +(defvar ses--row) +(defvar ses--col) + (defun ses-print-cell (row col) "Format and print the value of cell (ROW,COL) to the print area. Use the cell's printer function. If the cell's new print form is too wide, @@ -1150,10 +1135,13 @@ preceding cell has spilled over." (ses-set-cell row col 'printer (setq printer (ses-safe-printer (cadr printer))))) ;; Print the value. - (setq text (ses-call-printer (or printer - (ses-col-printer col) - ses--default-printer) - value)) + (setq text + (let ((ses--row row) + (ses--col col)) + (ses-call-printer (or printer + (ses-col-printer col) + ses--default-printer) + value))) (if (consp ses-call-printer-return) ;; Printer returned an error. (setq sig ses-call-printer-return)))) @@ -1164,7 +1152,8 @@ preceding cell has spilled over." ((< len width) ;; Fill field to length with spaces. (setq len (make-string (- width len) ?\s) - text (if (eq ses-call-printer-return t) + text (if (or (stringp value) + (eq ses-call-printer-return t)) (concat text len) (concat len text)))) ((> len width) @@ -1261,7 +1250,15 @@ printer signaled one (and \"%s\" is used as the default printer), else nil." (format (car printer) value) "")) (t - (setq value (funcall printer (or value ""))) + (setq value + (funcall + (or (and (symbolp printer) + (let ((locprn (gethash printer + ses--local-printer-hashmap))) + (and locprn + (ses--locprn-compiled locprn)))) + printer) + (or value ""))) (if (stringp value) value (or (stringp (car-safe value)) @@ -1334,6 +1331,24 @@ ses--default-printer, ses--numrows, or ses--numcols." (goto-char ses--params-marker) (forward-line def)))) +(defun ses-file-format-extend-parameter-list (new-file-format) + "Extend the global parameters list when file format is updated +from 2 to 3. This happens when local printer function are added +to a sheet that was created with SES version 2. This is not +undoable. Return nil when there was no change, and non nil otherwise." + (save-excursion + (cond + ((and (= ses--file-format 2) (= 3 new-file-format)) + (ses-set-parameter 'ses--file-format 3) + (message "Upgrading from SES-2 to SES-3 file format") + (ses-widen) + (goto-char ses--params-marker) + (forward-line (plist-get ses-paramlines-plist 'ses--numlocprn )) + (insert (format (plist-get ses-paramfmt-plist 'ses--numlocprn) + ses--numlocprn) + ?\n) + t) ))) + (defun ses-set-parameter (def value &optional elem) "Set parameter DEF to VALUE (with undo) and write the value to the data area. See `ses-goto-data' for meaning of DEF. Newlines in the data are escaped. @@ -1343,13 +1358,7 @@ If ELEM is specified, it is the array subscript within DEF to be set to VALUE." ;; in case one of them is being changed. (ses-goto-data def) (let ((inhibit-read-only t) - (fmt (plist-get '(ses--col-widths "(ses-column-widths %S)" - ses--col-printers "(ses-column-printers %S)" - ses--default-printer "(ses-default-printer %S)" - ses--header-row "(ses-header-row %S)" - ses--file-format " %S ;SES file-format" - ses--numrows " %S ;numrows" - ses--numcols " %S ;numcols") + (fmt (plist-get ses-paramfmt-plist def)) oldval) (if elem @@ -1375,8 +1384,8 @@ Newlines in the data are escaped." (with-temp-message " " (save-excursion (while ses--deferred-write - (ses-time-check "Writing... (%d cells left)" - '(length ses--deferred-write)) + (ses--time-check "Writing... (%d cells left)" + (length ses--deferred-write)) (setq rowcol (pop ses--deferred-write) row (car rowcol) col (cdr rowcol) @@ -1388,24 +1397,17 @@ Newlines in the data are escaped." (setq formula (cadr formula))) (if (eq (car-safe printer) 'ses-safe-printer) (setq printer (cadr printer))) - ;; This is noticeably faster than (format "%S %S %S %S %S") - (setq text (concat "(ses-cell " - (symbol-name sym) - " " - (prin1-to-string (symbol-value sym)) - " " - (prin1-to-string formula) - " " - (prin1-to-string printer) - " " - (if (atom (ses-cell-references cell)) - "nil" - (concat "(" - (mapconcat 'symbol-name - (ses-cell-references cell) - " ") - ")")) - ")")) + (setq text (prin1-to-string + ;; We could shorten it to (ses-cell SYM VAL) when + ;; the other parameters are nil, but in practice most + ;; cells have non-nil `references', so it's + ;; rather pointless. + `(ses-cell ,sym + ,(symbol-value sym) + ,(unless (equal formula (symbol-value sym)) + formula) + ,printer + ,(ses-cell-references cell)))) (ses-goto-data row col) (delete-region (point) (line-end-position)) (insert text))) @@ -1422,8 +1424,8 @@ refers to. For recursive calls, RESULT-SO-FAR is the list being constructed, or t to get a wrong-type-argument error when the first reference is found." (if (ses-sym-rowcol formula) - ;;Entire formula is one symbol - (add-to-list 'result-so-far formula) + ;; Entire formula is one symbol. + (cl-pushnew formula result-so-far :test #'equal) (if (consp formula) (cond ((eq (car formula) 'ses-range) @@ -1431,7 +1433,7 @@ first reference is found." (cdr (funcall 'macroexpand (list 'ses-range (nth 1 formula) (nth 2 formula))))) - (add-to-list 'result-so-far cur))) + (cl-pushnew cur result-so-far :test #'equal))) ((null (eq (car formula) 'quote)) ;;Recursive call for subformulas (dolist (cur formula) @@ -1600,8 +1602,8 @@ to each symbol." ;; This cell referred to a cell that's been deleted or is no ;; longer part of the range. We can't fix that now because ;; reference lists cells have been partially updated. - (add-to-list 'ses--deferred-recalc - (ses-create-cell-symbol row col))) + (cl-pushnew (ses-create-cell-symbol row col) + ses--deferred-recalc :test #'equal)) (setq newval (ses-relocate-formula (ses-cell-references mycell) minrow mincol rowincr colincr)) (ses-set-cell row col 'references newval) @@ -1673,7 +1675,7 @@ to each symbol." (let (row col) (setq ses-start-time (float-time)) (while reform - (ses-time-check "Fixing ses-ranges... (%d left)" '(length reform)) + (ses--time-check "Fixing ses-ranges... (%d left)" (length reform)) (setq row (caar reform) col (cdar reform) reform (cdr reform)) @@ -1691,36 +1693,30 @@ to each symbol." (insert-and-inherit "X") (delete-region (1- (point)) (point)))) -(defun ses-set-with-undo (sym newval) - "Like set, but undoable. Result is t if value has changed." - ;; We try to avoid adding redundant entries to the undo list, but this is - ;; unavoidable for strings because equal ignores text properties and there's - ;; no easy way to get the whole property list to see if it's different! - (unless (and (boundp sym) - (equal (symbol-value sym) newval) - (not (stringp newval))) - (push (if (boundp sym) - `(apply ses-set-with-undo ,sym ,(symbol-value sym)) - `(apply ses-unset-with-undo ,sym)) - buffer-undo-list) - (set sym newval) - t)) - -(defun ses-unset-with-undo (sym) - "Set SYM to be unbound. This is undoable." - (when (1value (boundp sym)) ; Always bound, except after a programming error. - (push `(apply ses-set-with-undo ,sym ,(symbol-value sym)) buffer-undo-list) - (makunbound sym))) +(defun ses-setter-with-undo (accessors newval &rest args) + "Set a field/variable and record it so it can be undone. +Result is non-nil if field/variable has changed." + (let ((oldval (apply (car accessors) args))) + (unless (equal-including-properties oldval newval) + (push `(apply ses-setter-with-undo ,accessors ,oldval ,@args) + buffer-undo-list) + (apply (cdr accessors) newval args) + t))) (defun ses-aset-with-undo (array idx newval) - "Like `aset', but undoable. -Result is t if element has changed." - (unless (equal (aref array idx) newval) - (push `(apply ses-aset-with-undo ,array ,idx - ,(aref array idx)) buffer-undo-list) - (aset array idx newval) - t)) + (ses-setter-with-undo (eval-when-compile + (cons #'aref + (lambda (newval array idx) (aset array idx newval)))) + newval array idx)) +(defun ses-set-with-undo (sym newval) + (ses-setter-with-undo + (eval-when-compile + (cons (lambda (sym) (if (boundp sym) (symbol-value sym) :ses--unbound)) + (lambda (newval sym) (if (eq newval :ses--unbound) + (makunbound sym) + (set sym newval))))) + newval sym)) ;;---------------------------------------------------------------------------- ;; Startup for major mode @@ -1735,29 +1731,38 @@ Does not execute cell formulas or print functions." (search-backward ";; Local Variables:\n" nil t) (backward-list 1) (setq ses--params-marker (point-marker)) - (let ((params (ignore-errors (read (current-buffer))))) - (or (and (= (safe-length params) 3) + (let* ((params (ignore-errors (read (current-buffer)))) + (params-len (safe-length params))) + (or (and (>= params-len 3) + (<= params-len 4) (numberp (car params)) (numberp (cadr params)) (>= (cadr params) 0) (numberp (nth 2 params)) - (> (nth 2 params) 0)) + (> (nth 2 params) 0) + (or (<= params-len 3) + (let ((numlocprn (nth 3 params))) + (and (integerp numlocprn) (>= numlocprn 0))))) (error "Invalid SES file")) (setq ses--file-format (car params) ses--numrows (cadr params) - ses--numcols (nth 2 params)) + ses--numcols (nth 2 params) + ses--numlocprn (or (nth 3 params) 0)) (when (= ses--file-format 1) (let (buffer-undo-list) ; This is not undoable. (ses-goto-data 'ses--header-row) (insert "(ses-header-row 0)\n") - (ses-set-parameter 'ses--file-format 2) - (message "Upgrading from SES-1 file format"))) - (or (= ses--file-format 2) + (ses-set-parameter 'ses--file-format 3) + (message "Upgrading from SES-1 to SES-2 file format"))) + (or (<= ses--file-format 3) (error "This file needs a newer version of the SES library code")) ;; Initialize cell array. (setq ses--cells (make-vector ses--numrows nil)) (dotimes (row ses--numrows) - (aset ses--cells row (make-vector ses--numcols nil)))) + (aset ses--cells row (make-vector ses--numcols nil))) + ;; initialize local printer map. + (clrhash ses--local-printer-hashmap)) + ;; Skip over print area, which we assume is correct. (goto-char (point-min)) (forward-line ses--numrows) @@ -1767,8 +1772,23 @@ Does not execute cell formulas or print functions." (setq ses--data-marker (point-marker)) (forward-char (1- (length ses-print-data-boundary))) ;; Initialize printer and symbol lists. - (mapc 'ses-printer-record ses-standard-printer-functions) - (setq ses--symbolic-formulas nil) + (mapc #'ses-printer-record ses-standard-printer-functions) + (setq ses--symbolic-formulas nil) + + ;; Load local printer definitions. + ;; This must be loaded *BEFORE* cells and column printers because the latter + ;; may call them. + (save-excursion + (forward-line (* ses--numrows (1+ ses--numcols))) + (let ((numlocprn ses--numlocprn)) + (setq ses--numlocprn 0) + (dotimes (_ numlocprn) + (let ((x (read (current-buffer)))) + (or (and (looking-at-p "\n") + (eq (car-safe x) 'ses-local-printer) + (apply #'ses--local-printer (cdr x))) + (error "local printer-def error")) + (setq ses--numlocprn (1+ ses--numlocprn)))))) ;; Load cell definitions. (dotimes (row ses--numrows) (dotimes (col ses--numcols) @@ -1778,9 +1798,11 @@ Does not execute cell formulas or print functions." (eq (car-safe x) 'ses-cell) (ses-create-cell-variable sym row col)) (error "Cell-def error")) - (eval x))) + (apply #'ses--cell (cdr x)))) (or (looking-at-p "\n\n") (error "Missing blank line between rows"))) + ;; Skip local printer function declaration --- that were already loaded. + (forward-line (+ 2 ses--numlocprn)) ;; Load global parameters. (let ((widths (read (current-buffer))) (n1 (char-after (point))) @@ -1799,14 +1821,13 @@ Does not execute cell formulas or print functions." (eq (car-safe head-row) 'ses-header-row) (= n4 ?\n)) (error "Invalid SES global parameters")) - (1value (eval widths)) - (1value (eval def-printer)) - (1value (eval printers)) - (1value (eval head-row))) + (1value (eval widths t)) + (1value (eval def-printer t)) + (1value (eval printers t)) + (1value (eval head-row t))) ;; Should be back at global-params. (forward-char 1) - (or (looking-at-p (replace-regexp-in-string "1" "[0-9]+" - ses-initial-global-parameters)) + (or (looking-at-p ses-initial-global-parameters-re) (error "Problem with column-defs or global-params")) ;; Check for overall newline count in definitions area. (forward-line 3) @@ -1822,45 +1843,42 @@ Narrows the buffer to show only the print area. Gives it `read-only' and `intangible' properties. Sets up highlighting for current cell." (interactive) (let ((end (point-min)) - (inhibit-read-only t) (inhibit-point-motion-hooks t) - (was-modified (buffer-modified-p)) pos sym) - (ses-goto-data 0 0) ; Include marker between print-area and data-area. - (set-text-properties (point) (point-max) nil) ; Delete garbage props. - (mapc 'delete-overlay (overlays-in (point-min) (point-max))) - ;; The print area is read-only (except for our special commands) and uses a - ;; special keymap. - (put-text-property (point-min) (1- (point)) 'read-only 'ses) - (put-text-property (point-min) (1- (point)) 'keymap 'ses-mode-print-map) - ;; For the beginning of the buffer, we want the read-only and keymap - ;; attributes to be inherited from the first character. - (put-text-property (point-min) (1+ (point-min)) 'front-sticky t) - ;; Create intangible properties, which also indicate which cell the text - ;; came from. - (dotimes-with-progress-reporter (row ses--numrows) "Finding cells..." - (dotimes (col ses--numcols) - (setq pos end - sym (ses-cell-symbol row col)) - ;; Include skipped cells following this one. - (while (and (< col (1- ses--numcols)) - (eq (ses-cell-value row (1+ col)) '*skip*)) - (setq end (+ end (ses-col-width col) 1) - col (1+ col))) - (setq end (save-excursion - (goto-char pos) - (move-to-column (+ (current-column) (- end pos) - (ses-col-width col))) - (if (eolp) - (+ end (ses-col-width col) 1) - (forward-char) - (point)))) - (put-text-property pos end 'intangible sym))) - ;; Adding these properties did not actually alter the text. - (unless was-modified - (restore-buffer-modified-p nil) - (buffer-disable-undo) - (buffer-enable-undo))) + (with-silent-modifications + (ses-goto-data 0 0) ; Include marker between print-area and data-area. + (set-text-properties (point) (point-max) nil) ; Delete garbage props. + (mapc #'delete-overlay (overlays-in (point-min) (point-max))) + ;; The print area is read-only (except for our special commands) and + ;; uses a special keymap. + (put-text-property (point-min) (1- (point)) 'read-only 'ses) + (put-text-property (point-min) (1- (point)) 'keymap 'ses-mode-print-map) + ;; For the beginning of the buffer, we want the read-only and keymap + ;; attributes to be inherited from the first character. + (put-text-property (point-min) (1+ (point-min)) 'front-sticky t) + ;; Create intangible properties, which also indicate which cell the text + ;; came from. + (dotimes-with-progress-reporter (row ses--numrows) "Finding cells..." + (dotimes (col ses--numcols) + (setq pos end + sym (ses-cell-symbol row col)) + (unless (eq (symbol-value sym) '*skip*) + ;; Include skipped cells following this one. + (while (and (< col (1- ses--numcols)) + (eq (ses-cell-value row (1+ col)) '*skip*)) + (setq end (+ end (ses-col-width col) 1) + ;; Beware: Modifying the iteration variable of `dotimes' + ;; may or may not affect the iteration! + col (1+ col))) + (setq end (save-excursion + (goto-char pos) + (move-to-column (+ (current-column) (- end pos) + (ses-col-width col))) + (if (eolp) + (+ end (ses-col-width col) 1) + (forward-char) + (point)))) + (put-text-property pos end 'intangible sym)))))) ;; Create the underlining overlay. It's impossible for (point) to be 2, ;; because column A must be at least 1 column wide. (setq ses--curcell-overlay (make-overlay (1+ (point-min)) (1+ (point-min)))) @@ -1880,7 +1898,7 @@ Delete overlays, remove special text properties." ;; Delete read-only, keymap, and intangible properties. (set-text-properties (point-min) (point-max) nil) ;; Delete overlay. - (mapc 'delete-overlay (overlays-in (point-min) (point-max))) + (mapc #'delete-overlay (overlays-in (point-min) (point-max))) (unless was-modified (restore-buffer-modified-p nil)))) @@ -1938,7 +1956,8 @@ formula: ;; calculation). indent-tabs-mode nil) (1value (add-hook 'change-major-mode-hook 'ses-cleanup nil t)) - (1value (add-hook 'before-revert-hook 'ses-cleanup nil t)) + ;; This makes revert impossible if the buffer is read-only. + ;; (1value (add-hook 'before-revert-hook 'ses-cleanup nil t)) (setq header-line-format '(:eval (progn (when (/= (window-hscroll) ses--header-hscroll) @@ -2085,7 +2104,7 @@ Based on the current set of columns and `window-hscroll' position." (push (propertize (format " [row %d]" ses--header-row) 'display '((height (- 1)))) result)) - (setq ses--header-string (apply 'concat (nreverse result))))) + (setq ses--header-string (apply #'concat (nreverse result))))) ;;---------------------------------------------------------------------------- @@ -2122,7 +2141,7 @@ print area if NONARROW is nil." (delete-region (point-min) (point)) ;; Insert all blank lines before printing anything, so ses-print-cell can ;; find the data area when inserting or deleting *skip* values for cells. - (dotimes (row ses--numrows) + (dotimes (_ ses--numrows) (insert-and-inherit ses--blank-line)) (dotimes-with-progress-reporter (row ses--numrows) "Reprinting..." (if (eq (ses-cell-value row 0) '*skip*) @@ -2137,6 +2156,14 @@ print area if NONARROW is nil." (setq ses--Dijkstra-attempt-nb (1+ ses--Dijkstra-attempt-nb) ses--Dijkstra-weight-bound (* ses--numrows ses--numcols))) +;; These functions use the variables 'row' and 'col' that are dynamically bound +;; by ses-print-cell. We define these variables at compile-time to make the +;; compiler happy. +;; (defvar row) +;; (defvar col) +;; (defvar maxrow) +;; (defvar maxcol) + (defun ses-recalculate-cell () "Recalculate and reprint the current cell or range. @@ -2154,29 +2181,30 @@ to are recalculated first." (when (setq cur-rowcol (ses-sym-rowcol ses--curcell) sig (progn - (ses-cell-property-set :ses-Dijkstra-attempt - (cons ses--Dijkstra-attempt-nb 0) - (car cur-rowcol) (cdr cur-rowcol) ) + (setf (ses-cell-property :ses-Dijkstra-attempt + (car cur-rowcol) + (cdr cur-rowcol)) + (cons ses--Dijkstra-attempt-nb 0)) (ses-calculate-cell (car cur-rowcol) (cdr cur-rowcol) t))) (nconc sig (list (ses-cell-symbol (car cur-rowcol) (cdr cur-rowcol))))) ;; First, recalculate all cells that don't refer to other cells and ;; produce a list of cells with references. (ses-dorange ses--curcell - (ses-time-check "Recalculating... %s" '(ses-cell-symbol row col)) + (ses--time-check "Recalculating... %s" (ses-cell-symbol row col)) (condition-case nil (progn ;; The t causes an error if the cell has references. If no ;; references, the t will be the result value. (1value (ses-formula-references (ses-cell-formula row col) t)) - (ses-cell-property-set :ses-Dijkstra-attempt - (cons ses--Dijkstra-attempt-nb 0) - row col) + (setf (ses-cell-property :ses-Dijkstra-attempt row col) + (cons ses--Dijkstra-attempt-nb 0)) (when (setq sig (ses-calculate-cell row col t)) (nconc sig (list (ses-cell-symbol row col))))) (wrong-type-argument ;; The formula contains a reference. - (add-to-list 'ses--deferred-recalc (ses-cell-symbol row col)))))) + (cl-pushnew (ses-cell-symbol row col) ses--deferred-recalc + :test #'equal))))) ;; Do the update now, so we can force recalculation. (let ((x ses--deferred-recalc)) (setq ses--deferred-recalc nil) @@ -2211,8 +2239,10 @@ to are recalculated first." (eq (ses-cell-value row (1+ col)) '*skip*)) ;; This cell has spill-over. We'll momentarily pretend the following cell ;; has a `t' in it. - (eval `(let ((,(ses-cell-symbol row (1+ col)) t)) - (ses-print-cell row col))) + (cl-progv + (list (ses-cell-symbol row (1+ col))) + '(t) + (ses-print-cell row col)) ;; Now remove the *skip*. ses-print-cell is always nil here. (ses-set-cell row (1+ col) 'value nil) (1value (ses-print-cell row (1+ col)))))) @@ -2251,7 +2281,7 @@ to are recalculated first." (insert ses-initial-file-trailer) (goto-char (point-min))) ;; Create a blank display area. - (dotimes (row ses--numrows) + (dotimes (_ ses--numrows) (insert ses--blank-line)) (insert ses-print-data-boundary) (backward-char (1- (length ses-print-data-boundary))) @@ -2321,16 +2351,23 @@ cell formula was unsafe and user declined confirmation." (barf-if-buffer-read-only) (list (car rowcol) (cdr rowcol) - (read-from-minibuffer - (format "Cell %s: " ses--curcell) - (cons (if (equal initial "\"") "\"\"" - (if (equal initial "(") "()" initial)) 2) - ses-mode-edit-map - t ; Convert to Lisp object. - 'ses-read-cell-history - (prin1-to-string (if (eq (car-safe curval) 'ses-safe-formula) - (cadr curval) - curval)))))) + (if (equal initial "\"") + (progn + (if (not (stringp curval)) (setq curval nil)) + (read-string (if curval + (format "String Cell %s (default %s): " + ses--curcell curval) + (format "String Cell %s: " ses--curcell)) + nil 'ses-read-string-history curval)) + (read-from-minibuffer + (format "Cell %s: " ses--curcell) + (cons (if (equal initial "(") "()" initial) 2) + ses-mode-edit-map + t ; Convert to Lisp object. + 'ses-read-cell-history + (prin1-to-string (if (eq (car-safe curval) 'ses-safe-formula) + (cadr curval) + curval))))))) (when (ses-edit-cell row col newval) (ses-command-hook) ; Update cell widths before movement. (dolist (x ses-after-entry-functions) @@ -2363,7 +2400,7 @@ With prefix, deletes several cells." (1value (ses-clear-cell-backward (- count))) (ses-check-curcell) (ses-begin-change) - (dotimes (x count) + (dotimes (_ count) (ses-set-curcell) (let ((rowcol (ses-sym-rowcol ses--curcell))) (or rowcol (signal 'end-of-buffer nil)) @@ -2378,7 +2415,7 @@ cells." (1value (ses-clear-cell-forward (- count))) (ses-check-curcell 'end) (ses-begin-change) - (dotimes (x count) + (dotimes (_ count) (backward-char 1) ; Will signal 'beginning-of-buffer if appropriate. (ses-set-curcell) (let ((rowcol (ses-sym-rowcol ses--curcell))) @@ -2390,12 +2427,14 @@ cells." ;;---------------------------------------------------------------------------- (defun ses-read-printer (prompt default) - "Common code for `ses-read-cell-printer', `ses-read-column-printer', and `ses-read-default-printer'. -PROMPT should end with \": \". Result is t if operation was canceled." + "Common code for functions `ses-read-cell-printer', `ses-read-column-printer', +`ses-read-default-printer' and `ses-define-local-printer'. +PROMPT should end with \": \". Result is t if operation was +canceled." (barf-if-buffer-read-only) (if (eq default t) (setq default "") - (setq prompt (format "%s [currently %S]: " + (setq prompt (format "%s (default %S): " (substring prompt 0 -2) default))) (let ((new (read-from-minibuffer prompt @@ -2411,6 +2450,7 @@ PROMPT should end with \": \". Result is t if operation was canceled." (or (not new) (stringp new) (stringp (car-safe new)) + (and (symbolp new) (gethash new ses--local-printer-hashmap)) (ses-warn-unsafe new 'unsafep-function) (setq new t))) new)) @@ -2425,21 +2465,20 @@ one argument, or a symbol that names a function of one argument. In the latter two cases, the function's result should be either a string (will be right-justified) or a list of one string (will be left-justified)." (interactive - (let ((default t) - x) + (let ((default t)) (ses-check-curcell 'range) ;;Default is none if not all cells in range have same printer (catch 'ses-read-cell-printer (ses-dorange ses--curcell - (setq x (ses-cell-printer row col)) - (if (eq (car-safe x) 'ses-safe-printer) - (setq x (cadr x))) - (if (eq default t) - (setq default x) - (unless (equal default x) - ;;Range contains differing printer functions - (setq default t) - (throw 'ses-read-cell-printer t))))) + (let ((x (ses-cell-printer row col))) + (if (eq (car-safe x) 'ses-safe-printer) + (setq x (cadr x))) + (if (eq default t) + (setq default x) + (unless (equal default x) + ;;Range contains differing printer functions + (setq default t) + (throw 'ses-read-cell-printer t)))))) (list (ses-read-printer (format "Cell %S printer: " ses--curcell) default)))) (unless (eq newval t) @@ -2718,7 +2757,7 @@ inserts a new row if at bottom of print area. Repeat COUNT times." (list col (if current-prefix-arg (prefix-numeric-value current-prefix-arg) - (read-from-minibuffer (format "Column %s width [currently %d]: " + (read-from-minibuffer (format "Column %s width (default %d): " (ses-column-letter col) (ses-col-width col)) nil ; No initial contents. @@ -2773,7 +2812,7 @@ SES attributes recording the contents of the cell as of the time of copying." ;;Avoid overflow situation (setq end (1- ses--data-marker))) (let* ((inhibit-point-motion-hooks t) - (x (mapconcat 'ses-copy-region-helper + (x (mapconcat #'ses-copy-region-helper (extract-rectangle beg (1- end)) "\n"))) (remove-text-properties 0 (length x) '(read-only t @@ -2957,9 +2996,9 @@ cons of ROW and COL). Treat plain symbols as strings unless ARG is a list." ;; Invalid sexp --- leave it as a string. (setq val (substring text from to))) ((and (car val) (symbolp (car val))) - (if (consp arg) - (setq val (list 'quote (car val))) ; Keep symbol. - (setq val (substring text from to)))) ; Treat symbol as text. + (setq val (if (consp arg) + (list 'quote (car val)) ; Keep symbol. + (substring text from to)))) ; Treat symbol as text. (t (setq val (car val)))) (let ((row (car rowcol)) @@ -3078,7 +3117,7 @@ is non-nil. Newlines and tabs in the export text are escaped." (push "\t" result)) ((< row maxrow) (push "\n" result)))) - (setq result (apply 'concat (nreverse result))) + (setq result (apply #'concat (nreverse result))) (kill-new result))) @@ -3305,29 +3344,31 @@ highlighted range in the spreadsheet." (if (equal new-rowcol rowcol) (put new-name 'ses-cell rowcol) (error "Not a valid name for this cell location")) - (setq ses--named-cell-hashmap (or ses--named-cell-hashmap (make-hash-table :test 'eq))) + (setq ses--named-cell-hashmap + (or ses--named-cell-hashmap (make-hash-table :test 'eq))) (put new-name 'ses-cell :ses-named) (puthash new-name rowcol ses--named-cell-hashmap)) (push `(ses-rename-cell ,old-name ,cell) buffer-undo-list) - ;; replace name by new name in formula of cells refering to renamed cell + ;; Replace name by new name in formula of cells refering to renamed cell. (dolist (ref (ses-cell-references cell)) (let* ((x (ses-sym-rowcol ref)) (xcell (ses-get-cell (car x) (cdr x)))) - (ses-cell-formula-aset xcell - (ses-replace-name-in-formula - (ses-cell-formula xcell) - sym - new-name)))) - ;; replace name by new name in reference list of cells to which renamed cell refers to + (setf (ses-cell-formula xcell) + (ses-replace-name-in-formula + (ses-cell-formula xcell) + sym + new-name)))) + ;; Replace name by new name in reference list of cells to which renamed + ;; cell refers to. (dolist (ref (ses-formula-references (ses-cell-formula cell))) (let* ((x (ses-sym-rowcol ref)) (xcell (ses-get-cell (car x) (cdr x)))) - (ses-cell-references-aset xcell - (cons new-name (delq sym - (ses-cell-references xcell)))))) + (setf (ses-cell-references xcell) + (cons new-name (delq sym + (ses-cell-references xcell)))))) (push new-name ses--renamed-cell-symb-list) (set new-name (symbol-value sym)) - (aset cell 0 new-name) + (setf (ses-cell--symbol cell) new-name) (makunbound sym) (and curcell (setq ses--curcell new-name)) (let* ((pos (point)) @@ -3344,6 +3385,75 @@ highlighted range in the spreadsheet." (symbol-name new-name))) (force-mode-line-update))) +(defun ses-refresh-local-printer (name _compiled-value) ;FIXME: unused arg? + "Refresh printout for all cells which use printer NAME. +NAME should be the name of a locally defined printer. +Uses the value COMPILED-VALUE for this printer." + (message "Refreshing cells using printer %S" name) + (let (new-print) + (dotimes (row ses--numrows) + (dotimes (col ses--numcols) + (let ((cell-printer (ses-cell-printer row col))) + (when (eq cell-printer name) + (unless new-print + (setq new-print t) + (ses-begin-change)) + (ses-print-cell row col))))))) + +(defun ses-define-local-printer (name) + "Define a local printer with name NAME." + (interactive "*SEnter printer name: ") + (let* ((cur-printer (gethash name ses--local-printer-hashmap)) + (default (and (vectorp cur-printer) (ses--locprn-def cur-printer))) + create-printer + (new-def + (ses-read-printer (format "Enter definition of printer %S: " name) + default))) + (cond + ;; cancelled operation => do nothing + ((eq new-def t)) + ;; no change => do nothing + ((and (vectorp cur-printer) (equal new-def default))) + ;; re-defined printer + ((vectorp cur-printer) + (setq create-printer 0) + (setf (ses--locprn-def cur-printer) new-def) + (ses-refresh-local-printer + name + (setf (ses--locprn-compiled cur-printer) + (ses-local-printer-compile new-def)))) + ;; new definition + (t + (setq create-printer 1) + (puthash name + (setq cur-printer + (ses-make-local-printer-info new-def)) + ses--local-printer-hashmap))) + (when create-printer + (let ((printer-def-text + (concat + "(ses-local-printer " + (symbol-name name) + " " + (prin1-to-string (ses--locprn-def cur-printer)) + ")"))) + (save-excursion + (ses-goto-data ses--numrows + (ses--locprn-number cur-printer)) + (let ((inhibit-read-only t)) + ;; Special undo since it's outside the narrowed buffer. + (let (buffer-undo-list) + (if (= create-printer 0) + (delete-region (point) (line-end-position)) + (insert ?\n) + (backward-char)) + (insert printer-def-text) + (when (= create-printer 1) + (ses-file-format-extend-parameter-list 3) + (ses-set-parameter 'ses--numlocprn + (+ ses--numlocprn create-printer)))))))))) + + ;;---------------------------------------------------------------------------- ;; Checking formulas for safety ;;---------------------------------------------------------------------------- @@ -3353,6 +3463,7 @@ highlighted range in the spreadsheet." (if (or (stringp printer) (stringp (car-safe printer)) (not printer) + (and (symbolp printer) (gethash printer ses--local-printer-hashmap)) (ses-warn-unsafe printer 'unsafep-function)) printer 'ses-unsafe)) @@ -3479,7 +3590,7 @@ Use `math-format-value' as a printer for Calc objects." (setcdr (last result 2) nil) (setq result (cdr (nreverse result)))) (unless reorient-x - (setq result (mapcar 'nreverse result))) + (setq result (mapcar #'nreverse result))) (when transpose (let ((ret (mapcar (lambda (x) (list x)) (pop result))) iter) (while result @@ -3491,7 +3602,7 @@ Use `math-format-value' as a printer for Calc objects." (cl-flet ((vectorize-*1 (clean result) - (cons clean (cons (quote 'vec) (apply 'append result)))) + (cons clean (cons (quote 'vec) (apply #'append result)))) (vectorize-*2 (clean result) (cons clean (cons (quote 'vec) @@ -3499,7 +3610,7 @@ Use `math-format-value' as a printer for Calc objects." (cons clean (cons (quote 'vec) x))) result))))) (pcase vectorize - (`nil (cons clean (apply 'append result))) + (`nil (cons clean (apply #'append result))) (`*1 (vectorize-*1 clean result)) (`*2 (vectorize-*2 clean result)) (`* (funcall (if (cdr result) @@ -3517,13 +3628,13 @@ Use `math-format-value' as a printer for Calc objects." (defun ses+ (&rest args) "Compute the sum of the arguments, ignoring blanks." - (apply '+ (apply 'ses-delete-blanks args))) + (apply #'+ (apply #'ses-delete-blanks args))) (defun ses-average (list) "Computes the sum of the numbers in LIST, divided by their length. Blanks are ignored. Result is always floating-point, even if all args are integers." - (setq list (apply 'ses-delete-blanks list)) - (/ (float (apply '+ list)) (length list))) + (setq list (apply #'ses-delete-blanks list)) + (/ (float (apply #'+ list)) (length list))) (defmacro ses-select (fromrange test torange) "Select cells in FROMRANGE that are `equal' to TEST. @@ -3532,7 +3643,7 @@ The ranges are macroexpanded but not evaluated so they should be either (ses-range BEG END) or (list ...). The TEST is evaluated." (setq fromrange (cdr (macroexpand fromrange)) torange (cdr (macroexpand torange)) - test (eval test)) + test (eval test t)) (or (= (length fromrange) (length torange)) (error "ses-select: Ranges not same length")) (let (result) @@ -3552,25 +3663,19 @@ either (ses-range BEG END) or (list ...). The TEST is evaluated." ;; Standard print functions ;;---------------------------------------------------------------------------- -;; These functions use the variables 'row' and 'col' that are dynamically bound -;; by ses-print-cell. We define these variables at compile-time to make the -;; compiler happy. -(defvar row) -(defvar col) - (defun ses-center (value &optional span fill) "Print VALUE, centered within column. FILL is the fill character for centering (default = space). SPAN indicates how many additional rightward columns to include in width (default = 0)." - (let ((printer (or (ses-col-printer col) ses--default-printer)) - (width (ses-col-width col)) + (let ((printer (or (ses-col-printer ses--col) ses--default-printer)) + (width (ses-col-width ses--col)) half) (or fill (setq fill ?\s)) (or span (setq span 0)) (setq value (ses-call-printer printer value)) (dotimes (x span) - (setq width (+ width 1 (ses-col-width (+ col span (- x)))))) + (setq width (+ width 1 (ses-col-width (+ ses--col span (- x)))))) ;; Set column width. (setq width (- width (string-width value))) (if (<= width 0) @@ -3583,11 +3688,11 @@ in width (default = 0)." "Print VALUE, centered within the span that starts in the current column and continues until the next nonblank column. FILL specifies the fill character (default = space)." - (let ((end (1+ col))) + (let ((end (1+ ses--col))) (while (and (< end ses--numcols) - (memq (ses-cell-value row end) '(nil *skip*))) + (memq (ses-cell-value ses--row end) '(nil *skip*))) (setq end (1+ end))) - (ses-center value (- end col 1) fill))) + (ses-center value (- end ses--col 1) fill))) (defun ses-dashfill (value &optional span) "Print VALUE centered using dashes. diff --git a/lisp/shell.el b/lisp/shell.el index 6d69ca638dc..f71d1407a49 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -584,6 +584,8 @@ buffer." (setq shell-dirstack-query (cond ((string-equal shell "sh") "pwd") ((string-equal shell "ksh") "echo $PWD ~-") + ;; Bypass any aliases. TODO all shells could use this. + ((string-equal shell "bash") "command dirs") (t "dirs"))) ;; Bypass a bug in certain versions of bash. (when (string-equal shell "bash") @@ -717,7 +719,7 @@ Otherwise, one argument `-i' is passed to the shell. ;; The buffer's window must be correctly set when we call comint (so ;; that comint sets the COLUMNS env var properly). - (pop-to-buffer-same-window buffer) + (pop-to-buffer buffer) (unless (comint-check-proc buffer) (let* ((prog (or explicit-shell-file-name (getenv "ESHELL") shell-file-name)) diff --git a/lisp/simple.el b/lisp/simple.el index 497e4a1604f..967fbc69cbc 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -819,15 +819,15 @@ If BACKWARD-ONLY is non-nil, only delete them before point." If N is negative, delete newlines as well, leaving -N spaces. See also `cycle-spacing'." (interactive "*p") - (cycle-spacing n nil t)) + (cycle-spacing n nil 'single-shot)) (defvar cycle-spacing--context nil "Store context used in consecutive calls to `cycle-spacing' command. -The first time this function is run, it saves the original point -position and original spacing around the point in this -variable.") +The first time `cycle-spacing' runs, it saves in this variable: +its N argument, the original point position, and the original spacing +around point.") -(defun cycle-spacing (&optional n preserve-nl-back single-shot) +(defun cycle-spacing (&optional n preserve-nl-back mode) "Manipulate whitespace around point in a smart way. In interactive use, this function behaves differently in successive consecutive calls. @@ -838,25 +838,31 @@ It deletes all spaces and tabs around point, leaving one space it deletes newlines as well, leaving -N spaces. \(If PRESERVE-NL-BACK is non-nil, it does not delete newlines before point.) -The second call in a sequence (or the first call if the above does -not result in any changes) deletes all spaces. +The second call in a sequence deletes all spaces. The third call in a sequence restores the original whitespace (and point). -If SINGLE-SHOT is non-nil, it only performs the first step in the sequence." +If MODE is `single-shot', it only performs the first step in the sequence. +If MODE is `fast' and the first step would not result in any change +\(i.e., there are exactly (abs N) spaces around point), +the function goes straight to the second step. + +Repeatedly calling the function with different values of N starts a +new sequence each time." (interactive "*p") (let ((orig-pos (point)) (skip-characters (if (and n (< n 0)) " \t\n\r" " \t")) - (n (abs (or n 1)))) + (num (abs (or n 1)))) (skip-chars-backward (if preserve-nl-back " \t" skip-characters)) (constrain-to-field nil orig-pos) (cond - ;; Command run for the first time or single-shot is non-nil. - ((or single-shot + ;; Command run for the first time, single-shot mode or different argument + ((or (eq 'single-shot mode) (not (equal last-command this-command)) - (not cycle-spacing--context)) + (not cycle-spacing--context) + (not (eq (car cycle-spacing--context) n))) (let* ((start (point)) - (n (- n (skip-chars-forward " " (+ n (point))))) + (num (- num (skip-chars-forward " " (+ num (point))))) (mid (point)) (end (progn (skip-chars-forward skip-characters) @@ -864,12 +870,12 @@ If SINGLE-SHOT is non-nil, it only performs the first step in the sequence." (setq cycle-spacing--context ;; Save for later. ;; Special handling for case where there was no space at all. (unless (= start end) - (cons orig-pos (buffer-substring start (point))))) + (cons n (cons orig-pos (buffer-substring start (point)))))) ;; If this run causes no change in buffer content, delete all spaces, ;; otherwise delete all excess spaces. - (delete-region (if (and (not single-shot) (zerop n) (= mid end)) + (delete-region (if (and (eq mode 'fast) (zerop num) (= mid end)) start mid) end) - (insert (make-string n ?\s)))) + (insert (make-string num ?\s)))) ;; Command run for the second time. ((not (equal orig-pos (point))) @@ -877,8 +883,8 @@ If SINGLE-SHOT is non-nil, it only performs the first step in the sequence." ;; Command run for the third time. (t - (insert (cdr cycle-spacing--context)) - (goto-char (car cycle-spacing--context)) + (insert (cddr cycle-spacing--context)) + (goto-char (cadr cycle-spacing--context)) (setq cycle-spacing--context nil))))) (defun beginning-of-buffer (&optional arg) @@ -888,10 +894,8 @@ If the buffer is narrowed, this command uses the beginning of the accessible part of the buffer. If Transient Mark mode is disabled, leave mark at previous -position, unless a \\[universal-argument] prefix is supplied. - -Don't use this command in Lisp programs! -\(goto-char (point-min)) is faster." +position, unless a \\[universal-argument] prefix is supplied." + (declare (interactive-only "use `(goto-char (point-min))' instead.")) (interactive "^P") (or (consp arg) (region-active-p) @@ -906,8 +910,6 @@ Don't use this command in Lisp programs! (/ (+ 10 (* size (prefix-numeric-value arg))) 10))) (point-min)))) (if (and arg (not (consp arg))) (forward-line 1))) -(put 'beginning-of-buffer 'interactive-only - "use `(goto-char (point-min))' instead.") (defun end-of-buffer (&optional arg) "Move point to the end of the buffer. @@ -916,10 +918,8 @@ If the buffer is narrowed, this command uses the end of the accessible part of the buffer. If Transient Mark mode is disabled, leave mark at previous -position, unless a \\[universal-argument] prefix is supplied. - -Don't use this command in Lisp programs! -\(goto-char (point-max)) is faster." +position, unless a \\[universal-argument] prefix is supplied." + (declare (interactive-only "use `(goto-char (point-max))' instead.")) (interactive "^P") (or (consp arg) (region-active-p) (push-mark)) (let ((size (- (point-max) (point-min)))) @@ -940,7 +940,6 @@ Don't use this command in Lisp programs! ;; then scroll specially to put it near, but not at, the bottom. (overlay-recenter (point)) (recenter -3)))) -(put 'end-of-buffer 'interactive-only "use `(goto-char (point-max))' instead.") (defcustom delete-active-region t "Whether single-char deletion commands delete an active region. @@ -981,6 +980,7 @@ arg, and KILLFLAG is set if N is explicitly specified. In Overwrite mode, single character backward deletion may replace tabs with spaces so as to back over columns, unless point is at the end of the line." + (declare (interactive-only delete-char)) (interactive "p\nP") (unless (integerp n) (signal 'wrong-type-argument (list 'integerp n))) @@ -1003,7 +1003,6 @@ the end of the line." (insert-char ?\s (- ocol (current-column)) nil)))) ;; Otherwise, do simple deletion. (t (delete-char (- n) killflag)))) -(put 'delete-backward-char 'interactive-only 'delete-char) (defun delete-forward-char (n &optional killflag) "Delete the following N characters (previous if N is negative). @@ -1014,6 +1013,7 @@ To disable this, set variable `delete-active-region' to nil. Optional second arg KILLFLAG non-nil means to kill (save in kill ring) instead of delete. Interactively, N is the prefix arg, and KILLFLAG is set if N was explicitly specified." + (declare (interactive-only delete-char)) (interactive "p\nP") (unless (integerp n) (signal 'wrong-type-argument (list 'integerp n))) @@ -1027,7 +1027,6 @@ KILLFLAG is set if N was explicitly specified." ;; Otherwise, do simple deletion. (t (delete-char n killflag)))) -(put 'delete-forward-char 'interactive-only 'delete-char) (defun mark-whole-buffer () "Put point at beginning and mark at end of buffer. @@ -1035,6 +1034,7 @@ If narrowing is in effect, only uses the accessible part of the buffer. You probably should not use this function in Lisp programs; it is usually a mistake for a Lisp function to use any subroutine that uses or sets the mark." + (declare (interactive-only t)) (interactive) (push-mark (point)) (push-mark (point-max) nil t) @@ -1063,6 +1063,7 @@ What you probably want instead is something like: (forward-line (1- N)) If at all possible, an even better solution is to use char counts rather than line counts." + (declare (interactive-only forward-line)) (interactive (if (and current-prefix-arg (not (consp current-prefix-arg))) (list (prefix-numeric-value current-prefix-arg)) @@ -1102,7 +1103,6 @@ rather than line counts." (if (eq selective-display t) (re-search-forward "[\n\C-m]" nil 'end (1- line)) (forward-line (1- line))))) -(put 'goto-line 'interactive-only 'forward-line) (defun count-words-region (start end &optional arg) "Count the number of words in the region. @@ -1229,15 +1229,21 @@ in *Help* buffer. See also the command `describe-char'." (interactive "P") (let* ((char (following-char)) (bidi-fixer - (cond ((memq char '(?\x202a ?\x202b ?\x202d ?\x202e)) - ;; If the character is one of LRE, LRO, RLE, RLO, it - ;; will start a directional embedding, which could - ;; completely disrupt the rest of the line (e.g., RLO - ;; will display the rest of the line right-to-left). - ;; So we put an invisible PDF character after these - ;; characters, to end the embedding, which eliminates - ;; any effects on the rest of the line. + ;; If the character is one of LRE, LRO, RLE, RLO, it will + ;; start a directional embedding, which could completely + ;; disrupt the rest of the line (e.g., RLO will display the + ;; rest of the line right-to-left). So we put an invisible + ;; PDF character after these characters, to end the + ;; embedding, which eliminates any effects on the rest of + ;; the line. For RLE and RLO we also append an invisible + ;; LRM, to avoid reordering the following numerical + ;; characters. For LRI/RLI/FSI we append a PDI. + (cond ((memq char '(?\x202a ?\x202d)) (propertize (string ?\x202c) 'invisible t)) + ((memq char '(?\x202b ?\x202e)) + (propertize (string ?\x202c ?\x200e) 'invisible t)) + ((memq char '(?\x2066 ?\x2067 ?\x2068)) + (propertize (string ?\x2069) 'invisible t)) ;; Strong right-to-left characters cause reordering of ;; the following numerical characters which show the ;; codepoint, so append LRM to countermand that. @@ -1400,8 +1406,11 @@ display the result of expression evaluation." (let ((minibuffer-completing-symbol t)) (minibuffer-with-setup-hook (lambda () + ;; FIXME: call emacs-lisp-mode? + (add-function :before-until (local 'eldoc-documentation-function) + #'elisp-eldoc-documentation-function) (add-hook 'completion-at-point-functions - #'lisp-completion-at-point nil t) + #'elisp-completion-at-point nil t) (run-hooks 'eval-expression-minibuffer-setup-hook)) (read-from-minibuffer prompt initial-contents read-expression-map t @@ -1521,31 +1530,26 @@ to get different commands to edit and resubmit." ;; add it to the history. (or (equal newcmd (car command-history)) (setq command-history (cons newcmd command-history))) - (unwind-protect - (progn - ;; Trick called-interactively-p into thinking that `newcmd' is - ;; an interactive call (bug#14136). - (add-hook 'called-interactively-p-functions - #'repeat-complex-command--called-interactively-skip) - (eval newcmd)) - (remove-hook 'called-interactively-p-functions - #'repeat-complex-command--called-interactively-skip))) + (apply #'funcall-interactively + (car newcmd) + (mapcar (lambda (e) (eval e t)) (cdr newcmd)))) (if command-history (error "Argument %d is beyond length of command history" arg) (error "There are no previous complex commands to repeat"))))) -(defun repeat-complex-command--called-interactively-skip (i _frame1 frame2) - (and (eq 'eval (cadr frame2)) - (eq 'repeat-complex-command - (cadr (backtrace-frame i #'called-interactively-p))) - 1)) (defvar extended-command-history nil) +(defvar execute-extended-command--last-typed nil) (defun read-extended-command () "Read command name to invoke in `execute-extended-command'." (minibuffer-with-setup-hook (lambda () + (add-hook 'post-self-insert-hook + (lambda () + (setq execute-extended-command--last-typed + (minibuffer-contents))) + nil 'local) (set (make-local-variable 'minibuffer-default-add-function) (lambda () ;; Get a command name at point in the original buffer @@ -1573,7 +1577,17 @@ to get different commands to edit and resubmit." ;; because "M-x" is a well-known prompt to read a command ;; and it serves as a shorthand for "Extended command: ". "M-x ") - obarray 'commandp t nil 'extended-command-history))) + (lambda (string pred action) + (let ((pred + (if (memq action '(nil t)) + ;; Exclude obsolete commands from completions. + (lambda (sym) + (and (funcall pred sym) + (or (equal string (symbol-name sym)) + (not (get sym 'byte-obsolete-info))))) + pred))) + (complete-with-action action obarray string pred))) + #'commandp t nil 'extended-command-history))) (defcustom suggest-key-bindings t "Non-nil means show the equivalent key-binding when M-x command has one. @@ -1584,19 +1598,59 @@ If the value is non-nil and not a number, we wait 2 seconds." (integer :tag "time" 2) (other :tag "on"))) -(defun execute-extended-command (prefixarg &optional command-name) +(defun execute-extended-command--shorter-1 (name length) + (cond + ((zerop length) (list "")) + ((equal name "") nil) + (t + (nconc (mapcar (lambda (s) (concat (substring name 0 1) s)) + (execute-extended-command--shorter-1 + (substring name 1) (1- length))) + (when (string-match "\\`\\(-\\)?[^-]*" name) + (execute-extended-command--shorter-1 + (substring name (match-end 0)) length)))))) + +(defun execute-extended-command--shorter (name typed) + (let ((candidates '()) + (max (length typed)) + (len 1) + binding) + (while (and (not binding) + (progn + (unless candidates + (setq len (1+ len)) + (setq candidates (execute-extended-command--shorter-1 + name len))) + ;; Don't show the help message if the binding isn't + ;; significantly shorter than the M-x command the user typed. + (< len (- max 5)))) + (let ((candidate (pop candidates))) + (when (equal name + (car-safe (completion-try-completion + candidate obarray 'commandp len))) + (setq binding candidate)))) + binding)) + +(defun execute-extended-command (prefixarg &optional command-name typed) ;; Based on Fexecute_extended_command in keyboard.c of Emacs. ;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24 "Read a command name, then read the arguments and call the command. -Interactively, to pass a prefix argument to the command you are -invoking, give a prefix argument to `execute-extended-command'. -Noninteractively, the argument PREFIXARG is the prefix argument to -give to the command you invoke." - (interactive (list current-prefix-arg (read-extended-command))) +To pass a prefix argument to the command you are +invoking, give a prefix argument to `execute-extended-command'." + (declare (interactive-only command-execute)) + ;; FIXME: Remember the actual text typed by the user before completion, + ;; so that we don't later on suggest the same shortening. + (interactive + (let ((execute-extended-command--last-typed nil)) + (list current-prefix-arg + (read-extended-command) + execute-extended-command--last-typed))) ;; Emacs<24 calling-convention was with a single `prefixarg' argument. - (if (null command-name) - (setq command-name (let ((current-prefix-arg prefixarg)) ; for prompt - (read-extended-command)))) + (unless command-name + (let ((current-prefix-arg prefixarg) ; for prompt + (execute-extended-command--last-typed nil)) + (setq command-name (read-extended-command)) + (setq typed execute-extended-command--last-typed))) (let* ((function (and (stringp command-name) (intern-soft command-name))) (binding (and suggest-key-bindings (not executing-kbd-macro) @@ -1613,19 +1667,34 @@ give to the command you invoke." (let ((prefix-arg prefixarg)) (command-execute function 'record)) ;; If enabled, show which key runs this command. - (when binding - ;; But first wait, and skip the message if there is input. - (let* ((waited - ;; If this command displayed something in the echo area; - ;; wait a few seconds, then display our suggestion message. + ;; But first wait, and skip the message if there is input. + (let* ((waited + ;; If this command displayed something in the echo area; + ;; wait a few seconds, then display our suggestion message. + ;; FIXME: Wait *after* running post-command-hook! + ;; FIXME: Don't wait if execute-extended-command--shorter won't + ;; find a better answer anyway! + (when suggest-key-bindings (sit-for (cond ((zerop (length (current-message))) 0) ((numberp suggest-key-bindings) suggest-key-bindings) - (t 2))))) - (when (and waited (not (consp unread-command-events))) + (t 2)))))) + (when (and waited (not (consp unread-command-events))) + (unless (or binding executing-kbd-macro (not (symbolp function)) + (<= (length (symbol-name function)) 2)) + ;; There's no binding for CMD. Let's try and find the shortest + ;; string to use in M-x. + ;; FIXME: Can be slow. Cache it maybe? + (while-no-input + (setq binding (execute-extended-command--shorter + (symbol-name function) typed)))) + (when binding (with-temp-message (format "You can run the command `%s' with %s" - function (key-description binding)) + function + (if (stringp binding) + (concat "M-x " binding " RET") + (key-description binding))) (sit-for (if (numberp suggest-key-bindings) suggest-key-bindings 2)))))))) @@ -1915,6 +1984,38 @@ With argument N, it uses the Nth previous element." (or (zerop n) (goto-history-element (+ minibuffer-history-position n)))) +(defun next-line-or-history-element (&optional arg) + "Move cursor vertically down ARG lines, or to the next history element. +When point moves over the bottom line of multi-line minibuffer, puts ARGth +next element of the minibuffer history in the minibuffer." + (interactive "^p") + (or arg (setq arg 1)) + (let ((old-point (point))) + (condition-case nil + (with-no-warnings + (next-line arg)) + (end-of-buffer + ;; Restore old position since `line-move-visual' moves point to + ;; the end of the line when it fails to go to the next line. + (goto-char old-point) + (next-history-element arg))))) + +(defun previous-line-or-history-element (&optional arg) + "Move cursor vertically up ARG lines, or to the previous history element. +When point moves over the top line of multi-line minibuffer, puts ARGth +previous element of the minibuffer history in the minibuffer." + (interactive "^p") + (or arg (setq arg 1)) + (let ((old-point (point))) + (condition-case nil + (with-no-warnings + (previous-line arg)) + (beginning-of-buffer + ;; Restore old position since `line-move-visual' moves point to + ;; the beginning of the line when it fails to go to the previous line. + (goto-char old-point) + (previous-history-element arg))))) + (defun next-complete-history-element (n) "Get next history element which completes the minibuffer before the point. The contents of the minibuffer after the point are deleted, and replaced @@ -2383,91 +2484,115 @@ are ignored. If BEG and END are nil, all undo elements are used." (undo-make-selective-list (min beg end) (max beg end)) buffer-undo-list))) +;; The positions given in elements of the undo list are the positions +;; as of the time that element was recorded to undo history. In +;; general, subsequent buffer edits render those positions invalid in +;; the current buffer, unless adjusted according to the intervening +;; undo elements. +;; +;; Undo in region is a use case that requires adjustments to undo +;; elements. It must adjust positions of elements in the region based +;; on newer elements not in the region so as they may be correctly +;; applied in the current buffer. undo-make-selective-list +;; accomplishes this with its undo-deltas list of adjustments. An +;; example undo history from oldest to newest: +;; +;; buf pos: +;; 123456789 buffer-undo-list undo-deltas +;; --------- ---------------- ----------- +;; aaa (1 . 4) (1 . -3) +;; aaba (3 . 4) N/A (in region) +;; ccaaba (1 . 3) (1 . -2) +;; ccaabaddd (7 . 10) (7 . -3) +;; ccaabdd ("ad" . 6) (6 . 2) +;; ccaabaddd (6 . 8) (6 . -2) +;; | |<-- region: "caab", from 2 to 6 +;; +;; When the user starts a run of undos in region, +;; undo-make-selective-list is called to create the full list of in +;; region elements. Each element is adjusted forward chronologically +;; through undo-deltas to determine if it is in the region. +;; +;; In the above example, the insertion of "b" is (3 . 4) in the +;; buffer-undo-list. The undo-delta (1 . -2) causes (3 . 4) to become +;; (5 . 6). The next three undo-deltas cause no adjustment, so (5 +;; . 6) is assessed as in the region and placed in the selective list. +;; Notably, the end of region itself adjusts from "2 to 6" to "2 to 5" +;; due to the selected element. The "b" insertion is the only element +;; fully in the region, so in this example undo-make-selective-list +;; returns (nil (5 . 6)). +;; +;; The adjustment of the (7 . 10) insertion of "ddd" shows an edge +;; case. It is adjusted through the undo-deltas: ((6 . 2) (6 . -2)). +;; Normally an undo-delta of (6 . 2) would cause positions after 6 to +;; adjust by 2. However, they shouldn't adjust to less than 6, so (7 +;; . 10) adjusts to (6 . 8) due to the first undo delta. +;; +;; More interesting is how to adjust the "ddd" insertion due to the +;; next undo-delta: (6 . -2), corresponding to reinsertion of "ad". +;; If the reinsertion was a manual retyping of "ad", then the total +;; adjustment should be (7 . 10) -> (6 . 8) -> (8 . 10). However, if +;; the reinsertion was due to undo, one might expect the first "d" +;; character would again be a part of the "ddd" text, meaning its +;; total adjustment would be (7 . 10) -> (6 . 8) -> (7 . 10). +;; +;; undo-make-selective-list assumes in this situation that "ad" was a +;; new edit, even if it was inserted because of an undo. +;; Consequently, if the user undos in region "8 to 10" of the +;; "ccaabaddd" buffer, they could be surprised that it becomes +;; "ccaabad", as though the first "d" became detached from the +;; original "ddd" insertion. This quirk is a FIXME. + (defun undo-make-selective-list (start end) "Return a list of undo elements for the region START to END. -The elements come from `buffer-undo-list', but we keep only -the elements inside this region, and discard those outside this region. -If we find an element that crosses an edge of this region, -we stop and ignore all further elements." - (let ((undo-list-copy (undo-copy-list buffer-undo-list)) - (undo-list (list nil)) - some-rejected - undo-elt temp-undo-list delta) - (while undo-list-copy - (setq undo-elt (car undo-list-copy)) - (let ((keep-this - (cond ((and (consp undo-elt) (eq (car undo-elt) t)) - ;; This is a "was unmodified" element. - ;; Keep it if we have kept everything thus far. - (not some-rejected)) - ;; Skip over marker adjustments, instead relying on - ;; finding them after (TEXT . POS) elements - ((markerp (car-safe undo-elt)) - nil) - (t - (undo-elt-in-region undo-elt start end))))) - (if keep-this - (progn - (setq end (+ end (cdr (undo-delta undo-elt)))) - ;; Don't put two nils together in the list - (when (not (and (eq (car undo-list) nil) - (eq undo-elt nil))) - (setq undo-list (cons undo-elt undo-list)) - ;; If (TEXT . POS), "keep" its subsequent (MARKER - ;; . ADJUSTMENT) whose markers haven't moved. - (when (and (stringp (car-safe undo-elt)) - (integerp (cdr-safe undo-elt))) - (let ((list-i (cdr undo-list-copy))) +The elements come from `buffer-undo-list', but we keep only the +elements inside this region, and discard those outside this +region. The elements' positions are adjusted so as the returned +list can be applied to the current buffer." + (let ((ulist buffer-undo-list) + ;; A list of position adjusted undo elements in the region. + (selective-list (list nil)) + ;; A list of undo-deltas for out of region undo elements. + undo-deltas + undo-elt) + (while ulist + (when undo-no-redo + (while (gethash ulist undo-equiv-table) + (setq ulist (gethash ulist undo-equiv-table)))) + (setq undo-elt (car ulist)) + (cond + ((null undo-elt) + ;; Don't put two nils together in the list + (when (car selective-list) + (push nil selective-list))) + ((and (consp undo-elt) (eq (car undo-elt) t)) + ;; This is a "was unmodified" element. Keep it + ;; if we have kept everything thus far. + (when (not undo-deltas) + (push undo-elt selective-list))) + ;; Skip over marker adjustments, instead relying + ;; on finding them after (TEXT . POS) elements + ((markerp (car-safe undo-elt)) + nil) + (t + (let ((adjusted-undo-elt (undo-adjust-elt undo-elt + undo-deltas))) + (if (undo-elt-in-region adjusted-undo-elt start end) + (progn + (setq end (+ end (cdr (undo-delta adjusted-undo-elt)))) + (push adjusted-undo-elt selective-list) + ;; Keep (MARKER . ADJUSTMENT) if their (TEXT . POS) was + ;; kept. primitive-undo may discard them later. + (when (and (stringp (car-safe adjusted-undo-elt)) + (integerp (cdr-safe adjusted-undo-elt))) + (let ((list-i (cdr ulist))) (while (markerp (car-safe (car list-i))) - (let* ((adj-elt (pop list-i)) - (m (car adj-elt))) - (and (eq (marker-buffer m) (current-buffer)) - (= (cdr undo-elt) m) - (push adj-elt undo-list)))))))) - (if (undo-elt-crosses-region undo-elt start end) - (setq undo-list-copy nil) - (setq some-rejected t) - (setq temp-undo-list (cdr undo-list-copy)) - (setq delta (undo-delta undo-elt)) - - (when (/= (cdr delta) 0) - (let ((position (car delta)) - (offset (cdr delta))) - - ;; Loop down the earlier events adjusting their buffer - ;; positions to reflect the fact that a change to the buffer - ;; isn't being undone. We only need to process those element - ;; types which undo-elt-in-region will return as being in - ;; the region since only those types can ever get into the - ;; output - - (while temp-undo-list - (setq undo-elt (car temp-undo-list)) - (cond ((integerp undo-elt) - (if (>= undo-elt position) - (setcar temp-undo-list (- undo-elt offset)))) - ((atom undo-elt) nil) - ((stringp (car undo-elt)) - ;; (TEXT . POSITION) - (let ((text-pos (abs (cdr undo-elt))) - (point-at-end (< (cdr undo-elt) 0 ))) - (if (>= text-pos position) - (setcdr undo-elt (* (if point-at-end -1 1) - (- text-pos offset)))))) - ((integerp (car undo-elt)) - ;; (BEGIN . END) - (when (>= (car undo-elt) position) - (setcar undo-elt (- (car undo-elt) offset)) - (setcdr undo-elt (- (cdr undo-elt) offset)))) - ((null (car undo-elt)) - ;; (nil PROPERTY VALUE BEG . END) - (let ((tail (nthcdr 3 undo-elt))) - (when (>= (car tail) position) - (setcar tail (- (car tail) offset)) - (setcdr tail (- (cdr tail) offset)))))) - (setq temp-undo-list (cdr temp-undo-list)))))))) - (setq undo-list-copy (cdr undo-list-copy))) - (nreverse undo-list))) + (push (pop list-i) selective-list))))) + (let ((delta (undo-delta undo-elt))) + (when (/= 0 (cdr delta)) + (push delta undo-deltas))))))) + (pop ulist)) + (nreverse selective-list))) (defun undo-elt-in-region (undo-elt start end) "Determine whether UNDO-ELT falls inside the region START ... END. @@ -2505,6 +2630,7 @@ marker adjustment's corresponding (TEXT . POS) element." "Test whether UNDO-ELT crosses one edge of that region START ... END. This assumes we have already decided that UNDO-ELT is not *inside* the region START...END." + (declare (obsolete nil "25.1")) (cond ((atom undo-elt) nil) ((null (car undo-elt)) ;; (nil PROPERTY VALUE BEG . END) @@ -2516,6 +2642,72 @@ is not *inside* the region START...END." (and (< (car undo-elt) end) (> (cdr undo-elt) start))))) +(defun undo-adjust-elt (elt deltas) + "Return adjustment of undo element ELT by the undo DELTAS +list." + (pcase elt + ;; POSITION + ((pred integerp) + (undo-adjust-pos elt deltas)) + ;; (BEG . END) + (`(,(and beg (pred integerp)) . ,(and end (pred integerp))) + (undo-adjust-beg-end beg end deltas)) + ;; (TEXT . POSITION) + (`(,(and text (pred stringp)) . ,(and pos (pred integerp))) + (cons text (* (if (< pos 0) -1 1) + (undo-adjust-pos (abs pos) deltas)))) + ;; (nil PROPERTY VALUE BEG . END) + (`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare)) + `(nil ,prop ,val . ,(undo-adjust-beg-end beg end deltas))) + ;; (apply DELTA START END FUN . ARGS) + ;; FIXME + ;; All others return same elt + (_ elt))) + +;; (BEG . END) can adjust to the same positions, commonly when an +;; insertion was undone and they are out of region, for example: +;; +;; buf pos: +;; 123456789 buffer-undo-list undo-deltas +;; --------- ---------------- ----------- +;; [...] +;; abbaa (2 . 4) (2 . -2) +;; aaa ("bb" . 2) (2 . 2) +;; [...] +;; +;; "bb" insertion (2 . 4) adjusts to (2 . 2) because of the subsequent +;; undo. Further adjustments to such an element should be the same as +;; for (TEXT . POSITION) elements. The options are: +;; +;; 1: POSITION adjusts using <= (use-< nil), resulting in behavior +;; analogous to marker insertion-type t. +;; +;; 2: POSITION adjusts using <, resulting in behavior analogous to +;; marker insertion-type nil. +;; +;; There was no strong reason to prefer one or the other, except that +;; the first is more consistent with prior undo in region behavior. +(defun undo-adjust-beg-end (beg end deltas) + "Return cons of adjustments to BEG and END by the undo DELTAS +list." + (let ((adj-beg (undo-adjust-pos beg deltas))) + ;; Note: option 2 above would be like (cons (min ...) adj-end) + (cons adj-beg + (max adj-beg (undo-adjust-pos end deltas t))))) + +(defun undo-adjust-pos (pos deltas &optional use-<) + "Return adjustment of POS by the undo DELTAS list, comparing +with < or <= based on USE-<." + (dolist (d deltas pos) + (when (if use-< + (< (car d) pos) + (<= (car d) pos)) + (setq pos + ;; Don't allow pos to become less than the undo-delta + ;; position. This edge case is described in the overview + ;; comments. + (max (car d) (- pos (cdr d))))))) + ;; Return the first affected buffer position and the delta for an undo element ;; delta is defined as the change in subsequent buffer positions if we *did* ;; the undo. @@ -2919,12 +3111,14 @@ the use of a shell (with its need to quote arguments)." ;; If will create a new buffer, query first. (if (yes-or-no-p "A command is running in the default buffer. Use a new buffer? ") (setq buffer (generate-new-buffer - (or output-buffer "*Async Shell Command*"))) + (or (and (bufferp output-buffer) (buffer-name output-buffer)) + output-buffer "*Async Shell Command*"))) (error "Shell command in progress"))) ((eq async-shell-command-buffer 'new-buffer) ;; It will create a new buffer. (setq buffer (generate-new-buffer - (or output-buffer "*Async Shell Command*")))) + (or (and (bufferp output-buffer) (buffer-name output-buffer)) + output-buffer "*Async Shell Command*")))) ((eq async-shell-command-buffer 'confirm-rename-buffer) ;; If will rename the buffer, query first. (if (yes-or-no-p "A command is running in the default buffer. Rename it? ") @@ -3299,6 +3493,11 @@ support pty association, if PROGRAM is nil." (defvar process-menu-query-only nil) +(defvar process-menu-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [?d] 'process-menu-delete-process) + map)) + (define-derived-mode process-menu-mode tabulated-list-mode "Process Menu" "Major mode for listing the processes called by Emacs." (setq tabulated-list-format [("Process" 15 t) @@ -3311,6 +3510,12 @@ support pty association, if PROGRAM is nil." (add-hook 'tabulated-list-revert-hook 'list-processes--refresh nil t) (tabulated-list-init-header)) +(defun process-menu-delete-process () + "Kill process at point in a `list-processes' buffer." + (interactive) + (delete-process (tabulated-list-get-id)) + (revert-buffer)) + (defun list-processes--refresh () "Recompute the list of processes for the Process List buffer. Also, delete any process that is exited or signaled." @@ -3541,7 +3746,7 @@ No filtering is done unless a hook says to." ;;;; Window system cut and paste hooks. -(defvar interprogram-cut-function nil +(defvar interprogram-cut-function #'gui-select-text "Function to call to make a killed region available to other programs. Most window systems provide a facility for cutting and pasting text between different programs, such as the clipboard on X and @@ -3552,7 +3757,7 @@ put in the kill ring, to make the new kill available to other programs. The function takes one argument, TEXT, which is a string containing the text which should be made available.") -(defvar interprogram-paste-function nil +(defvar interprogram-paste-function #'gui-selection-value "Function to call to get text cut from other programs. Most window systems provide a facility for cutting and pasting text between different programs, such as the clipboard on X and @@ -3664,14 +3869,34 @@ argument should still be a \"useful\" string for such uses." (if interprogram-cut-function (funcall interprogram-cut-function string))) +;; It has been argued that this should work similar to `self-insert-command' +;; which merges insertions in undo-list in groups of 20 (hard-coded in cmds.c). +(defcustom kill-append-merge-undo nil + "Whether appending to kill ring also makes \\[undo] restore both pieces of text simultaneously." + :type 'boolean + :group 'killing + :version "25.1") + (defun kill-append (string before-p) "Append STRING to the end of the latest kill in the kill ring. If BEFORE-P is non-nil, prepend STRING to the kill. +Also removes the last undo boundary in the current buffer, + depending on `kill-append-merge-undo'. If `interprogram-cut-function' is set, pass the resulting kill to it." (let* ((cur (car kill-ring))) (kill-new (if before-p (concat string cur) (concat cur string)) (or (= (length cur) 0) - (equal nil (get-text-property 0 'yank-handler cur)))))) + (equal nil (get-text-property 0 'yank-handler cur)))) + (when (and kill-append-merge-undo (not buffer-read-only)) + (let ((prev buffer-undo-list) + (next (cdr buffer-undo-list))) + ;; find the next undo boundary + (while (car next) + (pop next) + (pop prev)) + ;; remove this undo boundary + (when prev + (setcdr prev (cdr next))))))) (defcustom yank-pop-change-selection nil "Whether rotating the kill ring changes the window system selection. @@ -3769,7 +3994,7 @@ some text between BEG and END, but we're killing the region." ;; Add that string to the kill ring, one way or another. (if (eq last-command 'kill-region) (kill-append string (< end beg)) - (kill-new string nil))) + (kill-new string))) (when (or string (eq last-command 'kill-region)) (setq this-command 'kill-region)) (setq deactivate-mark t) @@ -3870,7 +4095,7 @@ of this sample text; it defaults to 40." (goto-char point) ;; If user quit, deactivate the mark ;; as C-g would as a command. - (and quit-flag mark-active + (and quit-flag (region-active-p) (deactivate-mark))) (let ((len (min (abs (- mark point)) (or message-len 40)))) @@ -3901,6 +4126,144 @@ The argument is used for internal purposes; do not supply one." (setq this-command 'kill-region) (message "If the next command is a kill, it will append")) (setq last-command 'kill-region))) + +(defvar bidi-directional-controls-chars "\x202a-\x202e\x2066-\x2069" + "Character set that matches bidirectional formatting control characters.") + +(defvar bidi-directional-non-controls-chars "^\x202a-\x202e\x2066-\x2069" + "Character set that matches any character except bidirectional controls.") + +(defun squeeze-bidi-context-1 (from to category replacement) + "A subroutine of `squeeze-bidi-context'. +FROM and TO should be markers, CATEGORY and REPLACEMENT should be strings." + (let ((pt (copy-marker from)) + (limit (copy-marker to)) + (old-pt 0) + lim1) + (setq lim1 limit) + (goto-char pt) + (while (< pt limit) + (if (> pt old-pt) + (move-marker lim1 + (save-excursion + ;; L and R categories include embedding and + ;; override controls, but we don't want to + ;; replace them, because that might change + ;; the visual order. Likewise with PDF and + ;; isolate controls. + (+ pt (skip-chars-forward + bidi-directional-non-controls-chars + limit))))) + ;; Replace any run of non-RTL characters by a single LRM. + (if (null (re-search-forward category lim1 t)) + ;; No more characters of CATEGORY, we are done. + (setq pt limit) + (replace-match replacement nil t) + (move-marker pt (point))) + (setq old-pt pt) + ;; Skip directional controls, if any. + (move-marker + pt (+ pt (skip-chars-forward bidi-directional-controls-chars limit)))))) + +(defun squeeze-bidi-context (from to) + "Replace characters between FROM and TO while keeping bidi context. + +This function replaces the region of text with as few characters +as possible, while preserving the effect that region will have on +bidirectional display before and after the region." + (let ((start (set-marker (make-marker) + (if (> from 0) from (+ (point-max) from)))) + (end (set-marker (make-marker) to)) + ;; This is for when they copy text with read-only text + ;; properties. + (inhibit-read-only t)) + (if (null (marker-position end)) + (setq end (point-max-marker))) + ;; Replace each run of non-RTL characters with a single LRM. + (squeeze-bidi-context-1 start end "\\CR+" "\x200e") + ;; Replace each run of non-LTR characters with a single RLM. Note + ;; that the \cR category includes both the Arabic Letter (AL) and + ;; R characters; here we ignore the distinction between them, + ;; because that distinction only affects Arabic Number (AN) + ;; characters, which are weak and don't affect the reordering. + (squeeze-bidi-context-1 start end "\\CL+" "\x200f"))) + +(defun line-substring-with-bidi-context (start end &optional no-properties) + "Return buffer text between START and END with its bidi context. + +START and END are assumed to belong to the same physical line +of buffer text. This function prepends and appends to the text +between START and END bidi control characters that preserve the +visual order of that text when it is inserted at some other place." + (if (or (< start (point-min)) + (> end (point-max))) + (signal 'args-out-of-range (list (current-buffer) start end))) + (let ((buf (current-buffer)) + substr para-dir from to) + (save-excursion + (goto-char start) + (setq para-dir (current-bidi-paragraph-direction)) + (setq from (line-beginning-position) + to (line-end-position)) + (goto-char from) + ;; If we don't have any mixed directional characters in the + ;; entire line, we can just copy the substring without adding + ;; any context. + (if (or (looking-at-p "\\CR*$") + (looking-at-p "\\CL*$")) + (setq substr (if no-properties + (buffer-substring-no-properties start end) + (buffer-substring start end))) + (setq substr + (with-temp-buffer + (if no-properties + (insert-buffer-substring-no-properties buf from to) + (insert-buffer-substring buf from to)) + (squeeze-bidi-context 1 (1+ (- start from))) + (squeeze-bidi-context (- end to) nil) + (buffer-substring 1 (point-max))))) + + ;; Wrap the string in LRI/RLI..PDI pair to achieve 2 effects: + ;; (1) force the string to have the same base embedding + ;; direction as the paragraph direction at the source, no matter + ;; what is the paragraph direction at destination; and (2) avoid + ;; affecting the visual order of the surrounding text at + ;; destination if there are characters of different + ;; directionality there. + (concat (if (eq para-dir 'left-to-right) "\x2066" "\x2067") + substr "\x2069")))) + +(defun buffer-substring-with-bidi-context (start end &optional no-properties) + "Return portion of current buffer between START and END with bidi context. + +This function works similar to `buffer-substring', but it prepends and +appends to the text bidi directional control characters necessary to +preserve the visual appearance of the text if it is inserted at another +place. This is useful when the buffer substring includes bidirectional +text and control characters that cause non-trivial reordering on display. +If copied verbatim, such text can have a very different visual appearance, +and can also change the visual appearance of the surrounding text at the +destination of the copy. + +Optional argument NO-PROPERTIES, if non-nil, means copy the text without +the text properties." + (let (line-end substr) + (if (or (< start (point-min)) + (> end (point-max))) + (signal 'args-out-of-range (list (current-buffer) start end))) + (save-excursion + (goto-char start) + (setq line-end (min end (line-end-position))) + (while (< start end) + (setq substr + (concat substr + (if substr "\n" "") + (line-substring-with-bidi-context start line-end + no-properties))) + (forward-line 1) + (setq start (point)) + (setq line-end (min end (line-end-position)))) + substr))) ;; Yanking. @@ -4295,10 +4658,8 @@ If ARG is zero, move to the beginning of the current line." (defun insert-buffer (buffer) "Insert after point the contents of BUFFER. Puts mark after the inserted text. -BUFFER may be a buffer or a buffer name. - -This function is meant for the user to run interactively. -Don't call it from programs: use `insert-buffer-substring' instead!" +BUFFER may be a buffer or a buffer name." + (declare (interactive-only insert-buffer-substring)) (interactive (list (progn @@ -4313,7 +4674,6 @@ Don't call it from programs: use `insert-buffer-substring' instead!" (insert-buffer-substring (get-buffer buffer)) (point))) nil) -(put 'insert-buffer 'interactive-only 'insert-buffer-substring) (defun append-to-buffer (buffer start end) "Append to specified buffer the text of the region. @@ -4392,10 +4752,6 @@ a mistake; see the documentation of `set-mark'." (signal 'mark-inactive nil))) ;; Behind display-selections-p. -(declare-function x-selection-owner-p "xselect.c" - (&optional selection terminal)) -(declare-function x-selection-exists-p "xselect.c" - (&optional selection terminal)) (defun deactivate-mark (&optional force) "Deactivate the mark. @@ -4410,7 +4766,7 @@ If Transient Mark mode was temporarily enabled, reset the value of the variable `transient-mark-mode'; if this causes Transient Mark mode to be disabled, don't change `mark-active' to nil or run `deactivate-mark-hook'." - (when (or transient-mark-mode force) + (when (or (region-active-p) force) (when (and (if (eq select-active-regions 'only) (eq (car-safe transient-mark-mode) 'only) select-active-regions) @@ -4420,21 +4776,23 @@ run `deactivate-mark-hook'." ;; the region prior to the last command modifying the buffer. ;; Set the selection to that, or to the current region. (cond (saved-region-selection - (x-set-selection 'PRIMARY saved-region-selection) + (gui-set-selection 'PRIMARY saved-region-selection) (setq saved-region-selection nil)) ;; If another program has acquired the selection, region ;; deactivation should not clobber it (Bug#11772). ((and (/= (region-beginning) (region-end)) - (or (x-selection-owner-p 'PRIMARY) - (null (x-selection-exists-p 'PRIMARY)))) - (x-set-selection 'PRIMARY - (funcall region-extract-function nil))))) + (or (gui-call gui-selection-owner-p 'PRIMARY) + (null (gui-call gui-selection-exists-p 'PRIMARY)))) + (gui-set-selection 'PRIMARY + (funcall region-extract-function nil))))) (when mark-active (force-mode-line-update)) ;Refresh toolbar (bug#16382). (cond ((eq (car-safe transient-mark-mode) 'only) - (setq transient-mark-mode (cdr transient-mark-mode))) + (setq transient-mark-mode (cdr transient-mark-mode)) + (if (eq transient-mark-mode (default-value 'transient-mark-mode)) + (kill-local-variable 'transient-mark-mode))) ((eq transient-mark-mode 'lambda) - (setq transient-mark-mode nil))) + (kill-local-variable 'transient-mark-mode))) (setq mark-active nil) (run-hooks 'deactivate-mark-hook) (redisplay--update-region-highlight (selected-window)))) @@ -4447,7 +4805,7 @@ If NO-TMM is non-nil, leave `transient-mark-mode' alone." (force-mode-line-update) ;Refresh toolbar (bug#16382). (setq mark-active t) (unless (or transient-mark-mode no-tmm) - (setq transient-mark-mode 'lambda)) + (setq-local transient-mark-mode 'lambda)) (run-hooks 'activate-mark-hook)))) (defun set-mark (pos) @@ -4661,7 +5019,7 @@ Novice Emacs Lisp programmers often try to use the mark for the wrong purposes. See the documentation of `set-mark' for more information." (interactive "P") (cond ((eq transient-mark-mode 'lambda) - (setq transient-mark-mode nil)) + (kill-local-variable 'transient-mark-mode)) ((eq (car-safe transient-mark-mode) 'only) (deactivate-mark))) (cond @@ -4672,15 +5030,13 @@ purposes. See the documentation of `set-mark' for more information." (pop-to-mark-command) (push-mark-command t))) ((and set-mark-command-repeat-pop - (eq last-command 'pop-to-mark-command)) - (setq this-command 'pop-to-mark-command) - (pop-to-mark-command)) - ((and set-mark-command-repeat-pop (eq last-command 'pop-global-mark) (not arg)) (setq this-command 'pop-global-mark) (pop-global-mark)) - (arg + ((or (and set-mark-command-repeat-pop + (eq last-command 'pop-to-mark-command)) + arg) (setq this-command 'pop-to-mark-command) (pop-to-mark-command)) ((eq last-command 'set-mark-command) @@ -4755,7 +5111,7 @@ mode temporarily." (set-mark (point)) (goto-char omark) (cond (temp-highlight - (setq transient-mark-mode (cons 'only transient-mark-mode))) + (setq-local transient-mark-mode (cons 'only transient-mark-mode))) ((or (and arg (region-active-p)) ; (xor arg (not (region-active-p))) (not (or arg (region-active-p)))) (deactivate-mark)) @@ -4794,13 +5150,15 @@ its earlier value." (cond ((and shift-select-mode this-command-keys-shift-translated) (unless (and mark-active (eq (car-safe transient-mark-mode) 'only)) - (setq transient-mark-mode - (cons 'only - (unless (eq transient-mark-mode 'lambda) - transient-mark-mode))) + (setq-local transient-mark-mode + (cons 'only + (unless (eq transient-mark-mode 'lambda) + transient-mark-mode))) (push-mark nil nil t))) ((eq (car-safe transient-mark-mode) 'only) (setq transient-mark-mode (cdr transient-mark-mode)) + (if (eq transient-mark-mode (default-value 'transient-mark-mode)) + (kill-local-variable 'transient-mark-mode)) (deactivate-mark)))) (define-minor-mode transient-mark-mode @@ -4828,7 +5186,7 @@ Transient Mark mode, invoke \\[apropos-documentation] and type \"transient\" or \"mark.*active\" at the prompt." :global t ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again. - :variable transient-mark-mode) + :variable (default-value 'transient-mark-mode)) (defvar widen-automatically t "Non-nil means it is ok for commands to call `widen' when they want to. @@ -4902,11 +5260,8 @@ this command moves to the specified goal column (or as close as possible). The goal column is stored in the variable `goal-column', which is nil when there is no goal column. Note that setting `goal-column' overrides `line-move-visual' and causes this command to move by buffer -lines rather than by display lines. - -If you are thinking of using this in a Lisp program, consider -using `forward-line' instead. It is usually easier to use -and more reliable (no dependence on goal column, etc.)." +lines rather than by display lines." + (declare (interactive-only forward-line)) (interactive "^p\np") (or arg (setq arg 1)) (if (and next-line-add-newlines (= arg 1)) @@ -4923,7 +5278,6 @@ and more reliable (no dependence on goal column, etc.)." (signal (car err) (cdr err)))) (line-move arg nil nil try-vscroll))) nil) -(put 'next-line 'interactive-only 'forward-line) (defun previous-line (&optional arg try-vscroll) "Move cursor vertically up ARG lines. @@ -4949,11 +5303,9 @@ this command moves to the specified goal column (or as close as possible). The goal column is stored in the variable `goal-column', which is nil when there is no goal column. Note that setting `goal-column' overrides `line-move-visual' and causes this command to move by buffer -lines rather than by display lines. - -If you are thinking of using this in a Lisp program, consider using -`forward-line' with a negative argument instead. It is usually easier -to use and more reliable (no dependence on goal column, etc.)." +lines rather than by display lines." + (declare (interactive-only + "use `forward-line' with negative argument instead.")) (interactive "^p\np") (or arg (setq arg 1)) (if (called-interactively-p 'interactive) @@ -4963,8 +5315,6 @@ to use and more reliable (no dependence on goal column, etc.)." (signal (car err) (cdr err)))) (line-move (- arg) nil nil try-vscroll)) nil) -(put 'previous-line 'interactive-only - "use `forward-line' with negative argument instead.") (defcustom track-eol nil "Non-nil means vertical motion starting at end of line keeps to ends of lines. @@ -5853,7 +6203,9 @@ With prefix arg ARG, effect is to take character before point and drag it forward past ARG other characters (backward if ARG negative). If no argument and at end of line, the previous two chars are exchanged." (interactive "*P") - (and (null arg) (eolp) (forward-char -1)) + (when (and (null arg) (eolp) (not (bobp)) + (not (get-text-property (1- (point)) 'read-only))) + (forward-char -1)) (transpose-subr 'forward-char (prefix-numeric-value arg))) (defun transpose-words (arg) @@ -6510,6 +6862,7 @@ The function should return non-nil if the two tokens do not match.") (not blink-matching-paren-dont-ignore-comments)))) (condition-case () (progn + (syntax-propertize (point)) (forward-sexp -1) ;; backward-sexp skips backward over prefix chars, ;; so move back to the matching paren. @@ -6624,6 +6977,8 @@ At top-level, as an editor command, this simply beeps." (deactivate-mark)) (if (fboundp 'kmacro-keyboard-quit) (kmacro-keyboard-quit)) + (when completion-in-region-mode + (completion-in-region-mode -1)) ;; Force the next redisplay cycle to remove the "Def" indicator from ;; all the mode lines. (if defining-kbd-macro @@ -6920,6 +7275,8 @@ With a prefix argument, set VARIABLE to VALUE buffer-locally." (define-key map "\e\e\e" 'delete-completion-window) (define-key map [left] 'previous-completion) (define-key map [right] 'next-completion) + (define-key map [?\t] 'next-completion) + (define-key map [backtab] 'previous-completion) (define-key map "q" 'quit-window) (define-key map "z" 'kill-this-buffer) map) @@ -7483,7 +7840,9 @@ DISPLAY-FLAG non-nil means show the new buffer with `pop-to-buffer'. This is always done when called interactively. Optional third arg NORECORD non-nil means do not put this buffer at the -front of the list of recently selected ones." +front of the list of recently selected ones. + +Returns the newly created indirect buffer." (interactive (progn (if (get major-mode 'no-clone-indirect) @@ -7868,31 +8227,6 @@ contains the list of implementations currently supported for this command." command-name))))))) -;; This is here because files in obsolete/ are not scanned for autoloads. - -(defvar iswitchb-mode nil "\ -Non-nil if Iswitchb mode is enabled. -See the command `iswitchb-mode' for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `iswitchb-mode'.") - -(custom-autoload 'iswitchb-mode "iswitchb" nil) - -(autoload 'iswitchb-mode "iswitchb" "\ -Toggle Iswitchb mode. -With a prefix argument ARG, enable Iswitchb mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. - -Iswitchb mode is a global minor mode that enables switching -between buffers using substrings. See `iswitchb' for details. - -\(fn &optional ARG)" t nil) - -(make-obsolete 'iswitchb-mode - "use `icomplete-mode' or `ido-mode' instead." "24.4") - (provide 'simple) diff --git a/lisp/skeleton.el b/lisp/skeleton.el index 9074268890e..84b0e0a5754 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el @@ -62,12 +62,8 @@ region.") "If non-nil, make sure that the skeleton inserted ends with a newline. This just influences the way the default `skeleton-end-hook' behaves.") -(defvar skeleton-end-hook - (lambda () - (or (eolp) (not skeleton-end-newline) (newline-and-indent))) +(defvar skeleton-end-hook nil "Hook called at end of skeleton but before going to point of interest. -By default this moves out anything following to next line, - unless `skeleton-end-newline' is set to nil. The variables `v1' and `v2' are still set when calling this.") @@ -268,6 +264,7 @@ When done with skeleton, but before going back to `_'-point call (mapcar #'car skeleton-further-elements) (mapcar (lambda (x) (eval (cadr x))) skeleton-further-elements) (skeleton-internal-list skeleton str)) + (or (eolp) (not skeleton-end-newline) (newline-and-indent)) (run-hooks 'skeleton-end-hook) (sit-for 0) (or (pos-visible-in-window-p beg) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 4c090baf0ee..2989274ac55 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -39,21 +39,9 @@ this version is not backward compatible to 0.14 or earlier.") ;; ;;; Notes: ;; -;; Users of really old emacsen without the need timer functions -;; will not have speedbar updating automatically. Use "g" to refresh -;; the display after changing directories. Remember, do not interrupt -;; the stealthy updates or your display may not be completely -;; refreshed. -;; ;; AUC-TEX users: The imenu tags for AUC-TEX mode don't work very ;; well. Use the imenu keywords from tex-mode.el for better results. ;; -;; This file requires the library package assoc (association lists) -;; assoc should be available in all modern versions of Emacs. -;; The custom package is optional (for easy configuration of speedbar) -;; http://www.dina.kvl.dk/~abraham/custom/ -;; custom is available in all versions of Emacs version 20 or better. -;; ;;; Developing for speedbar ;; ;; Adding a speedbar specialized display mode: diff --git a/lisp/startup.el b/lisp/startup.el index c0c52f11bb1..999e53e56dd 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -294,8 +294,9 @@ see `tty-setup-hook'.") `tty-setup-hook' instead." "24.4") (defvar inhibit-startup-hooks nil - "Non-nil means don't run `term-setup-hook' and `emacs-startup-hook'. -This is because we already did so.") + "Non-nil means don't run some startup hooks, because we already did. +Currently this applies to: `emacs-startup-hook', `term-setup-hook', +and `window-setup-hook'.") (defvar keyboard-type nil "The brand of keyboard you are using. @@ -358,6 +359,8 @@ this variable usefully is to set it while building and dumping Emacs." :set (lambda (_variable _value) (error "Customizing `site-run-file' does not work"))) +(make-obsolete-variable 'system-name "use (system-name) instead" "25.1") + (defcustom mail-host-address nil "Name of this machine, for purposes of naming users. If non-nil, Emacs uses this instead of `system-name' when constructing @@ -421,21 +424,6 @@ Warning Warning!!! Pure space overflow !!!Warning Warning :type 'directory :initialize 'custom-initialize-delay) -(defvar package--builtin-versions - ;; Mostly populated by loaddefs.el via autoload-builtin-package-versions. - (purecopy `((emacs . ,(version-to-list emacs-version)))) - "Alist giving the version of each versioned builtin package. -I.e. each element of the list is of the form (NAME . VERSION) where -NAME is the package name as a symbol, and VERSION is its version -as a list.") - -(defun package--description-file (dir) - (concat (let ((subdir (file-name-nondirectory - (directory-file-name dir)))) - (if (string-match "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" subdir) - (match-string 1 subdir) subdir)) - "-pkg.el")) - (defun normal-top-level-add-subdirs-to-load-path () "Add all subdirectories of `default-directory' to `load-path'. More precisely, this uses only the subdirectories whose names @@ -497,7 +485,7 @@ It sets `command-line-processed', processes the command-line, reads the initialization files, etc. It is the default value of the variable `top-level'." (if command-line-processed - (message "Back to top level.") + (message internal--top-level-message) (setq command-line-processed t) ;; Look in each dir in load-path for a subdirs.el file. If we @@ -649,9 +637,7 @@ It is the default value of the variable `top-level'." (emacs-pid) (system-name)))))))) (unless inhibit-startup-hooks - (run-hooks 'emacs-startup-hook) - (and term-setup-hook - (run-hooks 'term-setup-hook))) + (run-hooks 'emacs-startup-hook 'term-setup-hook)) ;; Don't do this if we failed to create the initial frame, ;; for instance due to a dense colormap. @@ -687,8 +673,8 @@ It is the default value of the variable `top-level'." ;; Now we know the user's default font, so add it to the menu. (if (fboundp 'font-menu-add-default) (font-menu-add-default)) - (and window-setup-hook - (run-hooks 'window-setup-hook)))) + (unless inhibit-startup-hooks + (run-hooks 'window-setup-hook)))) ;; Subprocesses of Emacs do not have direct access to the terminal, so ;; unless told otherwise they should only assume a dumb terminal. ;; We are careful to do it late (after term-setup-hook), although the @@ -721,20 +707,17 @@ It is the default value of the variable `top-level'." (defconst tool-bar-images-pixel-height 24 "Height in pixels of images in the tool-bar.") -(defvar tool-bar-originally-present nil - "Non-nil if tool-bars are present before user and site init files are read.") - -(defvar handle-args-function-alist '((nil . tty-handle-args)) - "Functions for processing window-system dependent command-line arguments. +(gui-method-declare handle-args-function #'tty-handle-args + "Method for processing window-system dependent command-line arguments. Window system startup files should add their own function to this -alist, which should parse the command line arguments. Those +method, which should parse the command line arguments. Those pertaining to the window system should be processed and removed from the returned command line.") -(defvar window-system-initialization-alist '((nil . ignore)) - "Alist of window-system initialization functions. -Window-system startup files should add their own initialization -function to this list. The function should take no arguments, +(gui-method-declare window-system-initialization #'ignore + "Method for window-system initialization. +Window-system startup files should add their own implementation +to this method. The function should take no arguments, and initialize the window system environment to prepare for opening the first frame (e.g. open a connection to an X server).") @@ -970,13 +953,11 @@ please check its value") ;; Process window-system specific command line parameters. (setq command-line-args (funcall - (or (cdr (assq initial-window-system handle-args-function-alist)) - (error "Unsupported window system `%s'" initial-window-system)) + (gui-method handle-args-function initial-window-system) command-line-args)) ;; Initialize the window system. (Open connection, etc.) (funcall - (or (cdr (assq initial-window-system window-system-initialization-alist)) - (error "Unsupported window system `%s'" initial-window-system))) + (gui-method window-system-initialization initial-window-system)) (put initial-window-system 'window-system-initialized t)) ;; If there was an error, print the error message and exit. (error @@ -1044,18 +1025,6 @@ please check its value") (or (eq initial-window-system 'pc) (tty-register-default-colors)) - ;; Record whether the tool-bar is present before the user and site - ;; init files are processed. frame-notice-user-settings uses this - ;; to determine if the tool-bar has been disabled by the init files, - ;; and the frame needs to be resized. - (when (fboundp 'frame-notice-user-settings) - (let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist) - (assq 'tool-bar-lines default-frame-alist)))) - (setq tool-bar-originally-present - (and tool-bar-lines - (cdr tool-bar-lines) - (not (eq 0 (cdr tool-bar-lines))))))) - (let ((old-scalable-fonts-allowed scalable-fonts-allowed) (old-face-ignored-fonts face-ignored-fonts)) @@ -1321,7 +1290,6 @@ the `--debug-init' option to view a complete error backtrace." (dolist (dir load-path) (and (not warned) (stringp dir) - (string-match-p "/[._]emacs\\.d/?\\'" dir) (string-equal (file-name-as-directory (expand-file-name dir)) (expand-file-name user-emacs-directory)) (setq warned t) @@ -1329,9 +1297,10 @@ the `--debug-init' option to view a complete error backtrace." (format "Your `load-path' seems to contain your `.emacs.d' directory: %s\n\ This is likely to cause problems...\n\ -Consider using a subdirectory instead, e.g.: %s" dir -(expand-file-name "lisp" user-emacs-directory)) - :warning)))) +Consider using a subdirectory instead, e.g.: %s" + dir (expand-file-name + "lisp" user-emacs-directory)) + :warning)))) ;; If -batch, terminate after processing the command options. (if noninteractive (kill-emacs t)) @@ -1413,8 +1382,9 @@ If this is nil, no message will be displayed." `("GNU/Linux" ,(lambda (_button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html")) "Browse http://www.gnu.org/gnu/linux-and-gnu.html") - `("GNU" ,(lambda (_button) (describe-gnu-project)) - "Display info on the GNU project"))) + `("GNU" ,(lambda (_button) + (browse-url "http://www.gnu.org/gnu/thegnuproject.html")) + "Browse http://www.gnu.org/gnu/thegnuproject.html"))) " operating system.\n\n" :face variable-pitch :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial))) @@ -1496,9 +1466,7 @@ Each element in the list should be a list of strings or pairs (goto-char (point-min)))) "\tMany people have contributed code included in GNU Emacs\n" :link ("Contributing" - ,(lambda (_button) - (view-file (expand-file-name "CONTRIBUTE" data-directory)) - (goto-char (point-min)))) + ,(lambda (_button) (info "(emacs)Contributing"))) "\tHow to contribute improvements to Emacs\n" "\n" :link ("GNU and Freedom" ,(lambda (_button) (describe-gnu-project))) @@ -2072,9 +2040,7 @@ Type \\[describe-distribution] for information on ")) (insert-button "Contributing" 'action - (lambda (_button) - (view-file (expand-file-name "CONTRIBUTE" data-directory)) - (goto-char (point-min))) + (lambda (_button) (info "(emacs)Contributing")) 'follow-link t) (insert "\tHow to contribute improvements to Emacs\n\n") @@ -2446,10 +2412,7 @@ A fancy display is used on graphic displays, normal otherwise." ;; If there are no switches to process, we might as well ;; run this hook now, and there may be some need to do it ;; before doing any output. - (run-hooks 'emacs-startup-hook) - (and term-setup-hook - (run-hooks 'term-setup-hook)) - (setq inhibit-startup-hooks t) + (run-hooks 'emacs-startup-hook 'term-setup-hook) ;; It's important to notice the user settings before we ;; display the startup message; otherwise, the settings @@ -2461,10 +2424,9 @@ A fancy display is used on graphic displays, normal otherwise." ;; If there are no switches to process, we might as well ;; run this hook now, and there may be some need to do it ;; before doing any output. - (when window-setup-hook - (run-hooks 'window-setup-hook) - ;; Don't let the hook be run twice. - (setq window-setup-hook nil)) + (run-hooks 'window-setup-hook) + + (setq inhibit-startup-hooks t) ;; ;; Do this now to avoid an annoying delay if the user ;; ;; clicks the menu bar during the sit-for. diff --git a/lisp/subr.el b/lisp/subr.el index a48038fa12b..68cd230c5e2 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -169,7 +169,8 @@ change the list." ;; So we can use `pop' in the bootstrap before `gv' can be used. (list 'prog1 place (list 'setq place (list 'cdr place))) (gv-letplace (getter setter) place - `(prog1 ,getter ,(funcall setter `(cdr ,getter))))))) + (macroexp-let2 macroexp-copyable-p x getter + `(prog1 ,x ,(funcall setter `(cdr ,x)))))))) (defmacro when (cond &rest body) "If COND yields non-nil, do BODY, else return nil. @@ -265,7 +266,9 @@ information about the function or macro; these go into effect during the evaluation of the `defun' or `defmacro' form. The possible values of SPECS are specified by -`defun-declarations-alist' and `macro-declarations-alist'." +`defun-declarations-alist' and `macro-declarations-alist'. + +For more information, see info node `(elisp)Declare Form'." ;; FIXME: edebug spec should pay attention to defun-declarations-alist. nil) @@ -332,6 +335,7 @@ Any list whose car is `frame-configuration' is assumed to be a frame configuration." (and (consp object) (eq (car object) 'frame-configuration))) + ;;;; List functions. @@ -380,6 +384,13 @@ If N is omitted or nil, remove the last element." (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil)) list)))) +(defun zerop (number) + "Return t if NUMBER is zero." + ;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because + ;; = has a byte-code. + (declare (compiler-macro (lambda (_) `(= 0 ,number)))) + (= 0 number)) + (defun delete-dups (list) "Destructively remove `equal' duplicates from LIST. Store the result in LIST and return it. LIST must be a proper list. @@ -545,6 +556,15 @@ Elements of ALIST that are not conses are ignored." (setq tail tail-cdr)))) alist) +(defun alist-get (key alist &optional default remove) + "Get the value associated to KEY in ALIST. +DEFAULT is the value to return if KEY is not found in ALIST. +REMOVE, if non-nil, means that when setting this element, we should +remove the entry if the new value is `eql' to DEFAULT." + (ignore remove) ;;Silence byte-compiler. + (let ((x (assq key alist))) + (if x (cdr x) default))) + (defun remove (elt seq) "Return a copy of SEQ with all occurrences of ELT removed. SEQ must be a list, vector, or string. The comparison is done with `equal'." @@ -1999,7 +2019,14 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." (or (cdr (assq 'tool-bar global-map)) (lookup-key global-map [tool-bar]))) map)) - (aref (catch 'read-key (read-key-sequence-vector prompt nil t)) 0)) + (let* ((keys + (catch 'read-key (read-key-sequence-vector prompt nil t))) + (key (aref keys 0))) + (if (and (> (length keys) 1) + (memq key '(mode-line header-line + left-fringe right-fringe))) + (aref keys 1) + key))) (cancel-timer timer) (use-global-map old-global-map)))) @@ -2018,7 +2045,7 @@ If optional CONFIRM is non-nil, read the password twice to make sure. Optional DEFAULT is a default password to use instead of empty input. This function echoes `.' for each character that the user types. -Note that in batch mode, the input is not hidden! +You could let-bind `read-hide-char' to another hiding character, though. Once the caller uses the password, it can erase the password by doing (clear-string STRING)." @@ -2043,7 +2070,7 @@ by doing (clear-string STRING)." beg))) (dotimes (i (- end beg)) (put-text-property (+ i beg) (+ 1 i beg) - 'display (string ?.))))) + 'display (string (or read-hide-char ?.)))))) minibuf) (minibuffer-with-setup-hook (lambda () @@ -2057,12 +2084,9 @@ by doing (clear-string STRING)." (setq-local show-paren-mode nil) ;bug#16091. (add-hook 'after-change-functions hide-chars-fun nil 'local)) (unwind-protect - (let ((enable-recursive-minibuffers t)) - (read-string - (if noninteractive - (format "%s[INPUT WILL NOT BE HIDDEN!] " prompt) ; bug#17839 - prompt) - nil t default)) ; t = "no history" + (let ((enable-recursive-minibuffers t) + (read-hide-char (or read-hide-char ?.))) + (read-string prompt nil t default)) ; t = "no history" (when (buffer-live-p minibuf) (with-current-buffer minibuf ;; Not sure why but it seems that there might be cases where the @@ -2197,12 +2221,16 @@ floating point support." (read-event nil t seconds)))) (or (null read) (progn - ;; If last command was a prefix arg, e.g. C-u, push this event onto - ;; unread-command-events as (t . EVENT) so it will be added to - ;; this-command-keys by read-key-sequence. - (if (eq overriding-terminal-local-map universal-argument-map) - (setq read (cons t read))) - (push read unread-command-events) + ;; https://lists.gnu.org/archive/html/emacs-devel/2006-10/msg00394.html + ;; We want `read' appear in the next command's this-command-event + ;; but not in the current one. + ;; By pushing (cons t read), we indicate that `read' has not + ;; yet been recorded in this-command-keys, so it will be recorded + ;; next time it's read. + ;; And indeed the `seconds' argument to read-event correctly + ;; prevented recording this event in the current command's + ;; this-command-keys. + (push (cons t read) unread-command-events) nil)))))) ;; Behind display-popup-menus-p test. @@ -2709,14 +2737,6 @@ computing the hash. If BINARY is non-nil, return a string in binary form." (secure-hash 'sha1 object start end binary)) -(defalias 'function-put #'put - ;; This is only really used in Emacs>24.4, but we add it to 24.4 already, so - ;; as to ease the pain when people use future autoload files that contain - ;; function-put. - "Set function F's property PROP to VALUE. -The namespace for PROP is shared with symbols. -So far, F can only be a symbol, not a lambda expression.") - (defun function-get (f prop &optional autoload) "Return the value of property PROP of function F. If AUTOLOAD is non-nil and F is autoloaded, try to autoload it @@ -2952,6 +2972,14 @@ Similar to `call-process-shell-command', but calls `process-file'." ;;;; Lisp macros to do various things temporarily. +(defmacro track-mouse (&rest body) + "Evaluate BODY with mouse movement events enabled. +Within a `track-mouse' form, mouse motion generates input events that + you can read with `read-event'. +Normally, mouse motion is ignored." + (declare (debug t) (indent 0)) + `(internal--track-mouse (lambda () ,@body))) + (defmacro with-current-buffer (buffer-or-name &rest body) "Execute the forms in BODY with BUFFER-OR-NAME temporarily current. BUFFER-OR-NAME must be a buffer or the name of an existing buffer. @@ -3216,12 +3244,7 @@ not really affect the buffer's content." `(let* ((,modified (buffer-modified-p)) (buffer-undo-list t) (inhibit-read-only t) - (inhibit-modification-hooks t) - deactivate-mark - ;; Avoid setting and removing file locks and checking - ;; buffer's uptodate-ness w.r.t the underlying file. - buffer-file-name - buffer-file-truename) + (inhibit-modification-hooks t)) (unwind-protect (progn ,@body) @@ -3339,6 +3362,19 @@ The value returned is the value of the last form in BODY." ,@body) (with-current-buffer ,old-buffer (set-case-table ,old-case-table)))))) + +(defmacro with-file-modes (modes &rest body) + "Execute BODY with default file permissions temporarily set to MODES. +MODES is as for `set-default-file-modes'." + (declare (indent 1) (debug t)) + (let ((umask (make-symbol "umask"))) + `(let ((,umask (default-file-modes))) + (unwind-protect + (progn + (set-default-file-modes ,modes) + ,@body) + (set-default-file-modes ,umask))))) + ;;; Matching and match data. @@ -3690,12 +3726,14 @@ and replace a sub-expression, e.g. (setq matches (cons (substring string start l) matches)) ; leftover (apply #'concat (nreverse matches))))) -(defun string-prefix-p (str1 str2 &optional ignore-case) - "Return non-nil if STR1 is a prefix of STR2. +(defun string-prefix-p (prefix string &optional ignore-case) + "Return non-nil if PREFIX is a prefix of STRING. If IGNORE-CASE is non-nil, the comparison is done without paying attention to case differences." - (eq t (compare-strings str1 nil nil - str2 0 (length str1) ignore-case))) + (let ((prefix-length (length prefix))) + (if (> prefix-length (length string)) nil + (eq t (compare-strings prefix 0 prefix-length string + 0 prefix-length ignore-case))))) (defun string-suffix-p (suffix string &optional ignore-case) "Return non-nil if SUFFIX is a suffix of STRING. @@ -3859,7 +3897,9 @@ This function is called directly from the C code." ;; discard the file name regexp (mapc #'funcall (cdr a-l-element)))) ;; Complain when the user uses obsolete files. - (when (string-match-p "/obsolete/[^/]*\\'" abs-file) + (when (save-match-data + (and (string-match "/obsolete/\\([^/]*\\)\\'" abs-file) + (not (equal "loaddefs.el" (match-string 1 abs-file))))) ;; Maybe we should just use display-warning? This seems yucky... (let* ((file (file-name-nondirectory abs-file)) (msg (format "Package %s is obsolete!" @@ -3879,7 +3919,8 @@ This function is called directly from the C code." (byte-compile-log-warning msg)) (run-with-timer 0 nil (lambda (msg) - (message "%s" msg)) msg)))) + (message "%s" msg)) + msg)))) ;; Finally, run any other hook. (run-hook-with-args 'after-load-functions abs-file)) @@ -4196,7 +4237,8 @@ I is the index of the frame after FRAME2. It should return nil if those frames don't seem special and otherwise, it should return the number of frames to skip (minus 1).") -(defconst internal--call-interactively (symbol-function 'call-interactively)) +(defconst internal--funcall-interactively + (symbol-function 'funcall-interactively)) (defun called-interactively-p (&optional kind) "Return t if the containing function was called by `call-interactively'. @@ -4270,10 +4312,13 @@ command is called from a keyboard macro?" (pcase (cons frame nextframe) ;; No subr calls `interactive-p', so we can rule that out. (`((,_ ,(pred (lambda (f) (subrp (indirect-function f)))) . ,_) . ,_) nil) - ;; In case #<subr call-interactively> without going through the - ;; `call-interactively' symbol (bug#3984). - (`(,_ . (t ,(pred (eq internal--call-interactively)) . ,_)) t) - (`(,_ . (t call-interactively . ,_)) t))))) + ;; In case #<subr funcall-interactively> without going through the + ;; `funcall-interactively' symbol (bug#3984). + (`(,_ . (t ,(pred (lambda (f) + (eq internal--funcall-interactively + (indirect-function f)))) + . ,_)) + t))))) (defun interactive-p () "Return t if the containing function was run directly by user input. @@ -4321,16 +4366,24 @@ use `called-interactively-p'." Normally, MAP is used only once, to look up the very next key. However, if the optional argument KEEP-PRED is t, MAP stays active if a key from MAP is used. KEEP-PRED can also be a -function of no arguments: if it returns non-nil, then MAP stays -active. +function of no arguments: it is called from `pre-command-hook' and +if it returns non-nil, then MAP stays active. Optional arg ON-EXIT, if non-nil, specifies a function that is called, with no arguments, after MAP is deactivated. This uses `overriding-terminal-local-map' which takes precedence over all other keymaps. As usual, if no match for a key is found in MAP, the normal key -lookup sequence then continues." - (let ((clearfun (make-symbol "clear-transient-map"))) +lookup sequence then continues. + +This returns an \"exit function\", which can be called with no argument +to deactivate this transient map, regardless of KEEP-PRED." + (let* ((clearfun (make-symbol "clear-transient-map")) + (exitfun + (lambda () + (internal-pop-keymap map 'overriding-terminal-local-map) + (remove-hook 'pre-command-hook clearfun) + (when on-exit (funcall on-exit))))) ;; Don't use letrec, because equal (in add/remove-hook) would get trapped ;; in a cycle. (fset clearfun @@ -4354,11 +4407,10 @@ lookup sequence then continues." (eq this-command (lookup-key map (this-command-keys-vector)))) (t (funcall keep-pred))) - (internal-pop-keymap map 'overriding-terminal-local-map) - (remove-hook 'pre-command-hook clearfun) - (when on-exit (funcall on-exit)))))) + (funcall exitfun))))) (add-hook 'pre-command-hook clearfun) - (internal-push-keymap map 'overriding-terminal-local-map))) + (internal-push-keymap map 'overriding-terminal-local-map) + exitfun)) ;;;; Progress reporters. @@ -4466,11 +4518,10 @@ NEW-MESSAGE, if non-nil, sets a new message for the reporter." (min-value (aref parameters 1)) (max-value (aref parameters 2)) (text (aref parameters 3)) - (current-time (float-time)) (enough-time-passed ;; See if enough time has passed since the last update. (or (not update-time) - (when (>= current-time update-time) + (when (>= (float-time) update-time) ;; Calculate time for the next update (aset parameters 0 (+ update-time (aref parameters 5))))))) (cond ((and min-value max-value) @@ -4770,6 +4821,21 @@ which is higher than \"1alpha\", which is higher than \"1snapshot\". Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions." (version-list-= (version-to-list v1) (version-to-list v2))) +(defvar package--builtin-versions + ;; Mostly populated by loaddefs.el via autoload-builtin-package-versions. + (purecopy `((emacs . ,(version-to-list emacs-version)))) + "Alist giving the version of each versioned builtin package. +I.e. each element of the list is of the form (NAME . VERSION) where +NAME is the package name as a symbol, and VERSION is its version +as a list.") + +(defun package--description-file (dir) + (concat (let ((subdir (file-name-nondirectory + (directory-file-name dir)))) + (if (string-match "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" subdir) + (match-string 1 subdir) subdir)) + "-pkg.el")) + ;;; Misc. (defconst menu-bar-separator '("--") diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 1ee54515bea..6c7f7553f82 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -50,9 +50,6 @@ ;; ;; o chmod should understand "a+x,og-w". ;; -;; o It's not possible to add a NEW file to a tar archive; not that -;; important, but still... -;; ;; o The code is less efficient that it could be - in a lot of places, I ;; pull a 512-character string out of the buffer and parse it, when I could ;; be parsing it in place, not garbaging a string. Should redo that. @@ -369,6 +366,80 @@ write-date, checksum, link-type, and link-name." string) (tar-parse-octal-integer string)) +(defun tar-new-regular-file-header (filename &optional size time) + "Return a Tar header for a regular file. +The header will lack a proper checksum; use `tar-header-block-checksum' +to compute one, or request `tar-header-serialize' to do that. + +Other tar-mode facilities may also require the data-start header +field to be set to a valid value. + +If SIZE is not given or nil, it defaults to 0. +If TIME is not given or nil, assume now." + (make-tar-header + nil + filename + #o644 0 0 (or size 0) + (or time (current-time)) + nil ; checksum + nil nil + nil nil nil nil nil)) + +(defun tar--pad-to (pos) + (make-string (+ pos (- (point)) (point-min)) 0)) + +(defun tar--put-at (pos val &optional fmt mask) + (when val + (insert (tar--pad-to pos) + (if fmt + (format fmt (if mask (logand mask val) val)) + val)))) + +(defun tar-header-serialize (header &optional update-checksum) + "Return the serialization of a Tar HEADER as a string. +This function calls `tar-header-block-check-checksum' to ensure the +checksum is correct. + +If UPDATE-CHECKSUM is non-nil, update HEADER with the newly-computed +checksum before doing the check." + (with-temp-buffer + (set-buffer-multibyte nil) + (let ((encoded-name + (encode-coding-string (tar-header-name header) + tar-file-name-coding-system))) + (unless (< (length encoded-name) 99) + ;; FIXME: Implement it. + (error "Long file name support is not implemented")) + (insert encoded-name)) + (tar--put-at tar-mode-offset (tar-header-mode header) "%6o\0 " #o777777) + (tar--put-at tar-uid-offset (tar-header-uid header) "%6o\0 " #o777777) + (tar--put-at tar-gid-offset (tar-header-gid header) "%6o\0 " #o777777) + (tar--put-at tar-size-offset (tar-header-size header) "%11o ") + (insert (tar--pad-to tar-time-offset) + (tar-octal-time (tar-header-date header)) + " ") + ;; Omit tar-header-checksum (tar-chk-offset) for now. + (tar--put-at tar-linkp-offset (tar-header-link-type header)) + (tar--put-at tar-link-offset (tar-header-link-name header)) + (when (tar-header-magic header) + (tar--put-at tar-magic-offset (tar-header-magic header)) + (tar--put-at tar-uname-offset (tar-header-uname header)) + (tar--put-at tar-gname-offset (tar-header-gname header)) + (tar--put-at tar-dmaj-offset (tar-header-dmaj header) "%7o\0" #o7777777) + (tar--put-at tar-dmin-offset (tar-header-dmin header) "%7o\0" #o7777777)) + (tar--put-at 512 "") + (let ((ck (tar-header-block-checksum (buffer-string)))) + (goto-char (+ (point-min) tar-chk-offset)) + (delete-char 8) + (insert (format "%6o\0 " ck)) + (when update-checksum + (setf (tar-header-checksum header) ck)) + (tar-header-block-check-checksum (buffer-string) + (tar-header-checksum header) + (tar-header-name header))) + ;; . + (buffer-string))) + (defun tar-header-block-checksum (string) "Compute and return a tar-acceptable checksum for this block." @@ -547,6 +618,7 @@ MODE should be an integer which is a file mode value." (define-key map "p" 'tar-previous-line) (define-key map "\^P" 'tar-previous-line) (define-key map [up] 'tar-previous-line) + (define-key map "I" 'tar-new-entry) (define-key map "R" 'tar-rename-entry) (define-key map "u" 'tar-unflag) (define-key map "v" 'tar-view) @@ -731,10 +803,14 @@ tar-file's buffer." (interactive "p") (tar-next-line (- arg))) +(defun tar-current-position () + "Return the `tar-parse-info' index for the current line." + (count-lines (point-min) (line-beginning-position))) + (defun tar-current-descriptor (&optional noerror) "Return the tar-descriptor of the current line, or signals an error." ;; I wish lines had plists, like in ZMACS... - (or (nth (count-lines (point-min) (line-beginning-position)) + (or (nth (tar-current-position) tar-parse-info) (if noerror nil @@ -948,6 +1024,37 @@ the current tar-entry." (write-region start end to-file nil nil nil t))) (message "Copied tar entry %s to %s" name to-file))) +(defun tar-new-entry (filename &optional index) + "Insert a new empty regular file before point." + (interactive "*sFile name: ") + (let* ((buffer (current-buffer)) + (index (or index (tar-current-position))) + (d-list (and (not (zerop index)) + (nthcdr (+ -1 index) tar-parse-info))) + (pos (if d-list + (tar-header-data-end (car d-list)) + (point-min))) + (new-descriptor + (tar-new-regular-file-header filename))) + ;; Update the data buffer; fill the missing descriptor fields. + (with-current-buffer tar-data-buffer + (goto-char pos) + (insert (tar-header-serialize new-descriptor t)) + (setf (tar-header-data-start new-descriptor) + (copy-marker (point) nil))) + ;; Update tar-parse-info. + (if d-list + (setcdr d-list (cons new-descriptor (cdr d-list))) + (setq tar-parse-info (cons new-descriptor tar-parse-info))) + ;; Update the listing buffer. + (save-excursion + (goto-char (point-min)) + (forward-line index) + (let ((inhibit-read-only t)) + (insert (tar-header-block-summarize new-descriptor) ?\n))) + ;; . + index)) + (defun tar-flag-deleted (p &optional unflag) "In Tar mode, mark this sub-file to be deleted from the tar file. With a prefix argument, mark that many files." diff --git a/lisp/tempo.el b/lisp/tempo.el index 9f7c2ed5f2b..92e1ea78da4 100644 --- a/lisp/tempo.el +++ b/lisp/tempo.el @@ -611,11 +611,7 @@ function or string that is used by `\\[tempo-complete-tag]' to find a string to match the tag against. It has the same definition as the variable `tempo-match-finder'. In this version, supplying a COMPLETION-FUNCTION just sets `tempo-match-finder' locally." - (let ((old (assq tag-list tempo-local-tags))) - (if old - (setcdr old completion-function) - (setq tempo-local-tags (cons (cons tag-list completion-function) - tempo-local-tags)))) + (setf (alist-get tag-list tempo-local-tags) completion-function) (if completion-function (setq tempo-match-finder completion-function)) (tempo-invalidate-collection)) diff --git a/lisp/term.el b/lisp/term.el index 6afae98e5ae..a629af90d3e 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -165,15 +165,13 @@ ;; full advantage of this package ;; ;; (add-hook 'term-mode-hook -;; (function -;; (lambda () -;; (setq term-prompt-regexp "^[^#$%>\n]*[#$%>] *") -;; (make-local-variable 'mouse-yank-at-point) -;; (make-local-variable 'transient-mark-mode) -;; (setq mouse-yank-at-point t) -;; (setq transient-mark-mode nil) -;; (auto-fill-mode -1) -;; (setq tab-width 8 )))) +;; (function +;; (lambda () +;; (setq term-prompt-regexp "^[^#$%>\n]*[#$%>] *") +;; (setq-local mouse-yank-at-point t) +;; (setq-local transient-mark-mode nil) +;; (auto-fill-mode -1) +;; (setq tab-width 8 )))) ;; ;; ;; ---------------------------------------- @@ -1254,16 +1252,7 @@ without any interpretation." (run-hooks 'mouse-leave-buffer-hook) (setq this-command 'yank) (mouse-set-point click) - (term-send-raw-string - ;; From `mouse-yank-primary': - (or (if (fboundp 'x-get-selection-value) - (if (eq system-type 'windows-nt) - (or (x-get-selection 'PRIMARY) - (x-get-selection-value)) - (or (x-get-selection-value) - (x-get-selection 'PRIMARY))) - (x-get-selection 'PRIMARY)) - (error "No selection is available"))))) + (term-send-raw-string (gui-get-primary-selection)))) (defun term-paste () "Insert the last stretch of killed text at point." @@ -3635,7 +3624,7 @@ all pending output has been dealt with.")) (if (< down 0) term-scroll-start term-scroll-end)))) (when (or (and (< down 0) (< scroll-needed 0)) (and (> down 0) (> scroll-needed 0))) - (let ((save-point (copy-marker (point))) (save-top)) + (let ((save-point (point-marker)) (save-top)) (goto-char term-home-marker) (cond (term-scroll-with-delete (if (< down 0) diff --git a/lisp/term/AT386.el b/lisp/term/AT386.el index 2ffef42bd5d..84420a5da22 100644 --- a/lisp/term/AT386.el +++ b/lisp/term/AT386.el @@ -22,8 +22,6 @@ ;;; Commentary: -;; Uses the Emacs 19 terminal initialization features --- won't work with 18. - ;;; Code: (defun terminal-init-AT386 () diff --git a/lisp/term/README b/lisp/term/README index f9352c6c84c..35715d97bb4 100644 --- a/lisp/term/README +++ b/lisp/term/README @@ -5,9 +5,11 @@ See the end of the file for license conditions. This directory contains files of elisp that customize Emacs for certain terminal types. - When Emacs opens a new terminal, it checks the TERM environment variable to -see what type of terminal the user is running on, searches for an elisp file -named "term/${TERM}.el", and if one exists, loads it. If Emacs finds no + When Emacs opens a new terminal, it checks the TERM environment variable +to see what type of terminal the user is running on. (If there is an entry +for TERM in the `term-file-aliases' variable, Emacs uses the associated value +in place of TERM in the following.) Emacs searches for an elisp file named +"term/${TERM}.el", and if one exists, loads it. If Emacs finds no suitable file, then it strips the last hyphen and what follows it from TERM, and tries again. If that still doesn't yield a file, then the previous hyphen is stripped, and so on until all hyphens are gone. For example, if the diff --git a/lisp/term/apollo.el b/lisp/term/apollo.el deleted file mode 100644 index e4cabac3bf1..00000000000 --- a/lisp/term/apollo.el +++ /dev/null @@ -1,5 +0,0 @@ -(defun terminal-init-apollo () - "Terminal initialization function for apollo." - (tty-run-terminal-initialization (selected-frame) "vt100")) - -;;; apollo.el ends here diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el index fa6f7c79226..64459353e1c 100644 --- a/lisp/term/common-win.el +++ b/lisp/term/common-win.el @@ -24,67 +24,6 @@ ;;; Code: -(defcustom x-select-enable-clipboard t - "Non-nil means cutting and pasting uses the clipboard. -This is in addition to, but in preference to, the primary selection. - -Note that MS-Windows does not support selection types other than the -clipboard. (The primary selection that is set by Emacs is not -accessible to other programs on MS-Windows.) - -This variable is not used by the Nextstep port." - :type 'boolean - :group 'killing - ;; The GNU/Linux version changed in 24.1, the MS-Windows version did not. - :version "24.1") - -(defvar x-last-selected-text) ; w32-fns.el -(declare-function w32-set-clipboard-data "w32select.c" - (string &optional ignored)) -(defvar ns-last-selected-text) ; ns-win.el -(declare-function ns-set-pasteboard "ns-win" (string)) - -(defvar x-select-enable-primary) ; x-win.el -(defvar x-last-selected-text-primary) -(defvar x-last-selected-text-clipboard) -(defvar saved-region-selection) ; simple.el - -(defun x-select-text (text) - "Select TEXT, a string, according to the window system. - -On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the -clipboard. If `x-select-enable-primary' is non-nil, put TEXT in -the primary selection. - -On MS-Windows, make TEXT the current selection. If -`x-select-enable-clipboard' is non-nil, copy the text to the -clipboard as well. - -On Nextstep, put TEXT in the pasteboard (`x-select-enable-clipboard' -is not used)." - (cond ((eq (framep (selected-frame)) 'w32) - (if x-select-enable-clipboard - (w32-set-clipboard-data text)) - (setq x-last-selected-text text)) - ((featurep 'ns) - ;; Don't send the pasteboard too much text. - ;; It becomes slow, and if really big it causes errors. - (ns-set-pasteboard text) - (setq ns-last-selected-text text)) - (t - ;; With multi-tty, this function may be called from a tty frame. - (when (eq (framep (selected-frame)) 'x) - (when x-select-enable-primary - (x-set-selection 'PRIMARY text) - (setq x-last-selected-text-primary text)) - (when x-select-enable-clipboard - ;; When cutting, the selection is cleared and PRIMARY set to - ;; the empty string. Prevent that, PRIMARY should not be reset - ;; by cut (Bug#16382). - (setq saved-region-selection text) - (x-set-selection 'CLIPBOARD text) - (setq x-last-selected-text-clipboard text)))))) - ;;;; Function keys (defvar x-alternatives-map @@ -117,9 +56,7 @@ is not used)." (set-keymap-parent map (keymap-parent local-function-key-map)) (set-keymap-parent local-function-key-map map)) (when (featurep 'ns) - (setq interprogram-cut-function 'x-select-text - interprogram-paste-function 'x-selection-value - system-key-alist + (setq system-key-alist (list ;; These are special "keys" used to pass events from C to lisp. (cons (logior (lsh 0 16) 1) 'ns-power-off) diff --git a/lisp/term/news.el b/lisp/term/news.el index 084a8e3f829..4caac2a06c7 100644 --- a/lisp/term/news.el +++ b/lisp/term/news.el @@ -22,8 +22,6 @@ ;;; Commentary: -;; Uses the Emacs 19 terminal initialization features --- won't work with 18. - ;;; Code: (defun terminal-init-news () diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index fbaee2a3f1b..9264a1cf033 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -718,52 +718,18 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;;;; Pasteboard support. (declare-function ns-get-selection-internal "nsselect.m" (buffer)) -(declare-function ns-store-selection-internal "nsselect.m" (buffer string)) (define-obsolete-function-alias 'ns-get-cut-buffer-internal 'ns-get-selection-internal "24.1") (define-obsolete-function-alias 'ns-store-cut-buffer-internal - 'ns-store-selection-internal "24.1") - - -(defun ns-get-pasteboard () - "Returns the value of the pasteboard." - (ns-get-selection-internal 'CLIPBOARD)) - -(defun ns-set-pasteboard (string) - "Store STRING into the pasteboard of the Nextstep display server." - ;; Check the data type of STRING. - (if (not (stringp string)) (error "Nonstring given to pasteboard")) - (ns-store-selection-internal 'CLIPBOARD string)) - -;; We keep track of the last text selected here, so we can check the -;; current selection against it, and avoid passing back our own text -;; from x-selection-value. -(defvar ns-last-selected-text nil) - -;; Return the value of the current Nextstep selection. For -;; compatibility with older Nextstep applications, this checks cut -;; buffer 0 before retrieving the value of the primary selection. -(defun x-selection-value () - (let (text) - ;; Consult the selection. Treat empty strings as if they were unset. - (or text (setq text (ns-get-pasteboard))) - (if (string= text "") (setq text nil)) - (cond - ((not text) nil) - ((eq text ns-last-selected-text) nil) - ((string= text ns-last-selected-text) - ;; Record the newer string, so subsequent calls can use the `eq' test. - (setq ns-last-selected-text text) - nil) - (t - (setq ns-last-selected-text text))))) + 'gui-set-selection "24.1") + (defun ns-copy-including-secondary () (interactive) (call-interactively 'kill-ring-save) - (ns-store-selection-internal 'SECONDARY - (buffer-substring (point) (mark t)))) + (gui-set-selection 'SECONDARY (buffer-substring (point) (mark t)))) + (defun ns-paste-secondary () (interactive) (insert (ns-get-selection-internal 'SECONDARY))) @@ -959,10 +925,18 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;; Any display name is OK. (add-to-list 'display-format-alist '(".*" . ns)) -(add-to-list 'handle-args-function-alist '(ns . x-handle-args)) -(add-to-list 'frame-creation-function-alist '(ns . x-create-frame-with-faces)) -(add-to-list 'window-system-initialization-alist '(ns . ns-initialize-window-system)) - +(gui-method-define handle-args-function ns #'x-handle-args) +(gui-method-define frame-creation-function ns #'x-create-frame-with-faces) +(gui-method-define window-system-initialization ns + #'ns-initialize-window-system) + +(gui-method-define gui-set-selection ns + (lambda (selection value) + (if value (ns-own-selection-internal selection value) + (ns-disown-selection-internal selection)))) +(gui-method-define gui-selection-owner-p ns #'ns-selection-owner-p) +(gui-method-define gui-selection-exists-p ns #'ns-selection-exists-p) +(gui-method-define gui-get-selection ns #'ns-get-selection) (provide 'ns-win) diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el index b2e819ddbca..dd4a8ae8d13 100644 --- a/lisp/term/pc-win.el +++ b/lisp/term/pc-win.el @@ -1,4 +1,4 @@ -;;; pc-win.el --- setup support for `PC windows' (whatever that is) +;;; pc-win.el --- setup support for `PC windows' (whatever that is) -*- lexical-binding:t -*- ;; Copyright (C) 1994, 1996-1997, 1999, 2001-2015 Free Software ;; Foundation, Inc. @@ -45,20 +45,20 @@ (declare-function w16-get-clipboard-data "w16select.c") (declare-function msdos-setup-keyboard "internal" (frame)) -;;; This was copied from etc/rgb.txt, except that some values were changed -;;; a bit to make them consistent with DOS console colors, and the RGB -;;; values were scaled up to 16 bits, as `tty-define-color' requires. +;; This was copied from etc/rgb.txt, except that some values were changed +;; a bit to make them consistent with DOS console colors, and the RGB +;; values were scaled up to 16 bits, as `tty-define-color' requires. ;;; -;;; The mapping between the 16 standard EGA/VGA colors and X color names -;;; was done by running a Unix version of Emacs inside an X client and a -;;; DJGPP-compiled Emacs on the same PC. The names of X colors used to -;;; define the pixel values are shown as comments to each color below. +;; The mapping between the 16 standard EGA/VGA colors and X color names +;; was done by running a Unix version of Emacs inside an X client and a +;; DJGPP-compiled Emacs on the same PC. The names of X colors used to +;; define the pixel values are shown as comments to each color below. ;;; -;;; If you want to change the RGB values, keep in mind that various pieces -;;; of Emacs think that a color whose RGB values add up to less than 0.6 of -;;; the values for WHITE (i.e. less than 117963) are ``dark'', otherwise the -;;; color is ``light''; see `frame-set-background-mode' in lisp/faces.el for -;;; an example. +;; If you want to change the RGB values, keep in mind that various pieces +;; of Emacs think that a color whose RGB values add up to less than 0.6 of +;; the values for WHITE (i.e. less than 117963) are ``dark'', otherwise the +;; color is ``light''; see `frame-set-background-mode' in lisp/faces.el for +;; an example. (defvar msdos-color-values '(("black" 0 0 0 0) ("blue" 1 0 0 52480) ; MediumBlue @@ -219,146 +219,50 @@ the operating system.") ; ;;;; Selections ; -;;; We keep track of the last text selected here, so we can check the -;;; current selection against it, and avoid passing back our own text -;;; from x-selection-value. -(defvar x-last-selected-text nil) - -(defcustom x-select-enable-clipboard t - "Non-nil means cutting and pasting uses the clipboard. -This is in addition to, but in preference to, the primary selection. - -Note that MS-Windows does not support selection types other than the -clipboard. (The primary selection that is set by Emacs is not -accessible to other programs on MS-Windows.) - -This variable is not used by the Nextstep port." - :type 'boolean - :group 'killing) - -(defun x-select-text (text) - "Select TEXT, a string, according to the window system. - -On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the -clipboard. If `x-select-enable-primary' is non-nil, put TEXT in -the primary selection. - -On MS-Windows, make TEXT the current selection. If -`x-select-enable-clipboard' is non-nil, copy the text to the -clipboard as well. - -On Nextstep, put TEXT in the pasteboard (`x-select-enable-clipboard' -is not used)." - (if x-select-enable-clipboard - (w16-set-clipboard-data text)) - (setq x-last-selected-text text)) - -(defun x-get-selection-value () +(defun w16-get-selection-value (_selection-symbol _target-type) "Return the value of the current selection. Consult the selection. Treat empty strings as if they were unset." - (if x-select-enable-clipboard - (let (text) - ;; Don't die if x-get-selection signals an error. - (with-demoted-errors "w16-get-clipboard-data:%s" - (setq text (w16-get-clipboard-data))) - (if (string= text "") (setq text nil)) - (cond - ((not text) nil) - ((eq text x-last-selected-text) nil) - ((string= text x-last-selected-text) - ;; Record the newer string, so subsequent calls can use the 'eq' test. - (setq x-last-selected-text text) - nil) - (t - (setq x-last-selected-text text)))))) - -;; x-selection-owner-p is used in simple.el. -(defun x-selection-owner-p (&optional _selection _terminal) - "Whether the current Emacs process owns the given X Selection. -The arg should be the name of the selection in question, typically one of -the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. -\(Those are literal upper-case symbol names, since that's what X expects.) -For convenience, the symbol nil is the same as `PRIMARY', -and t is the same as `SECONDARY'. - -TERMINAL should be a terminal object or a frame specifying the X -server to query. If omitted or nil, that stands for the selected -frame's display, or the first available X display. - -On Nextstep, TERMINAL is unused. - -\(fn &optional SELECTION TERMINAL)" - (if x-select-enable-clipboard - (let (text) - ;; Don't die if w16-get-clipboard-data signals an error. - (ignore-errors - (setq text (w16-get-clipboard-data))) - ;; We consider ourselves the owner of the selection if it does - ;; not exist, or exists and compares equal with the last text - ;; we've put into the Windows clipboard. - (cond - ((not text) t) - ((or (eq text x-last-selected-text) - (string= text x-last-selected-text)) - text) - (t nil))))) - -;; x-own-selection-internal and x-disown-selection-internal are used -;; in select.el:x-set-selection. -(defun x-own-selection-internal (_selection value &optional _frame) - "Assert an X selection of the type SELECTION with and value VALUE. -SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. -\(Those are literal upper-case symbol names, since that's what X expects.) -VALUE is typically a string, or a cons of two markers, but may be -anything that the functions on `selection-converter-alist' know about. - -FRAME should be a frame that should own the selection. If omitted or -nil, it defaults to the selected frame. - -On Nextstep, FRAME is unused. - -\(fn SELECTION VALUE &optional FRAME)" - (ignore-errors - (x-select-text value)) - value) - -(defun x-disown-selection-internal (selection &optional _time-object _terminal) - "If we own the selection SELECTION, disown it. -Disowning it means there is no such selection. - -Sets the last-change time for the selection to TIME-OBJECT (by default -the time of the last event). - -TERMINAL should be a terminal object or a frame specifying the X -server to query. If omitted or nil, that stands for the selected -frame's display, or the first available X display. - -On Nextstep, the TIME-OBJECT and TERMINAL arguments are unused. -On MS-DOS, all this does is return non-nil if we own the selection. - -\(fn SELECTION &optional TIME-OBJECT TERMINAL)" - (if (x-selection-owner-p selection) - t)) - -;; x-get-selection-internal is used in select.el -(defun x-get-selection-internal (_selection-symbol _target-type - &optional _time-stamp _terminal) - "Return text selected from some X window. -SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. -\(Those are literal upper-case symbol names, since that's what X expects.) -TARGET-TYPE is the type of data desired, typically `STRING'. - -TIME-STAMP is the time to use in the XConvertSelection call for foreign -selections. If omitted, defaults to the time for the last event. - -TERMINAL should be a terminal object or a frame specifying the X -server to query. If omitted or nil, that stands for the selected -frame's display, or the first available X display. - -On Nextstep, TIME-STAMP and TERMINAL are unused. - -\(fn SELECTION-SYMBOL TARGET-TYPE &optional TIME-STAMP TERMINAL)" - (x-get-selection-value)) + ;; Don't die if x-get-selection signals an error. + (with-demoted-errors "w16-get-clipboard-data:%s" + (w16-get-clipboard-data))) + +(declare-function w16-selection-exists-p "w16select.c") +;; gui-selection-owner-p is used in simple.el. +(gui-method-define gui-selection-exists-p pc #'w16-selection-exists-p) +(gui-method-define gui-selection-owner-p pc #'w16-selection-owner-p) + +(defun w16-selection-owner-p (_selection) + ;; FIXME: Other systems don't obey select-enable-clipboard here. + (if select-enable-clipboard + (let ((text + ;; Don't die if w16-get-clipboard-data signals an error. + (with-demoted-errors "w16-get-clipboard-data: %S" + (w16-get-clipboard-data)))) + ;; We consider ourselves the owner of the selection + ;; if it does not exist, or exists and compares + ;; equal with the last text we've put into the + ;; Windows clipboard. + (cond + ((not text) t) + ((equal text gui--last-selected-text-clipboard) text) + (t nil))))) + +;; gui-set-selection is used in gui-set-selection. +(declare-function w16-set-clipboard-data "w16select.c" + (string &optional ignored)) +(gui-method-define gui-set-selection pc + (lambda (selection value) + (if (not value) + (if (w16-selection-owner-p selection) + t) + ;; FIXME: Other systems don't obey + ;; gui-select-enable-clipboard here. + (with-demoted-errors "w16-set-clipboard-data: %S" + (w16-set-clipboard-data value)) + value))) + +;; gui-get-selection is used in select.el +(gui-method-define gui-get-selection pc #'w16-get-selection-value) ;; From src/fontset.c: (fset 'query-fontset 'ignore) @@ -463,20 +367,20 @@ Errors out because it is not supposed to be called, ever." (setq split-window-keep-point t) ;; Arrange for the kill and yank functions to set and check the ;; clipboard. - (setq interprogram-cut-function 'x-select-text) - (setq interprogram-paste-function 'x-get-selection-value) (menu-bar-enable-clipboard) (run-hooks 'terminal-init-msdos-hook)) ;; frame-creation-function-alist is examined by frame.el:make-frame. -(add-to-list 'frame-creation-function-alist - '(pc . msdos-create-frame-with-faces)) +(gui-method-define frame-creation-function + pc #'msdos-create-frame-with-faces) ;; window-system-initialization-alist is examined by startup.el:command-line. -(add-to-list 'window-system-initialization-alist - '(pc . msdos-initialize-window-system)) +(gui-method-define window-system-initialization + pc #'msdos-initialize-window-system) ;; We don't need anything beyond tty-handle-args for handling ;; command-line argument; see startup.el. -(add-to-list 'handle-args-function-alist '(pc . tty-handle-args)) +(gui-method-define handle-args-function pc #'tty-handle-args) + + ;; --------------------------------------------------------------------------- diff --git a/lisp/term/screen.el b/lisp/term/screen.el index d37a695086a..3587c4f95e5 100644 --- a/lisp/term/screen.el +++ b/lisp/term/screen.el @@ -1,12 +1,9 @@ -;; Treat a screen terminal similar to an xterm. -(load "term/xterm") - -(declare-function xterm-register-default-colors "xterm" ()) +;;; screen.el --- terminal initialization for screen and tmux -*- lexical-binding: t -*- +;; Copyright (C) 1995, 2001-2015 Free Software Foundation, Inc. (defun terminal-init-screen () "Terminal initialization function for screen." - ;; Use the xterm color initialization code. - (xterm-register-default-colors) - (tty-set-up-initial-frame-faces)) + ;; Treat a screen terminal similar to an xterm. + (tty-run-terminal-initialization (selected-frame) "xterm")) ;; screen.el ends here diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el index 409f93c1ece..3571b488e7d 100644 --- a/lisp/term/tvi970.el +++ b/lisp/term/tvi970.el @@ -23,8 +23,6 @@ ;;; Commentary: -;; Uses the Emacs 19 terminal initialization features --- won't work with 18. - ;;; Code: (defvar tvi970-terminal-map diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el index ae4f14d2781..8136f2e5d53 100644 --- a/lisp/term/vt100.el +++ b/lisp/term/vt100.el @@ -22,8 +22,6 @@ ;;; Commentary: -;; Uses the Emacs 19 terminal initialization features --- won't work with 18. - ;; Handles all VT100 clones, including the Apollo terminal. Also handles ;; the VT200 --- its PF- and arrow- keys are different, but all those ;; are really set up by the terminal initialization code, which mines them diff --git a/lisp/term/vt102.el b/lisp/term/vt102.el deleted file mode 100644 index 261b0bb5fd6..00000000000 --- a/lisp/term/vt102.el +++ /dev/null @@ -1,6 +0,0 @@ - -(defun terminal-init-vt102 () - "Terminal initialization function for vt102." - (tty-run-terminal-initialization (selected-frame) "vt100")) - -;;; vt102.el ends here diff --git a/lisp/term/vt125.el b/lisp/term/vt125.el deleted file mode 100644 index 2b2098d483d..00000000000 --- a/lisp/term/vt125.el +++ /dev/null @@ -1,6 +0,0 @@ - -(defun terminal-init-vt125 () - "Terminal initialization function for vt125." - (tty-run-terminal-initialization (selected-frame) "vt100")) - -;;; vt125.el ends here diff --git a/lisp/term/vt201.el b/lisp/term/vt201.el deleted file mode 100644 index a65b4737731..00000000000 --- a/lisp/term/vt201.el +++ /dev/null @@ -1,10 +0,0 @@ -;; For our purposes we can treat the vt200 and vt100 almost alike. -;; Most differences are handled by the termcap entry. -(defun terminal-init-vt201 () - "Terminal initialization function for vt201." - (tty-run-terminal-initialization (selected-frame) "vt100") - ;; Make F11 an escape key. - (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. - (define-key local-function-key-map [f11] [?\e])) - -;;; vt201.el ends here diff --git a/lisp/term/vt220.el b/lisp/term/vt220.el deleted file mode 100644 index 0dd43353c55..00000000000 --- a/lisp/term/vt220.el +++ /dev/null @@ -1,10 +0,0 @@ -;; For our purposes we can treat the vt200 and vt100 almost alike. -;; Most differences are handled by the termcap entry. -(defun terminal-init-vt220 () - "Terminal initialization function for vt220." - (tty-run-terminal-initialization (selected-frame) "vt100") - ;; Make F11 an escape key. - (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. - (define-key local-function-key-map [f11] [?\e])) - -;;; vt220.el ends here diff --git a/lisp/term/vt240.el b/lisp/term/vt240.el deleted file mode 100644 index b58d4211ce7..00000000000 --- a/lisp/term/vt240.el +++ /dev/null @@ -1,10 +0,0 @@ -;; For our purposes we can treat the vt200 and vt100 almost alike. -;; Most differences are handled by the termcap entry. -(defun terminal-init-vt240 () - "Terminal initialization function for vt240." - (tty-run-terminal-initialization (selected-frame) "vt100") - ;; Make F11 an escape key. - (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. - (define-key local-function-key-map [f11] [?\e])) - -;;; vt240.el ends here diff --git a/lisp/term/vt300.el b/lisp/term/vt300.el deleted file mode 100644 index a2664552a64..00000000000 --- a/lisp/term/vt300.el +++ /dev/null @@ -1,8 +0,0 @@ -(defun terminal-init-vt300 () - "Terminal initialization function for vt300." - (tty-run-terminal-initialization (selected-frame) "vt100") - ;; Make F11 an escape key. - (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. - (define-key local-function-key-map [f11] [?\e])) - -;;; vt300.el ends here diff --git a/lisp/term/vt320.el b/lisp/term/vt320.el deleted file mode 100644 index 08ed9a8ffb9..00000000000 --- a/lisp/term/vt320.el +++ /dev/null @@ -1,8 +0,0 @@ -(defun terminal-init-vt320 () - "Terminal initialization function for vt320." - (tty-run-terminal-initialization (selected-frame) "vt100") - ;; Make F11 an escape key. - (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. - (define-key local-function-key-map [f11] [?\e])) - -;;; vt320.el ends here diff --git a/lisp/term/vt400.el b/lisp/term/vt400.el deleted file mode 100644 index ad4a5fdbb4f..00000000000 --- a/lisp/term/vt400.el +++ /dev/null @@ -1,8 +0,0 @@ -(defun terminal-init-vt400 () - "Terminal initialization function for vt400." - (tty-run-terminal-initialization (selected-frame) "vt100") - ;; Make F11 an escape key. - (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. - (define-key local-function-key-map [f11] [?\e])) - -;;; vt400.el ends here diff --git a/lisp/term/vt420.el b/lisp/term/vt420.el deleted file mode 100644 index f6745a3953a..00000000000 --- a/lisp/term/vt420.el +++ /dev/null @@ -1,8 +0,0 @@ -(defun terminal-init-vt420 () - "Terminal initialization function for vt420." - (tty-run-terminal-initialization (selected-frame) "vt100") - ;; Make F11 an escape key. - (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. - (define-key local-function-key-map [f11] [?\e])) - -;;; vt420.el ends here diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 6db7e201bec..b5e6ff34743 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -205,13 +205,14 @@ European languages which are distributed with Windows as See the documentation of `create-fontset-from-fontset-spec' for the format.") -(defun x-win-suspend-error () - "Report an error when a suspend is attempted. -This returns an error if any Emacs frames are X frames, or always under W32." +(defun w32-win-suspend-error () + "Report an error when a suspend is attempted." (error "Suspending an Emacs running under W32 makes no sense")) (defvar dynamic-library-alist) (defvar libpng-version) ; image.c #ifdef HAVE_NTGUI +(defvar libgif-version) +(defvar libjpeg-version) ;;; Set default known names for external libraries (setq dynamic-library-alist @@ -353,7 +354,7 @@ This returns an error if any Emacs frames are X frames, or always under W32." (cons '(reverse . t) default-frame-alist))))) ;; Don't let Emacs suspend under Windows. - (add-hook 'suspend-hook 'x-win-suspend-error) + (add-hook 'suspend-hook #'w32-win-suspend-error) ;; Turn off window-splitting optimization; w32 is usually fast enough ;; that this is only annoying. @@ -371,9 +372,67 @@ This returns an error if any Emacs frames are X frames, or always under W32." (setq w32-initialized t)) (add-to-list 'display-format-alist '("\\`w32\\'" . w32)) -(add-to-list 'handle-args-function-alist '(w32 . x-handle-args)) -(add-to-list 'frame-creation-function-alist '(w32 . x-create-frame-with-faces)) -(add-to-list 'window-system-initialization-alist '(w32 . w32-initialize-window-system)) +(gui-method-define handle-args-function w32 #'x-handle-args) +(gui-method-define frame-creation-function w32 + #'x-create-frame-with-faces) +(gui-method-define window-system-initialization w32 + #'w32-initialize-window-system) + +;;;; Selections + +(declare-function w32-set-clipboard-data "w32select.c" + (string &optional ignored)) +(declare-function w32-get-clipboard-data "w32select.c") +(declare-function w32-selection-exists-p "w32select.c") + +;;; Fix interface to (X-specific) mouse.el +(defun w32--set-selection (type value) + (if (eq type 'CLIPBOARD) + (w32-set-clipboard-data value) + (put 'x-selections (or type 'PRIMARY) value))) + +(defun w32--get-selection (&optional type data-type) + (if (and (eq type 'CLIPBOARD) + (eq data-type 'STRING)) + (with-demoted-errors "w32-get-clipboard-data:%S" + (w32-get-clipboard-data)) + (get 'x-selections (or type 'PRIMARY)))) + +(defun w32--selection-owner-p (selection) + (and (memq selection '(nil PRIMARY SECONDARY)) + (get 'x-selections (or selection 'PRIMARY)))) + +(gui-method-define gui-set-selection w32 #'w32--set-selection) +(gui-method-define gui-get-selection w32 #'w32--get-selection) + +(gui-method-define gui-selection-owner-p w32 #'w32--selection-owner-p) +(gui-method-define gui-selection-exists-p w32 #'w32-selection-exists-p) + +(when (eq system-type 'windows-nt) + ;; Make copy&pasting in w32's console interact with the system's clipboard! + (gui-method-define gui-set-selection nil #'w32--set-selection) + (gui-method-define gui-get-selection nil #'w32--get-selection) + (gui-method-define gui-selection-owner-p nil #'w32--selection-owner-p) + (gui-method-define gui-selection-exists-p nil #'w32-selection-exists-p)) + +;; The "Windows" keys on newer keyboards bring up the Start menu +;; whether you want it or not - make Emacs ignore these keystrokes +;; rather than beep. +(global-set-key [lwindow] 'ignore) +(global-set-key [rwindow] 'ignore) + +(declare-function x-server-version "w32fns.c" (&optional terminal)) + +(defun w32-version () + "Return the MS-Windows version numbers. +The value is a list of three integers: the major and minor version +numbers, and the build number." + (x-server-version)) + +(defun w32-using-nt () + "Return non-nil if running on a Windows NT descendant. +That includes all Windows systems except for 9X/Me." + (getenv "SystemRoot")) (provide 'w32-win) diff --git a/lisp/term/wyse50.el b/lisp/term/wyse50.el index 7170fc3d21d..47c0ba34ea4 100644 --- a/lisp/term/wyse50.el +++ b/lisp/term/wyse50.el @@ -24,7 +24,6 @@ ;;; Commentary: -;; Uses the Emacs 19 terminal initialization features --- won't work with 18. ;; Rewritten for Emacs 19 by jimb, January 1992 ;; Cleaned up for new terminal package conventions by esr, March 1993 ;; Should work well for Televideo TVI 925 although it's overkill. diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index ca0ae3bd9e2..b0902942f8f 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1,4 +1,4 @@ -;;; x-win.el --- parse relevant switches and set up for X -*-coding: iso-2022-7bit;-*- +;;; x-win.el --- parse relevant switches and set up for X -*-coding: iso-2022-7bit; lexical-binding:t -*- ;; Copyright (C) 1993-1994, 2001-2015 Free Software Foundation, Inc. @@ -1154,157 +1154,17 @@ as returned by `x-server-vendor'." ;;;; Selections -;; We keep track of the last text selected here, so we can check the -;; current selection against it, and avoid passing back our own text -;; from x-selection-value. We track both -;; separately in case another X application only sets one of them -;; we aren't fooled by the PRIMARY or CLIPBOARD selection staying the same. -(defvar x-last-selected-text-clipboard nil - "The value of the CLIPBOARD X selection last time we selected or -pasted text.") -(defvar x-last-selected-text-primary nil - "The value of the PRIMARY X selection last time we selected or -pasted text.") - -(defcustom x-select-enable-primary nil - "Non-nil means cutting and pasting uses the primary selection." - :type 'boolean - :group 'killing - :version "24.1") - -(defcustom x-select-request-type nil - "Data type request for X selection. -The value is one of the following data types, a list of them, or nil: - `COMPOUND_TEXT', `UTF8_STRING', `STRING', `TEXT' - -If the value is one of the above symbols, try only the specified type. - -If the value is a list of them, try each of them in the specified -order until succeed. - -The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)." - :type '(choice (const :tag "Default" nil) - (const COMPOUND_TEXT) - (const UTF8_STRING) - (const STRING) - (const TEXT) - (set :tag "List of values" - (const COMPOUND_TEXT) - (const UTF8_STRING) - (const STRING) - (const TEXT))) - :group 'killing) - -;; Get a selection value of type TYPE by calling x-get-selection with -;; an appropriate DATA-TYPE argument decided by `x-select-request-type'. -;; The return value is already decoded. If x-get-selection causes an -;; error, this function return nil. - -(defun x-selection-value-internal (type) - (let ((request-type (or x-select-request-type - '(UTF8_STRING COMPOUND_TEXT STRING))) - text) - (if (consp request-type) - (while (and request-type (not text)) - (condition-case nil - (setq text (x-get-selection type (car request-type))) - (error nil)) - (setq request-type (cdr request-type))) - (condition-case nil - (setq text (x-get-selection type request-type)) - (error nil))) - (if text - (remove-text-properties 0 (length text) '(foreign-selection nil) text)) - text)) - -(defvar x-select-enable-clipboard) ; common-win - -;; Return the value of the current X selection. -;; Consult the selection. Treat empty strings as if they were unset. -;; If this function is called twice and finds the same text, -;; it returns nil the second time. This is so that a single -;; selection won't be added to the kill ring over and over. -(defun x-selection-value () - ;; With multi-tty, this function may be called from a tty frame. - (when (eq (framep (selected-frame)) 'x) - (let (clip-text primary-text) - (when x-select-enable-clipboard - (setq clip-text (x-selection-value-internal 'CLIPBOARD)) - (if (string= clip-text "") (setq clip-text nil)) - - ;; Check the CLIPBOARD selection for 'newness', is it different - ;; from what we remembered them to be last time we did a - ;; cut/paste operation. - (setq clip-text - (cond ;; check clipboard - ((or (not clip-text) (string= clip-text "")) - (setq x-last-selected-text-clipboard nil)) - ((eq clip-text x-last-selected-text-clipboard) nil) - ((string= clip-text x-last-selected-text-clipboard) - ;; Record the newer string, - ;; so subsequent calls can use the `eq' test. - (setq x-last-selected-text-clipboard clip-text) - nil) - (t (setq x-last-selected-text-clipboard clip-text))))) - - (when x-select-enable-primary - (setq primary-text (x-selection-value-internal 'PRIMARY)) - ;; Check the PRIMARY selection for 'newness', is it different - ;; from what we remembered them to be last time we did a - ;; cut/paste operation. - (setq primary-text - (cond ;; check primary selection - ((or (not primary-text) (string= primary-text "")) - (setq x-last-selected-text-primary nil)) - ((eq primary-text x-last-selected-text-primary) nil) - ((string= primary-text x-last-selected-text-primary) - ;; Record the newer string, - ;; so subsequent calls can use the `eq' test. - (setq x-last-selected-text-primary primary-text) - nil) - (t - (setq x-last-selected-text-primary primary-text))))) - - ;; As we have done one selection, clear this now. - (setq next-selection-coding-system nil) - - ;; At this point we have recorded the current values for the - ;; selection from clipboard (if we are supposed to) and primary. - ;; So return the first one that has changed - ;; (which is the first non-null one). - ;; - ;; NOTE: There will be cases where more than one of these has - ;; changed and the new values differ. This indicates that - ;; something like the following has happened since the last time - ;; we looked at the selections: Application X set all the - ;; selections, then Application Y set only one of them. - ;; In this case since we don't have - ;; timestamps there is no way to know what the 'correct' value to - ;; return is. The nice thing to do would be to tell the user we - ;; saw multiple possible selections and ask the user which was the - ;; one they wanted. - (or clip-text primary-text) - ))) - (define-obsolete-function-alias 'x-cut-buffer-or-selection-value 'x-selection-value "24.1") ;; Arrange for the kill and yank functions to set and check the clipboard. -(setq interprogram-cut-function 'x-select-text) -(setq interprogram-paste-function 'x-selection-value) - -;; Make paste from other applications use the decoding in x-select-request-type -;; and not just STRING. -(defun x-get-selection-value () - "Get the current value of the PRIMARY selection. -Request data types in the order specified by `x-select-request-type'." - (x-selection-value-internal 'PRIMARY)) (defun x-clipboard-yank () "Insert the clipboard contents, or the last stretch of killed text." + (declare (obsolete clipboard-yank "25.1")) (interactive "*") - (let ((clipboard-text (x-selection-value-internal 'CLIPBOARD)) - (x-select-enable-clipboard t)) + (let ((clipboard-text (gui--selection-value-internal 'CLIPBOARD)) + (select-enable-clipboard t)) (if (and clipboard-text (> (length clipboard-text) 0)) (kill-new clipboard-text)) (yank))) @@ -1327,9 +1187,9 @@ Request data types in the order specified by `x-select-request-type'." (defun x-win-suspend-error () "Report an error when a suspend is attempted. -This returns an error if any Emacs frames are X frames, or always under W32." +This returns an error if any Emacs frames are X frames." ;; Don't allow suspending if any of the frames are X frames. - (if (memq 'x (mapcar 'window-system (frame-list))) + (if (memq 'x (mapcar #'window-system (frame-list))) (error "Cannot suspend Emacs while running under X"))) (defvar x-initialized nil @@ -1463,9 +1323,17 @@ This returns an error if any Emacs frames are X frames, or always under W32." (setq x-initialized t)) (add-to-list 'display-format-alist '("\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" . x)) -(add-to-list 'handle-args-function-alist '(x . x-handle-args)) -(add-to-list 'frame-creation-function-alist '(x . x-create-frame-with-faces)) -(add-to-list 'window-system-initialization-alist '(x . x-initialize-window-system)) +(gui-method-define handle-args-function x #'x-handle-args) +(gui-method-define frame-creation-function x #'x-create-frame-with-faces) +(gui-method-define window-system-initialization x #'x-initialize-window-system) + +(gui-method-define gui-set-selection x + (lambda (selection value) + (if value (x-own-selection-internal selection value) + (x-disown-selection-internal selection)))) +(gui-method-define gui-selection-owner-p x #'x-selection-owner-p) +(gui-method-define gui-selection-exists-p x #'x-selection-exists-p) +(gui-method-define gui-get-selection x #'x-get-selection-internal) ;; Initiate drag and drop (add-hook 'after-make-frame-functions 'x-dnd-init-frame) @@ -1475,47 +1343,47 @@ This returns an error if any Emacs frames are X frames, or always under W32." (mapcar (lambda (arg) (cons (purecopy (car arg)) (purecopy (cdr arg)))) '( - ("etc/images/new" . "gtk-new") - ("etc/images/open" . "gtk-open") + ("etc/images/new" . ("document-new" "gtk-new")) + ("etc/images/open" . ("document-open" "gtk-open")) ("etc/images/diropen" . "n:system-file-manager") - ("etc/images/close" . "gtk-close") - ("etc/images/save" . "gtk-save") - ("etc/images/saveas" . "gtk-save-as") - ("etc/images/undo" . "gtk-undo") - ("etc/images/cut" . "gtk-cut") - ("etc/images/copy" . "gtk-copy") - ("etc/images/paste" . "gtk-paste") - ("etc/images/search" . "gtk-find") - ("etc/images/print" . "gtk-print") - ("etc/images/preferences" . "gtk-preferences") - ("etc/images/help" . "gtk-help") - ("etc/images/left-arrow" . "gtk-go-back") - ("etc/images/right-arrow" . "gtk-go-forward") - ("etc/images/home" . "gtk-home") - ("etc/images/jump-to" . "gtk-jump-to") + ("etc/images/close" . ("window-close" "gtk-close")) + ("etc/images/save" . ("document-save" "gtk-save")) + ("etc/images/saveas" . ("document-save-as" "gtk-save-as")) + ("etc/images/undo" . ("edit-undo" "gtk-undo")) + ("etc/images/cut" . ("edit-cut" "gtk-cut")) + ("etc/images/copy" . ("edit-copy" "gtk-copy")) + ("etc/images/paste" . ("edit-paste" "gtk-paste")) + ("etc/images/search" . ("edit-find" "gtk-find")) + ("etc/images/print" . ("document-print" "gtk-print")) + ("etc/images/preferences" . ("preferences-system" "gtk-preferences")) + ("etc/images/help" . ("help-browser" "gtk-help")) + ("etc/images/left-arrow" . ("go-previous" "gtk-go-back")) + ("etc/images/right-arrow" . ("go-next" "gtk-go-forward")) + ("etc/images/home" . ("go-home" "gtk-home")) + ("etc/images/jump-to" . ("go-jump" "gtk-jump-to")) ("etc/images/index" . "gtk-index") - ("etc/images/search" . "gtk-find") - ("etc/images/exit" . "gtk-quit") + ("etc/images/exit" . ("application-exit" "gtk-quit")) ("etc/images/cancel" . "gtk-cancel") - ("etc/images/info" . "gtk-info") + ("etc/images/info" . ("dialog-information" "gtk-info")) ("etc/images/bookmark_add" . "n:bookmark_add") ;; Used in Gnus and/or MH-E: ("etc/images/attach" . "gtk-attach") ("etc/images/connect" . "gtk-connect") ("etc/images/contact" . "gtk-contact") - ("etc/images/delete" . "gtk-delete") - ("etc/images/describe" . "gtk-properties") + ("etc/images/delete" . ("edit-delete" "gtk-delete")) + ("etc/images/describe" . ("ocument-properties" "gtk-properties")) ("etc/images/disconnect" . "gtk-disconnect") ;; ("etc/images/exit" . "gtk-exit") ("etc/images/lock-broken" . "gtk-lock_broken") ("etc/images/lock-ok" . "gtk-lock_ok") ("etc/images/lock" . "gtk-lock") ("etc/images/next-page" . "gtk-next-page") - ("etc/images/refresh" . "gtk-refresh") - ("etc/images/sort-ascending" . "gtk-sort-ascending") + ("etc/images/refresh" . ("view-refresh" "gtk-refresh")) + ("etc/images/sort-ascending" . ("view-sort-ascending" "gtk-sort-ascending")) ("etc/images/sort-column-ascending" . "gtk-sort-column-ascending") ("etc/images/sort-criteria" . "gtk-sort-criteria") - ("etc/images/sort-descending" . "gtk-sort-descending") + ("etc/images/sort-descending" . ("view-sort-descending" + "gtk-sort-descending")) ("etc/images/sort-row-ascending" . "gtk-sort-row-ascending") ("images/gnus/toggle-subscription" . "gtk-task-recurring") ("images/mail/compose" . "gtk-mail-compose") @@ -1532,8 +1400,8 @@ This returns an error if any Emacs frames are X frames, or always under W32." ("images/mail/spam" . "gtk-spam") ;; Used for GDB Graphical Interface ("images/gud/break" . "gtk-no") - ("images/gud/recstart" . "gtk-media-record") - ("images/gud/recstop" . "gtk-media-stop") + ("images/gud/recstart" . ("media-record" "gtk-media-record")) + ("images/gud/recstop" . ("media-playback-stop" "gtk-media-stop")) ;; No themed versions available: ;; mail/preview (combining stock_mail and stock_zoom) ;; mail/save (combining stock_mail, stock_save and stock_convert) @@ -1542,9 +1410,12 @@ This returns an error if any Emacs frames are X frames, or always under W32." Emacs must be compiled with the Gtk+ toolkit for this to have any effect. A value that begins with n: denotes a named icon instead of a stock icon." :version "22.2" - :type '(choice (repeat (choice symbol - (cons (string :tag "Emacs icon") - (string :tag "Stock/named"))))) + :type '(choice (repeat + (choice symbol + (cons (string :tag "Emacs icon") + (choice (group (string :tag "Named") + (string :tag "Stock")) + (string :tag "Stock/named")))))) :group 'x) (defcustom icon-map-list '(x-gtk-stock-map) diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index c673749fb69..519f6918565 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -43,10 +43,40 @@ The relevant features are: :type '(choice (const :tag "No" nil) (const :tag "Check" check) ;; NOTE: If you add entries here, make sure to update - ;; `tocheck-capabilities' in `terminal-init-xterm' as well. + ;; `terminal-init-xterm' as well. (set (const :tag "modifyOtherKeys support" modifyOtherKeys) (const :tag "report background" reportBackground)))) +(defconst xterm-paste-ending-sequence "\e[201~" + "Characters send by the terminal to end a bracketed paste.") + +(defun xterm-paste () + "Handle the start of a terminal paste operation." + (interactive) + (let* ((end-marker-length (length xterm-paste-ending-sequence)) + (pasted-text (with-temp-buffer + (set-buffer-multibyte nil) + (while (not (search-backward + xterm-paste-ending-sequence + (- (point) end-marker-length) t)) + (let ((event (read-event + nil nil + ;; Use finite timeout to avoid + ;; glomming the event onto + ;; this-command-keys. + most-positive-fixnum))) + (when (eql event ?\r) + (setf event ?\n)) + (insert event))) + (let ((last-coding-system-used)) + (decode-coding-region + (point-min) (point) + (keyboard-coding-system) t)))) + (interprogram-paste-function (lambda () pasted-text))) + (yank))) + +(define-key global-map [xterm-paste] #'xterm-paste) + (defvar xterm-function-map (let ((map (make-sparse-keymap))) @@ -248,6 +278,70 @@ The relevant features are: (define-key map "\eOx" [kp-8]) (define-key map "\eOy" [kp-9]) + (define-key map "\eO2j" [S-kp-multiply]) + (define-key map "\eO2k" [S-kp-add]) + (define-key map "\eO2l" [S-kp-separator]) + (define-key map "\eO2m" [S-kp-subtract]) + (define-key map "\eO2o" [S-kp-divide]) + (define-key map "\eO2p" [S-kp-0]) + (define-key map "\eO2q" [S-kp-1]) + (define-key map "\eO2r" [S-kp-2]) + (define-key map "\eO2s" [S-kp-3]) + (define-key map "\eO2t" [S-kp-4]) + (define-key map "\eO2u" [S-kp-5]) + (define-key map "\eO2v" [S-kp-6]) + (define-key map "\eO2w" [S-kp-7]) + (define-key map "\eO2x" [S-kp-8]) + (define-key map "\eO2y" [S-kp-9]) + + (define-key map "\eO4j" [M-S-kp-multiply]) + (define-key map "\eO4k" [M-S-kp-add]) + (define-key map "\eO4l" [M-S-kp-separator]) + (define-key map "\eO4m" [M-S-kp-subtract]) + (define-key map "\eO4o" [M-S-kp-divide]) + (define-key map "\eO4p" [M-S-kp-0]) + (define-key map "\eO4q" [M-S-kp-1]) + (define-key map "\eO4r" [M-S-kp-2]) + (define-key map "\eO4s" [M-S-kp-3]) + (define-key map "\eO4t" [M-S-kp-4]) + (define-key map "\eO4u" [M-S-kp-5]) + (define-key map "\eO4v" [M-S-kp-6]) + (define-key map "\eO4w" [M-S-kp-7]) + (define-key map "\eO4x" [M-S-kp-8]) + (define-key map "\eO4y" [M-S-kp-9]) + + (define-key map "\eO6j" [C-S-kp-multiply]) + (define-key map "\eO6k" [C-S-kp-add]) + (define-key map "\eO6l" [C-S-kp-separator]) + (define-key map "\eO6m" [C-S-kp-subtract]) + (define-key map "\eO6o" [C-S-kp-divide]) + (define-key map "\eO6p" [C-S-kp-0]) + (define-key map "\eO6q" [C-S-kp-1]) + (define-key map "\eO6r" [C-S-kp-2]) + (define-key map "\eO6s" [C-S-kp-3]) + (define-key map "\eO6t" [C-S-kp-4]) + (define-key map "\eO6u" [C-S-kp-5]) + (define-key map "\eO6v" [C-S-kp-6]) + (define-key map "\eO6w" [C-S-kp-7]) + (define-key map "\eO6x" [C-S-kp-8]) + (define-key map "\eO6y" [C-S-kp-9]) + + (define-key map "\eO8j" [C-M-S-kp-multiply]) + (define-key map "\eO8k" [C-M-S-kp-add]) + (define-key map "\eO8l" [C-M-S-kp-separator]) + (define-key map "\eO8m" [C-M-S-kp-subtract]) + (define-key map "\eO8o" [C-M-S-kp-divide]) + (define-key map "\eO8p" [C-M-S-kp-0]) + (define-key map "\eO8q" [C-M-S-kp-1]) + (define-key map "\eO8r" [C-M-S-kp-2]) + (define-key map "\eO8s" [C-M-S-kp-3]) + (define-key map "\eO8t" [C-M-S-kp-4]) + (define-key map "\eO8u" [C-M-S-kp-5]) + (define-key map "\eO8v" [C-M-S-kp-6]) + (define-key map "\eO8w" [C-M-S-kp-7]) + (define-key map "\eO8x" [C-M-S-kp-8]) + (define-key map "\eO8y" [C-M-S-kp-9]) + ;; These keys are available in xterm starting from version 216 ;; if the modifyOtherKeys resource is set to 1. (dolist (bind '((5 9 [C-tab]) @@ -394,6 +488,11 @@ The relevant features are: (define-key map "\e[12~" [f2]) (define-key map "\e[13~" [f3]) (define-key map "\e[14~" [f4]) + + ;; Recognize the start of a bracketed paste sequence. The handler + ;; internally recognizes the end. + (define-key map "\e[200~" [xterm-paste]) + map) "Function key map overrides for xterm.") @@ -463,9 +562,6 @@ The relevant features are: map) "Keymap of possible alternative meanings for some keys.") -;; List of terminals for which modify-other-keys has been turned on. -(defvar xterm-modify-other-keys-terminal-list nil) - (defun xterm--report-background-handler () (let ((str "") chr) @@ -605,21 +701,23 @@ We run the first FUNCTION whose STRING matches the input events." (when (memq 'modifyOtherKeys xterm-extra-capabilities) (terminal-init-xterm-modify-other-keys))) + ;; Unconditionally enable bracketed paste mode: terminals that don't + ;; support it just ignore the sequence. + (terminal-init-xterm-bracketed-paste-mode) + (run-hooks 'terminal-init-xterm-hook)) (defun terminal-init-xterm-modify-other-keys () "Terminal initialization for xterm's modifyOtherKeys support." - ;; Make sure that the modifyOtherKeys state is restored when - ;; suspending, resuming and exiting. - (add-hook 'suspend-hook 'xterm-turn-off-modify-other-keys) - (add-hook 'suspend-resume-hook 'xterm-turn-on-modify-other-keys) - (add-hook 'kill-emacs-hook 'xterm-remove-modify-other-keys) - (add-hook 'delete-terminal-functions 'xterm-remove-modify-other-keys) - ;; Add the selected frame to the list of frames that - ;; need to deal with modify-other-keys. - (push (frame-terminal) - xterm-modify-other-keys-terminal-list) - (xterm-turn-on-modify-other-keys)) + (send-string-to-terminal "\e[>4;1m") + (push "\e[>4m" (terminal-parameter nil 'tty-mode-reset-strings)) + (push "\e[>4;1m" (terminal-parameter nil 'tty-mode-set-strings))) + +(defun terminal-init-xterm-bracketed-paste-mode () + "Terminal initialization for bracketed paste mode." + (send-string-to-terminal "\e[?2004h") + (push "\e[?2004l" (terminal-parameter nil 'tty-mode-reset-strings)) + (push "\e[?2004h" (terminal-parameter nil 'tty-mode-set-strings))) ;; Set up colors, for those versions of xterm that support it. (defvar xterm-standard-colors @@ -737,29 +835,6 @@ versions of xterm." ;; right colors, so clear them. (clear-face-cache))) -(defun xterm-turn-on-modify-other-keys () - "Turn the modifyOtherKeys feature of xterm back on." - (let ((terminal (frame-terminal))) - (when (and (terminal-live-p terminal) - (memq terminal xterm-modify-other-keys-terminal-list)) - (send-string-to-terminal "\e[>4;1m" terminal)))) - -(defun xterm-turn-off-modify-other-keys (&optional frame) - "Temporarily turn off the modifyOtherKeys feature of xterm." - (let ((terminal (when frame (frame-terminal frame)))) - (when (and (terminal-live-p terminal) - (memq terminal xterm-modify-other-keys-terminal-list)) - (send-string-to-terminal "\e[>4m" terminal)))) - -(defun xterm-remove-modify-other-keys (&optional terminal) - "Turn off the modifyOtherKeys feature of xterm for good." - (setq terminal (or terminal (frame-terminal))) - (when (and (terminal-live-p terminal) - (memq terminal xterm-modify-other-keys-terminal-list)) - (setq xterm-modify-other-keys-terminal-list - (delq terminal xterm-modify-other-keys-terminal-list)) - (send-string-to-terminal "\e[>4m" terminal))) - (defun xterm-maybe-set-dark-background-mode (redc greenc bluec) ;; Use the heuristic in `frame-set-background-mode' to decide if a ;; frame is dark. diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index abb98516441..5933559b37c 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -4840,7 +4840,7 @@ If optional arg MOVE is non-nil move point to end of field." If optional prefix JUSTIFY is non-nil justify as well. In BibTeX mode this function is bound to `fill-paragraph-function'." (interactive "*P") - (let ((pnt (copy-marker (point))) + (let ((pnt (point-marker)) (bounds (bibtex-enclosing-field t))) (bibtex-fill-field-bounds bounds justify) (goto-char pnt))) @@ -4852,7 +4852,7 @@ names appear in column `bibtex-field-indentation', field text starts in column `bibtex-text-indentation' and continuation lines start here, too. If `bibtex-align-at-equal-sign' is non-nil, align equal signs, too." (interactive "*") - (let ((pnt (copy-marker (point))) + (let ((pnt (point-marker)) (beg (bibtex-beginning-of-entry)) ; move point bounds) (bibtex-delete-whitespace) diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el index aae03d32ee5..b6bea218626 100644 --- a/lisp/textmodes/conf-mode.el +++ b/lisp/textmodes/conf-mode.el @@ -311,8 +311,7 @@ unbalanced, but hey...)" (when (or (not arg) (= (prefix-numeric-value arg) 2)) (modify-syntax-entry ?\" "." table)) (set-syntax-table table) - (when font-lock-mode - (font-lock-fontify-buffer)))) + (font-lock-flush))) (defun conf-outline-level () diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index c04c6a36e6a..c171bd50f62 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -185,7 +185,7 @@ (let ((st (make-syntax-table))) ;; C-style comments. (modify-syntax-entry ?/ ". 14" st) - (modify-syntax-entry ?* ". 23" st) + (modify-syntax-entry ?* ". 23b" st) ;; Strings. (modify-syntax-entry ?\" "\"" st) (modify-syntax-entry ?\' "\"" st) @@ -210,11 +210,15 @@ "\\\\\\(?:[^\000-\037\177]\\|[0-9a-fA-F]+[ \n\t\r\f]?\\)") (defconst css-nmchar-re (concat "\\(?:[-[:alnum:]]\\|" css-escapes-re "\\)")) (defconst css-nmstart-re (concat "\\(?:[[:alpha:]]\\|" css-escapes-re "\\)")) -(defconst css-ident-re (concat css-nmstart-re css-nmchar-re "*")) +(defconst css-ident-re ;; (concat css-nmstart-re css-nmchar-re "*") + ;; Apparently, "at rules" names can start with a dash, e.g. @-moz-keyframes. + (concat css-nmchar-re "+")) (defconst css-proprietary-nmstart-re ;; Vendor-specific properties. (concat "[-_]" (regexp-opt '("ms" "moz" "o" "khtml" "webkit")) "-")) (defconst css-name-re (concat css-nmchar-re "+")) +(defconst scss--hash-re "#\\(?:{[$-_[:alnum:]]+}\\|[[:alnum:]]+\\)") + (defface css-selector '((t :inherit font-lock-function-name-face)) "Face to use for selectors." :group 'css) @@ -224,24 +228,44 @@ (defface css-proprietary-property '((t :inherit (css-property italic))) "Face to use for vendor-specific properties.") -(defvar css-font-lock-keywords - `(("!\\s-*important" . font-lock-builtin-face) +(defun css--font-lock-keywords (&optional sassy) + `((,(concat "!\\s-*" + (regexp-opt (append (if sassy '("global")) + '("important")))) + (0 font-lock-builtin-face)) ;; Atrules keywords. IDs not in css-at-ids are valid (ignored). ;; In fact the regexp should probably be ;; (,(concat "\\(@" css-ident-re "\\)\\([ \t\n][^;{]*\\)[;{]") ;; (1 font-lock-builtin-face)) ;; Since "An at-rule consists of everything up to and including the next ;; semicolon (;) or the next block, whichever comes first." - (,(concat "@" css-ident-re) . font-lock-builtin-face) + (,(concat "@" css-ident-re) (0 font-lock-builtin-face)) ;; Selectors. ;; FIXME: attribute selectors don't work well because they may contain ;; strings which have already been highlighted as f-l-string-face and ;; thus prevent this highlighting from being applied (actually now that - ;; I use `append' this should work better). But really the part of the + ;; I use `keep' this should work better). But really the part of the ;; selector between [...] should simply not be highlighted. - (,(concat "^\\([ \t]*[^@:{}\n][^:{}]+\\(?::" (regexp-opt css-pseudo-ids t) - "\\(?:([^)]+)\\)?[^:{\n]*\\)*\\)\\(?:\n[ \t]*\\)*{") - (1 'css-selector append)) + (,(concat + "^[ \t]*\\(" + (if (not sassy) + ;; We don't allow / as first char, so as not to + ;; take a comment as the beginning of a selector. + "[^@/:{} \t\n][^:{}]+" + ;; Same as for non-sassy except we do want to allow { and } + ;; chars in selectors in the case of #{$foo} + ;; variable interpolation! + (concat "\\(?:" scss--hash-re + "\\|[^@/:{} \t\n#]\\)" + "[^:{}#]*\\(?:" scss--hash-re "[^:{}#]*\\)*")) + "\\(?::" (regexp-opt css-pseudo-ids t) + "\\(?:([^\)]+)\\)?" + (if (not sassy) + "[^:{}\n]*" + (concat "[^:{}\n#]*\\(?:" scss--hash-re "[^:{}\n#]*\\)*")) + "\\)*" + "\\)\\(?:\n[ \t]*\\)*{") + (1 'css-selector keep)) ;; In the above rule, we allow the open-brace to be on some subsequent ;; line. This will only work if we properly mark the intervening text ;; as being part of a multiline element (and even then, this only @@ -260,6 +284,8 @@ "\\)\\s-*:") (1 (if (match-end 2) 'css-proprietary-property 'css-property))))) +(defvar css-font-lock-keywords (css--font-lock-keywords)) + (defvar css-font-lock-defaults '(css-font-lock-keywords nil t)) @@ -277,6 +303,7 @@ (defun css-smie--forward-token () (cond ((and (eq (char-before) ?\}) + (scss-smie--not-interpolation-p) ;; FIXME: If the next char is not whitespace, what should we do? (or (memq (char-after) '(?\s ?\t ?\n)) (looking-at comment-start-skip))) @@ -293,7 +320,8 @@ (forward-comment (- (point))) (cond ;; FIXME: If the next char is not whitespace, what should we do? - ((and (eq (char-before) ?\}) (> pos (point))) ";") + ((and (eq (char-before) ?\}) (scss-smie--not-interpolation-p) + (> pos (point))) ";") ((memq (char-before) '(?\; ?\, ?\:)) (forward-char -1) (string (char-after))) (t (smie-default-backward-token))))) @@ -315,7 +343,6 @@ (setq-local comment-end "*/") (setq-local comment-end-skip "[ \t]*\\*+/") (setq-local parse-sexp-ignore-comments t) - (setq-local indent-line-function 'css-indent-line) (setq-local fill-paragraph-function 'css-fill-paragraph) (setq-local add-log-current-defun-function #'css-current-defun-name) (smie-setup css-smie-grammar #'css-smie-rules @@ -406,5 +433,35 @@ (if (looking-at "^[ \t]*\\([^{\r\n]*[^ {\t\r\n]\\)") (match-string-no-properties 1)))))) +;;; SCSS mode + +(defvar scss-mode-syntax-table + (let ((st (make-syntax-table css-mode-syntax-table))) + (modify-syntax-entry ?/ ". 124" st) + (modify-syntax-entry ?\n ">" st) + st)) + +(defvar scss-font-lock-keywords + (append `((,(concat "$" css-ident-re) (0 font-lock-variable-name-face))) + (css--font-lock-keywords 'sassy) + `((,(concat "@mixin[ \t]+\\(" css-ident-re "\\)[ \t]*(") + (1 font-lock-function-name-face))))) + +(defun scss-smie--not-interpolation-p () + (save-excursion + (forward-char -1) + (or (zerop (skip-chars-backward "[:alnum:]")) + (not (looking-back "#{\\$" (- (point) 3)))))) + +;;;###autoload (add-to-list 'auto-mode-alist '("\\.scss\\'" . scss-mode)) +;;;###autoload +(define-derived-mode scss-mode css-mode "SCSS" + "Major mode to edit \"Sassy CSS\" files." + (setq-local comment-start "// ") + (setq-local comment-end "") + (setq-local comment-start-skip "/[*/]+[ \t]*") + (setq-local comment-end-skip "[ \t]*\\(?:\n\\|\\*+/\\)") + (setq-local font-lock-defaults '(scss-font-lock-keywords nil t))) + (provide 'css-mode) ;;; css-mode.el ends here diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index b9d45b3a32f..040a50e3099 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -314,7 +314,8 @@ the region, and the START and END of each region." ;;;###autoload (defun enriched-encode (from to orig-buf) (if enriched-verbose (message "Enriched: encoding document...")) - (let ((inhibit-read-only t)) + (let ((inhibit-read-only t) + (inhibit-point-motion-hooks t)) (save-restriction (narrow-to-region from to) (delete-to-left-margin) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 81d8078df40..82a09a0f89a 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -931,16 +931,14 @@ Otherwise returns the library directory name, if that is defined." (defun ispell-call-process (&rest args) "Like `call-process' but defend against bad `default-directory'." (let ((default-directory default-directory)) - (unless (and (file-directory-p default-directory) - (file-readable-p default-directory)) + (unless (file-accessible-directory-p default-directory) (setq default-directory (expand-file-name "~/"))) (apply 'call-process args))) (defun ispell-call-process-region (&rest args) "Like `call-process-region' but defend against bad `default-directory'." (let ((default-directory default-directory)) - (unless (and (file-directory-p default-directory) - (file-readable-p default-directory)) + (unless (file-accessible-directory-p default-directory) (setq default-directory (expand-file-name "~/"))) (apply 'call-process-region args))) @@ -2211,16 +2209,12 @@ indicates whether the dictionary has been modified when option `a' or `i' is used. Global `ispell-quit' set to start location to continue spell session." (let ((count ?0) - (line ispell-choices-win-default-height) - ;; ensure 4 context lines. - (max-lines (- (ispell-adjusted-window-height) 4)) (choices miss) (window-min-height (min window-min-height ispell-choices-win-default-height)) (command-characters '( ? ?i ?a ?A ?r ?R ?? ?x ?X ?q ?l ?u ?m )) - (dedicated (window-dedicated-p)) (skipped 0) - char num result textwin dedicated-win) + char num result textwin) ;; setup the *Choices* buffer with valid data. (with-current-buffer (get-buffer-create ispell-choices-buffer) @@ -2235,30 +2229,27 @@ Global `ispell-quit' set to start location to continue spell session." (boundp 'horizontal-scrollbar-visible-p) (set-specifier horizontal-scrollbar-visible-p nil (cons (current-buffer) nil)))) + (ispell-with-no-warnings + (and (boundp 'horizontal-scroll-bar) + (setq horizontal-scroll-bar nil))) (erase-buffer) (if guess (progn (insert "Affix rules generate and capitalize " "this word as shown below:\n\t") (while guess - (if (> (+ 4 (current-column) (length (car guess))) - (window-width)) - (progn - (insert "\n\t") - (setq line (1+ line)))) + (when (> (+ 4 (current-column) (length (car guess))) + (window-width)) + (insert "\n\t")) (insert (car guess) " ") (setq guess (cdr guess))) - (insert "\nUse option `i' to accept this spelling and put it in your private dictionary.\n") - (setq line (+ line (if choices 3 2))))) - (while (and choices - (< (if (> (+ 7 (current-column) (length (car choices)) - (if (> count ?~) 3 0)) - (window-width)) - (progn - (insert "\n") - (setq line (1+ line))) - line) - max-lines)) + (insert "\nUse option `i' to accept this spelling and put it in your private dictionary.\n"))) + (while choices + (when (> (+ 7 (current-column) + (length (car choices)) + (if (> count ?~) 3 0)) + (window-width)) + (insert "\n")) ;; not so good if there are over 20 or 30 options, but then, if ;; there are that many you don't want to scan them all anyway... (while (memq count command-characters) ; skip command characters. @@ -2273,15 +2264,10 @@ Global `ispell-quit' set to start location to continue spell session." (if (not (pos-visible-in-window-p end)) (sit-for 0)) - ;; allow temporary split of dedicated windows... - (if dedicated - (progn - (setq dedicated-win (selected-window)) - (set-window-dedicated-p dedicated-win nil))) - ;; Display choices for misspelled word. - (ispell-show-choices line end) - (select-window (setq textwin (next-window))) + (setq textwin (selected-window)) + (ispell-show-choices) + (select-window textwin) ;; highlight word, protecting current buffer status (unwind-protect @@ -2408,18 +2394,13 @@ Global `ispell-quit' set to start location to continue spell session." (or ispell-complete-word-dict ispell-alternate-dictionary)) miss (ispell-lookup-words new-word) - choices miss - line ispell-choices-win-default-height) - (while (and choices ; adjust choices window. - (< (if (> (+ 7 (current-column) - (length (car choices)) - (if (> count ?~) 3 0)) - (window-width)) - (progn - (insert "\n") - (setq line (1+ line))) - line) - max-lines)) + choices miss) + (while choices + (when (> (+ 7 (current-column) + (length (car choices)) + (if (> count ?~) 3 0)) + (window-width)) + (insert "\n")) (while (memq count command-characters) (setq count (ispell-int-char (1+ count)) skipped (1+ skipped))) @@ -2428,8 +2409,9 @@ Global `ispell-quit' set to start location to continue spell session." count (ispell-int-char (1+ count)))) (setq count (ispell-int-char (- count ?0 skipped)))) - (ispell-show-choices line end) - (select-window (next-window))))) + (setq textwin (selected-window)) + (ispell-show-choices) + (select-window textwin)))) (and (eq 'block ispell-highlight-p) (ispell-highlight-spelling-error start end nil 'block)) @@ -2489,44 +2471,19 @@ Global `ispell-quit' set to start location to continue spell session." (and ispell-highlight-p ; unhighlight (save-window-excursion (select-window textwin) - (ispell-highlight-spelling-error start end))) - (if dedicated - (set-window-dedicated-p dedicated-win t))))) + (ispell-highlight-spelling-error start end)))))) -(defun ispell-show-choices (line end) +(defun ispell-show-choices () "Show the choices in another buffer or frame." (if (and ispell-use-framepop-p (fboundp 'framepop-display-buffer)) (progn (framepop-display-buffer (get-buffer ispell-choices-buffer)) ;; (get-buffer-window ispell-choices-buffer t) (select-window (previous-window))) ; *Choices* window - ;; standard selection by splitting a small buffer out of this window. - (let ((choices-window (get-buffer-window ispell-choices-buffer))) - (if choices-window - (if (= line (ispell-adjusted-window-height choices-window)) - (select-window choices-window) - ;; *Choices* window changed size. Adjust the choices window - ;; without scrolling the spelled window when possible - (let ((window-line - (- line (ispell-adjusted-window-height choices-window))) - (visible (progn (vertical-motion -1) (point)))) - (if (< line ispell-choices-win-default-height) - (setq window-line (+ window-line - (- ispell-choices-win-default-height - line)))) - (move-to-window-line 0) - (vertical-motion window-line) - (set-window-start (selected-window) - (if (> (point) visible) visible (point))) - (goto-char end) - (select-window choices-window) - (enlarge-window window-line))) - ;; Overlay *Choices* window when it isn't showing - (ispell-overlay-window (max line ispell-choices-win-default-height))) - (switch-to-buffer ispell-choices-buffer) - (goto-char (point-min))))) + ;; Display choices above selected window. + (ispell-display-buffer (get-buffer-create ispell-choices-buffer)))) ;;;###autoload @@ -2596,10 +2553,10 @@ SPC: Accept word this time. "Type 'x C-h f ispell-help' for more help"))) (save-window-excursion (if ispell-help-in-bufferp - (progn - (ispell-overlay-window 4) - (switch-to-buffer (get-buffer-create "*Ispell Help*")) - (insert (concat help-1 "\n" help-2 "\n" help-3)) + (let ((buffer (get-buffer-create "*Ispell Help*"))) + (with-current-buffer buffer + (insert (concat help-1 "\n" help-2 "\n" help-3))) + (ispell-display-buffer buffer) (sit-for 5) (kill-buffer "*Ispell Help*")) (unwind-protect @@ -2818,49 +2775,35 @@ The variable `ispell-highlight-face' selects the face to use for highlighting." (ispell-highlight-spelling-error-overlay start end highlight)) (t (ispell-highlight-spelling-error-generic start end highlight refresh)))) -(defun ispell-adjusted-window-height (&optional window) - "Like `window-height', adjusted to correct for the effect of tall mode-lines. -The value returned is actually the nominal number of text-lines in the -window plus 1. On a terminal, this is the same value returned by -`window-height', but if the window has a mode-line is taller than a normal -text line, the returned value may be smaller than that from -`window-height'." - (cond ((fboundp 'window-text-height) - (1+ (window-text-height window))) - ((or (and (fboundp 'display-graphic-p) (display-graphic-p)) - (and (featurep 'xemacs) window-system)) - (1- (window-height window))) - (t - (window-height window)))) - -(defun ispell-overlay-window (height) - "Create a window covering the top HEIGHT lines of the current window. -Ensure that the line above point is still visible but otherwise avoid -scrolling the current window. Leave the new window selected." - (save-excursion - (let ((oldot (save-excursion (vertical-motion -1) (point))) - (top (save-excursion (move-to-window-line height) (point)))) - ;; If line above old point (line starting at oldot) would be - ;; hidden by new window, scroll it to just below new win - ;; otherwise set top line of other win so it doesn't scroll. - (if (< oldot top) (setq top oldot)) - ;; if frame is unsplittable, temporarily disable that... - (if (cdr (assq 'unsplittable (frame-parameters (selected-frame)))) - (let ((frame (selected-frame))) - (modify-frame-parameters frame '((unsplittable . nil))) - (split-window nil height) - (modify-frame-parameters frame '((unsplittable . t)))) - (split-window nil height)) - (let ((deficit (- height (ispell-adjusted-window-height)))) - (when (> deficit 0) - ;; Number of lines the window is still too short. We ensure that - ;; there are at least (1- HEIGHT) lines visible in the window. - (enlarge-window deficit) - (goto-char top) - (vertical-motion deficit) - (setq top (min (point) oldot)))) - (set-window-start (next-window) top)))) - +(defun ispell-display-buffer (buffer) + "Show BUFFER in new window above selected one. +Also position fit window to BUFFER and select it." + (let* ((unsplittable + (cdr (assq 'unsplittable (frame-parameters (selected-frame))))) + (window + (or (get-buffer-window buffer) + (and unsplittable + ;; If frame is unsplittable, temporarily disable that... + (let ((frame (selected-frame))) + (modify-frame-parameters frame '((unsplittable . nil))) + (prog1 + (condition-case nil + (split-window + nil (- ispell-choices-win-default-height) 'above) + (error nil)) + (modify-frame-parameters frame '((unsplittable . t)))))) + (and (not unsplittable) + (condition-case nil + (split-window + nil (- ispell-choices-win-default-height) 'above) + (error nil))) + (display-buffer buffer)))) + (if (not window) + (error "Couldn't make window for *Choices*") + (select-window window) + (set-window-buffer window buffer) + (set-window-point window (point-min)) + (fit-window-to-buffer window nil nil nil nil t)))) ;; Should we add a compound word match return value? (defun ispell-parse-output (output &optional accept-list shift) @@ -2939,8 +2882,7 @@ Keeps argument list for future Ispell invocations for no async support." (ispell-hunspell-fill-dictionary-entry ispell-current-dictionary))) (let* ((default-directory - (if (and (file-directory-p default-directory) - (file-readable-p default-directory)) + (if (file-accessible-directory-p default-directory) default-directory ;; Defend against bad `default-directory'. (expand-file-name "~/"))) @@ -2998,8 +2940,7 @@ Keeps argument list for future Ispell invocations for no async support." (if (or ispell-really-aspell ispell-really-hunspell ;; Protect against bad default-directory - (not (and (file-directory-p default-directory) - (file-readable-p default-directory))) + (not (file-accessible-directory-p default-directory)) ;; Ispell and per-dir personal dicts available (not (or (file-readable-p (concat default-directory ".ispell_words")) diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el index b18a93cd3e6..8bcc71ed531 100644 --- a/lisp/textmodes/paragraphs.el +++ b/lisp/textmodes/paragraphs.el @@ -168,11 +168,11 @@ to obtain the value of this variable." :type '(choice regexp (const :tag "Use default value" nil))) (put 'sentence-end 'safe-local-variable 'string-or-null-p) -(defcustom sentence-end-base "[.?!][]\"'”)}]*" +(defcustom sentence-end-base "[.?!…‽][]\"'”’)}]*" "Regexp matching the basic end of a sentence, not including following space." :group 'paragraphs :type 'string - :version "22.1") + :version "25.1") (put 'sentence-end-base 'safe-local-variable 'stringp) (defun sentence-end () diff --git a/lisp/textmodes/reftex-auc.el b/lisp/textmodes/reftex-auc.el index 08b38cfa1a7..bbad065c4ba 100644 --- a/lisp/textmodes/reftex-auc.el +++ b/lisp/textmodes/reftex-auc.el @@ -47,6 +47,7 @@ (and (listp reftex-plug-into-AUCTeX) (nth which reftex-plug-into-AUCTeX)))) +;;;###autoload (defun reftex-arg-label (optional &optional prompt definition) "Use `reftex-label', `reftex-reference' or AUCTeX's code to insert label arg. What is being used depends upon `reftex-plug-into-AUCTeX'." @@ -68,6 +69,7 @@ What is being used depends upon `reftex-plug-into-AUCTeX'." (LaTeX-add-labels label)) (TeX-argument-insert label optional))) +;;;###autoload (defun reftex-arg-cite (optional &optional prompt definition) "Use `reftex-citation' or AUCTeX's code to insert a cite-key macro argument. What is being used depends upon `reftex-plug-into-AUCTeX'." @@ -85,6 +87,7 @@ What is being used depends upon `reftex-plug-into-AUCTeX'." optional))) +;;;###autoload (defun reftex-arg-index-tag (optional &optional prompt &rest args) "Prompt for an index tag with completion. This is the name of an index, not the entry." @@ -104,6 +107,7 @@ This is the name of an index, not the entry." (setq tag (read-string prompt))) (TeX-argument-insert tag optional))) +;;;###autoload (defun reftex-arg-index (optional &optional prompt &rest args) "Prompt for an index entry completing with known entries. Completion is specific for just one index, if the macro or a tag @@ -138,6 +142,7 @@ argument identify one of multiple indices." (t "idx"))))) (defvar LaTeX-label-function) +;;;###autoload (defun reftex-plug-into-AUCTeX () ;; Replace AUCTeX functions with RefTeX functions. ;; Which functions are replaced is controlled by the variable @@ -162,6 +167,7 @@ argument identify one of multiple indices." (fboundp 'TeX-arg-index) (fset 'TeX-arg-index 'reftex-arg-index))) +;;;###autoload (defun reftex-toggle-plug-into-AUCTeX () "Toggle Interface between AUCTeX and RefTeX on and off." (interactive) @@ -173,6 +179,7 @@ argument identify one of multiple indices." (message "RefTeX has been plugged into AUCTeX.") (message "RefTeX no longer interacts with AUCTeX."))) +;;;###autoload (defun reftex-add-label-environments (entry-list) "Add label environment descriptions to `reftex-label-alist-style'. The format of ENTRY-LIST is exactly like `reftex-label-alist'. See there @@ -197,8 +204,10 @@ the label information is recompiled on next use." (push entry list))) (when changed (put reftex-docstruct-symbol 'reftex-label-alist-style list))))) +;;;###autoload (defalias 'reftex-add-to-label-alist 'reftex-add-label-environments) +;;;###autoload (defun reftex-add-section-levels (entry-list) "Add entries to the value of `reftex-section-levels'. The added values are kept local to the current document. The format @@ -219,9 +228,14 @@ of ENTRY-LIST is a list of cons cells (\"MACRONAME\" . LEVEL). See (when changed (put reftex-docstruct-symbol 'reftex-section-levels list))))) +;;;###autoload (defun reftex-notice-new-section () (reftex-notice-new 1 'force)) (provide 'reftex-auc) ;;; reftex-auc.el ends here + +;; Local Variables: +;; generated-autoload-file: "reftex.el" +;; End: diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index 328064271f8..fa09efb64a4 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -58,6 +58,7 @@ ,@body) (set-syntax-table saved-syntax)))) +;;;###autoload (defun reftex-default-bibliography () "Return the expanded value of variable `reftex-default-bibliography'. The expanded value is cached." @@ -70,6 +71,7 @@ The expanded value is cached." reftex-default-bibliography)) (get 'reftex-default-bibliography :reftex-expanded)) +;;;###autoload (defun reftex-bib-or-thebib () "Test if BibTeX or \begin{thebibliography} should be used for the citation. Find the bof of the current file" @@ -89,6 +91,7 @@ Find the bof of the current file" (if bib 'bib nil) (if thebib 'thebib nil)))) +;;;###autoload (defun reftex-get-bibfile-list () "Return list of bibfiles for current document. When using the chapterbib or bibunits package you should either @@ -112,6 +115,7 @@ Then this function will return the applicable database files." (error "\\bibliography statement missing or .bib files not found"))) ;;; Find a certain reference in any of the BibTeX files. +;;;###autoload (defun reftex-pop-to-bibtex-entry (key file-list &optional mark-to-kill highlight item return) "Find BibTeX KEY in any file in FILE-LIST in another window. @@ -161,6 +165,7 @@ If RETURN is non-nil, just return the entry and restore point." (error "No \\bibitem with citation key %s" key) (error "No BibTeX entry with citation key %s" key))))) +;;;###autoload (defun reftex-end-of-bib-entry (item) (save-excursion (condition-case nil @@ -452,6 +457,7 @@ If FIELD is empty try \"editor\" field." (setq names (replace-match " " nil t names))) (split-string names "\n"))) +;;;###autoload (defun reftex-parse-bibtex-entry (entry &optional from to raw) "Parse BibTeX ENTRY. If ENTRY is nil then parse the entry in current buffer between FROM and TO. @@ -604,6 +610,7 @@ If FORMAT is non-nil `format' entry accordingly." ;;; Make a citation +;; NB this is a global autoload - see reftex.el. ;;;###autoload (defun reftex-citation (&optional no-insert format-key) "Make a citation using BibTeX database files. @@ -787,11 +794,13 @@ in order to only add another reference in the same cite command." (error "No citation format associated with key `%c'" key))))) format)) +;;;###autoload (defun reftex-citep () "Call `reftex-citation' with a format selector `?p'." (interactive) (reftex-citation nil ?p)) +;;;###autoload (defun reftex-citet () "Call `reftex-citation' with a format selector `?t'." (interactive) @@ -1058,6 +1067,7 @@ in order to only add another reference in the same cite command." (setq format (replace-match "" t t format))) format) +;;;###autoload (defun reftex-make-cite-echo-string (entry docstruct-symbol) "Format a bibtex ENTRY for the echo area and cache the result." (let* ((key (reftex-get-bib-field "&key" entry)) @@ -1151,6 +1161,7 @@ recommended for follow mode. It works OK for individual lookups." (string-match "^&" (car pair))) alist)))) +;;;###autoload (defun reftex-create-bibtex-file (bibfile) "Create a new BibTeX database BIBFILE with all entries referenced in document. The command prompts for a filename and writes the collected @@ -1244,3 +1255,7 @@ created files in the variables `reftex-create-bibtex-header' or (provide 'reftex-cite) ;;; reftex-cite.el ends here + +;; Local Variables: +;; generated-autoload-file: "reftex.el" +;; End: diff --git a/lisp/textmodes/reftex-dcr.el b/lisp/textmodes/reftex-dcr.el index 2957692dc5c..60cb1f65257 100644 --- a/lisp/textmodes/reftex-dcr.el +++ b/lisp/textmodes/reftex-dcr.el @@ -30,6 +30,7 @@ (require 'reftex) +;;;###autoload (defun reftex-view-crossref (&optional arg auto-how fail-quietly) "View cross reference of macro at point. Point must be on the KEY argument. When at a `\\ref' macro, show corresponding `\\label' @@ -220,6 +221,7 @@ to the functions `reftex-view-cr-cite' and `reftex-view-cr-ref'." (when (equal arg 2) (select-window pop-win))))) +;;;###autoload (defun reftex-mouse-view-crossref (ev) "View cross reference of \\ref or \\cite macro where you click. If the macro at point is a \\ref, show the corresponding label definition. @@ -318,6 +320,7 @@ With argument, actually select the window showing the cross reference." "Non-nil means use the idle timers in XEmacs for crossref display. Currently, idle timer restart is broken and we use the post-command-hook.") +;;;###autoload (defun reftex-toggle-auto-view-crossref () "Toggle the automatic display of crossref information in the echo area. When active, leaving point idle in the argument of a \\ref or \\cite macro @@ -355,6 +358,7 @@ will display info in the echo area." 'reftex-view-crossref-when-idle reftex-idle-time nil t)))) +;;;###autoload (defun reftex-view-crossref-from-bibtex (&optional arg) "View location in a LaTeX document which cites the BibTeX entry at point. Since BibTeX files can be used by many LaTeX documents, this function @@ -482,3 +486,7 @@ Calling this function several times find successive citation locations." (provide 'reftex-dcr) ;;; reftex-dcr.el ends here + +;; Local Variables: +;; generated-autoload-file: "reftex.el" +;; End: diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el index 03bf009bb12..15d42fe7b02 100644 --- a/lisp/textmodes/reftex-global.el +++ b/lisp/textmodes/reftex-global.el @@ -29,6 +29,7 @@ (require 'reftex) ;;; +;;;###autoload (defun reftex-create-tags-file () "Create TAGS file by running `etags' on the current document. The TAGS file is also immediately visited with `visit-tags-table'." @@ -48,6 +49,7 @@ The TAGS file is also immediately visited with `visit-tags-table'." (defvar reftex-grep-command "grep -n " "Last grep command used in \\[reftex-grep-document]; default for next grep.") +;;;###autoload (defun reftex-grep-document (grep-cmd) "Run grep query through all files related to this document. With prefix arg, force to rescan document. @@ -64,6 +66,7 @@ No active TAGS table is required." (mapconcat 'identity files " ")))) (grep cmd))) +;;;###autoload (defun reftex-search-document (&optional regexp) "Regexp search through all files of the current document. Starts always in the master file. Stops when a match is found. @@ -79,6 +82,7 @@ No active TAGS table is required." (reftex-access-scan-info current-prefix-arg) (tags-search regexp (list 'reftex-all-document-files)))) +;;;###autoload (defun reftex-query-replace-document (&optional from to delimited) "Do `query-replace-regexp' of FROM with TO over the entire document. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. @@ -100,6 +104,7 @@ No active TAGS table is required." (defvar TeX-master) (defvar isearch-next-buffer-function) +;;;###autoload (defun reftex-find-duplicate-labels () "Produce a list of all duplicate labels in the document." @@ -158,6 +163,7 @@ No active TAGS table is required." (delete-window) (message "Document does not contain duplicate labels.")))) +;;;###autoload (defun reftex-change-label (&optional from to) "Run `query-replace-regexp' of FROM with TO in all macro arguments. Works on the entire multifile document. @@ -177,6 +183,7 @@ No active TAGS table is required." (concat "{" (regexp-quote from) "}") (format "{%s}" to)))) +;;;###autoload (defun reftex-renumber-simple-labels () "Renumber all simple labels in the document to make them sequentially. Simple labels are the ones created by RefTeX, consisting only of the @@ -304,6 +311,7 @@ one with the `xr' package." (t nil)))))))) n)) +;;;###autoload (defun reftex-save-all-document-buffers () "Save all documents associated with the current document. The function is useful after a global action like replacing or renumbering @@ -414,6 +422,7 @@ Also checks if buffers visiting the files are in read-only mode." (when flist (find-file-noselect (car flist)))))) +;; NB this is a global autoload - see reftex.el. ;;;###autoload (defun reftex-isearch-minor-mode (&optional arg) "When on, isearch searches the whole document, not only the current file. @@ -466,3 +475,7 @@ With no argument, this command toggles 'reftex-isearch-minor-mode) ;;; reftex-global.el ends here + +;; Local Variables: +;; generated-autoload-file: "reftex.el" +;; End: diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index b5a3e05867e..b1aff428278 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -35,6 +35,7 @@ (defvar TeX-master) ;; END remove for XEmacs release +;;;###autoload (defun reftex-index-selection-or-word (&optional arg phrase) "Put selection or the word near point into the default index macro. This uses the information in `reftex-index-default-macro' to make an index @@ -87,6 +88,7 @@ which is part of AUCTeX, the string is first processed with the (delete-region beg end) (reftex-index def-char full-entry def-tag sel))))) +;;;###autoload (defun reftex-index (&optional char key tag sel no-insert) "Query for an index macro and insert it along with its arguments. The index macros available are those defined in `reftex-index-macro' or @@ -156,6 +158,7 @@ will prompt for other arguments." (member tag tag-list))) (put reftex-docstruct-symbol 'default-index-tag tag))) +;;;###autoload (defun reftex-index-complete-tag (&optional itag opt-args) ;; Ask the user for a tag, completing on known tags. ;; ITAG is the argument number which contains the tag. @@ -180,6 +183,7 @@ will prompt for other arguments." (reftex-update-default-index tag) tag)) +;;;###autoload (defun reftex-index-select-tag () ;; Have the user select an index tag. ;; FIXME: should we cache tag-alist, prompt and help? @@ -249,6 +253,7 @@ will prompt for other arguments." (error "No index tag associated with %c" rpl))))) (t (error "This should not happen (reftex-index-select-tag)"))))) +;;;###autoload (defun reftex-index-complete-key (&optional tag optional initial) ;; Read an index key, with completion. ;; Restrict completion table on index tag TAG. @@ -434,6 +439,7 @@ _ ^ Add/Remove parent key (to make this item a subitem). } / { Restrict Index to a single document section / Widen. < / > When restricted, move restriction to previous/next section.") +;;;###autoload (defun reftex-index-show-entry (data &optional no-revisit) ;; Find an index entry associated with DATA and display it highlighted ;; in another window. NO-REVISIT means we are not allowed to visit @@ -462,6 +468,7 @@ _ ^ Add/Remove parent key (to make this item a subitem). (reftex-highlight 0 (match-beginning 0) (match-end 0) (current-buffer))) match)) +;;;###autoload (defun reftex-display-index (&optional tag overriding-restriction redo &rest locations) "Display a buffer with an index compiled from the current document. @@ -1244,6 +1251,7 @@ This gets refreshed in every phrases command.") table) "Syntax table for RefTeX Index Phrases mode.") +;;;###autoload (defun reftex-index-phrase-selection-or-word (arg) "Add current selection or word at point to the phrases buffer. When you are in transient-mark-mode and the region is active, the @@ -1258,6 +1266,7 @@ You get a chance to edit the entry in the phrases buffer - finish with (substitute-command-keys "Return to LaTeX with \\[reftex-index-phrases-save-and-return]")))) +;;;###autoload (defun reftex-index-visit-phrases-buffer () "Switch to the phrases buffer, initialize if empty." (interactive) @@ -1345,6 +1354,7 @@ If the buffer is non-empty, delete the old header first." (defvar reftex-index-phrases-menu) (defvar reftex-index-phrases-marker) (defvar reftex-index-phrases-restrict-file nil) +;; NB this is a global autoload - see reftex.el. ;;;###autoload (define-derived-mode reftex-index-phrases-mode fundamental-mode "Phrases" "Major mode for managing the Index phrases of a LaTeX document. @@ -2096,3 +2106,7 @@ Does not do a save-excursion." (provide 'reftex-index) ;;; reftex-index.el ends here + +;; Local Variables: +;; generated-autoload-file: "reftex.el" +;; End: diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el index 4dc20c4fa8f..7f186afc27c 100644 --- a/lisp/textmodes/reftex-parse.el +++ b/lisp/textmodes/reftex-parse.el @@ -37,17 +37,22 @@ ,@body)) (set-syntax-table saved-syntax)))) +;;;###autoload (defun reftex-parse-one () "Re-parse this file." (interactive) (let ((reftex-enable-partial-scans t)) (reftex-access-scan-info '(4)))) +;;;###autoload (defun reftex-parse-all () "Re-parse entire document." (interactive) (reftex-access-scan-info '(16))) +(defvar reftex--index-tags) + +;;;###autoload (defun reftex-do-parse (rescan &optional file) "Do a document rescan. When allowed, do only a partial scan from FILE." @@ -72,7 +77,7 @@ When allowed, do only a partial scan from FILE." (file (or file (buffer-file-name))) (true-file (file-truename file)) (bibview-cache (assq 'bibview-cache old-list)) - (index-tags (cdr (assq 'index-tags old-list))) + (reftex--index-tags (cdr (assq 'index-tags old-list))) from-file appendix docstruct tmp) ;; Make sure replacement is really an option here @@ -92,7 +97,7 @@ When allowed, do only a partial scan from FILE." (t (error "This should not happen (reftex-do-parse)")))) ;; Reset index-tags if we scan everything - (if (equal rescan 1) (setq index-tags nil)) + (if (equal rescan 1) (setq reftex--index-tags nil)) ;; Find active toc entry and initialize section-numbers (setq reftex-active-toc (reftex-last-assoc-before-elt @@ -137,11 +142,12 @@ When allowed, do only a partial scan from FILE." (entry (or (assq 'is-multi docstruct) (car (push (list 'is-multi is-multi) docstruct))))) (setcdr entry (cons is-multi nil))) - (and index-tags (setq index-tags (sort index-tags 'string<))) + (and reftex--index-tags + (setq reftex--index-tags (sort reftex--index-tags 'string<))) (let ((index-tag-cell (assq 'index-tags docstruct))) (if index-tag-cell - (setcdr index-tag-cell index-tags) - (push (cons 'index-tags index-tags) docstruct))) + (setcdr index-tag-cell reftex--index-tags) + (push (cons 'index-tags reftex--index-tags) docstruct))) (unless (assq 'xr docstruct) (let* ((allxr (reftex-all-assq 'xr-doc docstruct)) (alist (mapcar @@ -165,11 +171,13 @@ When allowed, do only a partial scan from FILE." (set reftex-docstruct-symbol docstruct) (put reftex-docstruct-symbol 'modified t))) +;;;###autoload (defun reftex-everything-regexp () (if reftex-support-index reftex-everything-regexp reftex-everything-regexp-no-index)) +;; NB this is a global autoload - see reftex.el. ;;;###autoload (defun reftex-all-document-files (&optional relative) "Return a list of all files belonging to the current document. @@ -189,8 +197,6 @@ of master file." (nreverse file-list))) ;; Bound in the caller, reftex-do-parse. -(defvar index-tags) - (defun reftex-parse-from-file (file docstruct master-dir) "Scan the buffer for labels and save them in a list." (let ((regexp (reftex-everything-regexp)) @@ -300,7 +306,7 @@ of master file." (when reftex-support-index (setq index-entry (reftex-index-info file)) (when index-entry - (add-to-list 'index-tags (nth 1 index-entry)) + (add-to-list 'reftex--index-tags (nth 1 index-entry)) (push index-entry docstruct)))) ((match-end 11) @@ -359,6 +365,7 @@ of master file." (save-excursion (re-search-forward "^[^%\n]*?\\\\usepackage.*{biblatex}" nil t)))) +;;;###autoload (defun reftex-locate-bibliography-files (master-dir &optional files) "Scan buffer for bibliography macros and return file list." (unless files @@ -421,6 +428,7 @@ This function also makes sure the old toc markers do not point anywhere." (setcdr (nthcdr (1- (length new)) new) (cdr eof-list))) new)))) +;;;###autoload (defun reftex-section-info (file) "Return a section entry for the current match. Careful: This function expects the match-data to be still in place!" @@ -457,6 +465,7 @@ Careful: This function expects the match-data to be still in place!" (list 'toc "toc" text file marker level section-number literal (marker-position marker)))) +;;;###autoload (defun reftex-ensure-index-support (&optional abort) "When index support is turned off, ask to turn it on and set the current prefix argument so that `reftex-access-scan-info' @@ -472,11 +481,13 @@ will rescan the entire document." (ding) (sit-for 1))))) +;;;###autoload (defun reftex-index-info-safe (file) (reftex-with-special-syntax (reftex-index-info file))) (defvar test-dummy) +;;;###autoload (defun reftex-index-info (file) "Return an index entry for the current match. Careful: This function expects the match-data to be still in place!" @@ -525,6 +536,7 @@ Careful: This function expects the match-data to be still in place!" ;; 0 1 2 3 4 5 6 7 8 9 (list 'index index-tag context file bom arg key showkey sortkey key-end)))) +;;;###autoload (defun reftex-short-context (env parse &optional bound derive) "Get about one line of useful context for the label definition at point." @@ -585,6 +597,7 @@ Careful: This function expects the match-data to be still in place!" (t "INVALID VALUE OF PARSE")))) +;;;###autoload (defun reftex-where-am-I () "Return the docstruct entry above point. Actually returns a cons cell in which the cdr is a flag indicating @@ -683,6 +696,7 @@ if the information is exact (t) or approximate (nil)." cnt 2)) (cons rtn (eq cnt 1)))) +;;;###autoload (defun reftex-notice-new (&optional n force) "Hook to handshake with RefTeX after something new has been inserted." ;; Add a new entry to the docstruct list. If it is a section, renumber @@ -759,7 +773,7 @@ if the information is exact (t) or approximate (nil)." ;; Index entry (and reftex-support-index (setq entry (reftex-index-info-safe buffer-file-name)) - ;; FIXME: (add-to-list 'index-tags (nth 1 index-entry)) + ;; FIXME: (add-to-list 'reftex--index-tags (nth 1 index-entry)) (push entry (cdr tail)))))))))) (error nil)) @@ -781,11 +795,13 @@ in TeX." t) (t nil))) +;;;###autoload (defun reftex-what-macro-safe (which &optional bound) "Call `reftex-what-macro' with special syntax table." (reftex-with-special-syntax (reftex-what-macro which bound))) +;;;###autoload (defun reftex-what-macro (which &optional bound) "Find out if point is within the arguments of any TeX-macro. The return value is either (\"\\macro\" . (point)) or a list of them. @@ -848,6 +864,7 @@ considered an argument of macro \\macro." (goto-char pos))) (nreverse cmd-list))))) +;;;###autoload (defun reftex-what-environment (which &optional bound) "Find out if point is inside a LaTeX environment. The return value is (e.g.) either (\"equation\" . (point)) or a list of @@ -885,6 +902,7 @@ this point. If it is nil, limit to nearest \\section - like statement." (throw 'exit (cons env (point)))))) (nreverse env-list))))) +;;;###autoload (defun reftex-what-special-env (which &optional bound) "Run the special environment parsers and return the matches. @@ -925,7 +943,7 @@ If WHICH is a list of environments, look only for those environments and specials (car specials)))))) -(defsubst reftex-move-to-next-arg (&optional ignore) +(defsubst reftex-move-to-next-arg (&optional _ignore) "Assuming that we are at the end of a macro name or a macro argument, move forward to the opening parenthesis of the next argument. This function understands the splitting of macros over several lines @@ -944,6 +962,7 @@ in TeX." (let ((entry (assoc key reftex-env-or-mac-alist))) (reftex-nth-arg (nth 5 entry) (nth 6 entry)))) +;;;###autoload (defun reftex-nth-arg (n &optional opt-args) "Return the Nth following {} or [] parentheses content. OPT-ARGS is a list of argument numbers which are optional." @@ -982,6 +1001,7 @@ OPT-ARGS is a list of argument numbers which are optional." (reftex-context-substring) nil)))) +;;;###autoload (defun reftex-move-over-touching-args () (condition-case nil (while (memq (following-char) '(?\[ ?\{)) @@ -1021,6 +1041,7 @@ When point is just after a { or [, limit string to matching parenthesis" ;; Variable holding the vector with section numbers (defvar reftex-section-numbers (make-vector reftex-max-section-depth 0)) +;;;###autoload (defun reftex-init-section-numbers (&optional toc-entry appendix) "Initialize the section numbers with zeros or with what is found in the TOC-ENTRY." (let* ((level (or (nth 5 toc-entry) -1)) @@ -1039,6 +1060,7 @@ When point is just after a { or [, limit string to matching parenthesis" (decf i))) (put 'reftex-section-numbers 'appendix appendix)) +;;;###autoload (defun reftex-section-number (&optional level star) "Return a string with the current section number. When LEVEL is non-nil, increase section numbers on that level." @@ -1107,3 +1129,7 @@ When LEVEL is non-nil, increase section numbers on that level." (provide 'reftex-parse) ;;; reftex-parse.el ends here + +;; Local Variables: +;; generated-autoload-file: "reftex.el" +;; End: diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el index 0767b567c31..be119d9db58 100644 --- a/lisp/textmodes/reftex-ref.el +++ b/lisp/textmodes/reftex-ref.el @@ -29,6 +29,7 @@ (require 'reftex) (require 'reftex-parse) +;;;###autoload (defun reftex-label-location (&optional bound) "Return the environment or macro which determines the label type at point. If optional BOUND is an integer, limit backward searches to that point." @@ -62,6 +63,7 @@ If optional BOUND is an integer, limit backward searches to that point." (t ;; This should not happen, I think? "section")))) +;;;###autoload (defun reftex-label-info-update (cell) ;; Update information about just one label in a different file. ;; CELL contains the old info list @@ -92,6 +94,7 @@ If optional BOUND is an integer, limit backward searches to that point." (append (reftex-label-info label file) (list note))) (list label typekey "" file "LOST LABEL. RESCAN TO FIX."))))))) +;;;###autoload (defun reftex-label-info (label &optional file bound derive env-or-mac) ;; Return info list on LABEL at point. (let* ((prefix (if (string-match "^[a-zA-Z0-9]+:" label) @@ -118,6 +121,7 @@ If optional BOUND is an integer, limit backward searches to that point." ;;; Creating labels --------------------------------------------------------- +;;;###autoload (defun reftex-label (&optional environment no-insert) "Insert a unique label. Return the label. If ENVIRONMENT is given, don't bother to find out yourself. @@ -398,6 +402,7 @@ also applies `reftex-translate-to-ascii-function' to the string." a / A Put all marked entries into one/many \\ref commands. q / RET Quit without referencing / Accept current label (also on mouse-2).") +;;;###autoload (defun reftex-reference (&optional type no-insert cut) "Make a LaTeX reference. Look only for labels of a certain TYPE. With prefix arg, force to rescan buffer for labels. This should only be @@ -705,6 +710,7 @@ When called with 2 C-u prefix args, disable magic word recognition." (file (nth 3 data))) (reftex-access-scan-info arg file))))) +;;;###autoload (defun reftex-query-label-type () ;; Ask for label type (let ((key (reftex-select-with-char @@ -713,6 +719,7 @@ When called with 2 C-u prefix args, disable magic word recognition." (error "No such label type: %s" (char-to-string key))) (char-to-string key))) +;;;###autoload (defun reftex-show-label-location (data forward no-revisit &optional stay error) ;; View the definition site of a label in another window. @@ -833,10 +840,14 @@ package.\n\nThis is a generated function." Replace any occurrences of \"\\ref\" with REFSTYLE." ;; Replace instances of \ref in `fmt' with the special reference ;; style selected by the user. - (while (string-match "\\(\\\\ref\\)[ \t]*{" fmt) - (setq fmt (replace-match refstyle t t fmt 1))) + (cond + ((while (string-match "\\(\\\\ref\\)[ \t]*{" fmt) + (setq fmt (replace-match refstyle t t fmt 1)))) + ((string-match "\\(\\\\[[:alpha:]]+\\)[ \t]*{" fmt) + (setq fmt (replace-match refstyle t t fmt 1)))) (format fmt label)) +;;;###autoload (defun reftex-goto-label (&optional other-window) "Prompt for a label (with completion) and jump to the location of this label. Optional prefix argument OTHER-WINDOW goes to the label in another window." @@ -867,3 +878,7 @@ Optional prefix argument OTHER-WINDOW goes to the label in another window." (provide 'reftex-ref) ;;; reftex-ref.el ends here + +;; Local Variables: +;; generated-autoload-file: "reftex.el" +;; End: diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el index cd166735e27..643dbfb5a35 100644 --- a/lisp/textmodes/reftex-sel.el +++ b/lisp/textmodes/reftex-sel.el @@ -102,7 +102,8 @@ This keymap can be used to configure the label selection process which is started with the command \\[reftex-reference].") -(define-derived-mode reftex-select-label-mode fundamental-mode "LSelect" +;;;###autoload +(define-derived-mode reftex-select-label-mode special-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 @@ -147,7 +148,8 @@ During a selection process, these are the local bindings. This keymap can be used to configure the BibTeX selection process which is started with the command \\[reftex-citation].") -(define-derived-mode reftex-select-bib-mode fundamental-mode "BSelect" +;;;###autoload +(define-derived-mode reftex-select-bib-mode special-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 @@ -188,6 +190,7 @@ During a selection process, these are the local bindings. ;; (throw 'exit entry))) ;; nil)))) +;;;###autoload (defun reftex-get-offset (buf here-am-I &optional typekey toc index file) ;; Find the correct offset data, like insert-docstruct would, but faster. ;; Buffer BUF knows the correct docstruct to use. @@ -212,6 +215,7 @@ During a selection process, these are the local bindings. (throw 'exit (or lastentry entry)))) nil)))) +;;;###autoload (defun reftex-insert-docstruct (buf toc labels index-entries files context counter show-commented here-I-am xr-prefix toc-buffer) @@ -292,7 +296,7 @@ During a selection process, these are the local bindings. (setq to (point)) (when font (put-text-property from to - 'face reftex-file-boundary-face)) + 'font-lock-face reftex-file-boundary-face)) (when toc-buffer (if mouse-face (put-text-property from (1- to) @@ -310,7 +314,7 @@ During a selection process, these are the local bindings. (setq to (point)) (when font (put-text-property from to - 'face reftex-section-heading-face)) + 'font-lock-face reftex-section-heading-face)) (when toc-buffer (if mouse-face (put-text-property from (1- to) @@ -349,7 +353,7 @@ During a selection process, these are the local bindings. (setq to (point)) (put-text-property (- (point) (length label)) to - 'face (if comment + 'font-lock-face (if comment 'font-lock-comment-face label-face)) (goto-char to)) @@ -379,14 +383,14 @@ During a selection process, these are the local bindings. (setq index-tag (format "<%s>" (nth 1 cell))) (and font (put-text-property 0 (length index-tag) - 'face reftex-index-tag-face index-tag)) + 'font-lock-face reftex-index-tag-face index-tag)) (insert label-indent index-tag " " (nth 7 cell)) (when font (setq to (point)) (put-text-property (- (point) (length (nth 7 cell))) to - 'face index-face) + 'font-lock-face index-face) (goto-char to)) (insert "\n") (setq to (point)) @@ -412,6 +416,7 @@ During a selection process, these are the local bindings. (run-hooks 'reftex-display-copied-context-hook) offset)) +;;;###autoload (defun reftex-find-start-point (fallback &rest locations) ;; Set point to the first available LOCATION. When a LOCATION is a list, ;; search for such a :data text property. When it is an integer, @@ -440,6 +445,7 @@ During a selection process, these are the local bindings. (defvar reftex-last-line nil) (defvar reftex-select-marked nil) +;;;###autoload (defun reftex-select-item (reftex-select-prompt help-string keymap &optional offset call-back cb-flag) @@ -684,7 +690,7 @@ Cycle in reverse order if optional argument REVERSE is non-nil." eoe (or (next-single-property-change (point) :data) (point-max))) (setq ovl (reftex-make-overlay boe eoe)) (push (list data ovl separator) reftex-select-marked) - (reftex-overlay-put ovl 'face reftex-select-mark-face) + (reftex-overlay-put ovl 'font-lock-face reftex-select-mark-face) (reftex-overlay-put ovl 'before-string (if separator (format "*%c%d* " separator @@ -737,3 +743,7 @@ Cycle in reverse order if optional argument REVERSE is non-nil." (provide 'reftex-sel) ;;; reftex-sel.el ends here + +;; Local Variables: +;; generated-autoload-file: "reftex.el" +;; End: diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el index 697cdfc929d..69cab782315 100644 --- a/lisp/textmodes/reftex-toc.el +++ b/lisp/textmodes/reftex-toc.el @@ -129,7 +129,7 @@ (defvar reftex-toc-include-index-indicator nil) (defvar reftex-toc-max-level-indicator nil) -(define-derived-mode reftex-toc-mode fundamental-mode "TOC" +(define-derived-mode reftex-toc-mode special-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. @@ -190,6 +190,7 @@ M-% Global search and replace to rename label at point. x Switch to TOC of external document (with LaTeX package `xr'). z Jump to a specific section (e.g. '3 z' goes to section 3).") +;;;###autoload (defun reftex-toc (&optional rebuild reuse) "Show the table of contents for the current document. When called with a raw C-u prefix, rescan the document first." @@ -240,13 +241,13 @@ When called with a raw C-u prefix, rescan the document first." (< (window-height) (* 2 window-min-height))) (delete-other-windows)) - (setq reftex-last-window-width (window-width) + (setq reftex-last-window-width (window-total-width) reftex-last-window-height (window-height)) ; remember (unless unsplittable (if reftex-toc-split-windows-horizontally (split-window-right - (floor (* (window-width) + (floor (* (window-total-width) reftex-toc-split-windows-fraction))) (split-window-below (floor (* (window-height) @@ -278,7 +279,7 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help " (abbreviate-file-name reftex-last-toc-master))) (if (reftex-use-fonts) - (put-text-property (point-min) (point) 'face reftex-toc-header-face)) + (put-text-property (point-min) (point) 'font-lock-face reftex-toc-header-face)) (put-text-property (point-min) (point) 'intangible t) (put-text-property (point-min) (1+ (point-min)) 'xr-alist xr-alist) @@ -319,6 +320,7 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help (reftex-find-start-point (point) offset (get 'reftex-toc :reftex-line)) (setq reftex-last-follow-point (point)))) +;;;###autoload (defun reftex-toc-recenter (&optional arg) "Display the TOC window and highlight line corresponding to current position." (interactive "P") @@ -372,8 +374,8 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help (defun reftex-re-enlarge () "Enlarge window to a remembered size." (let ((count (if reftex-toc-split-windows-horizontally - (- (or reftex-last-window-width (window-width)) - (window-width)) + (- (or reftex-last-window-width (window-total-width)) + (window-total-width)) (- (or reftex-last-window-height (window-height)) (window-height))))) (when (> count 0) @@ -1009,6 +1011,7 @@ label prefix determines the wording of a reference." (let (current-prefix-arg) (reftex-toc-recenter)))) +;;;###autoload (defun reftex-toggle-auto-toc-recenter () "Toggle the automatic recentering of the TOC window. When active, leaving point idle will make the TOC window jump to the correct @@ -1088,3 +1091,7 @@ always show the current section in connection with the option (reftex-toggle-auto-toc-recenter)))) ;;; reftex-toc.el ends here + +;; Local Variables: +;; generated-autoload-file: "reftex.el" +;; End: diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index 97dd36ae9e8..160d9fb4cdf 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -70,141 +70,26 @@ (require 'reftex-vars) -;;; Autoloads - -;; Parser functions -(autoload 'reftex-parse-one "reftex-parse" - "Re-parse this file." t) -(autoload 'reftex-parse-all "reftex-parse" - "Re-parse entire document." t) -(autoload 'reftex-do-parse "reftex-parse") -(autoload 'reftex-where-am-I "reftex-parse") -(autoload 'reftex-init-section-numbers "reftex-parse") -(autoload 'reftex-section-info "reftex-parse") -(autoload 'reftex-section-number "reftex-parse") -(autoload 'reftex-what-macro "reftex-parse") -(autoload 'reftex-what-macro-safe "reftex-parse") -(autoload 'reftex-index-info "reftex-parse") -(autoload 'reftex-index-info-safe "reftex-parse") -(autoload 'reftex-short-context "reftex-parse") -(autoload 'reftex-what-environment "reftex-parse") -(autoload 'reftex-what-special-env "reftex-parse") -(autoload 'reftex-move-over-touching-args "reftex-parse") -(autoload 'reftex-notice-new "reftex-parse") -(autoload 'reftex-nth-arg "reftex-parse") -(autoload 'reftex-locate-bibliography-files "reftex-parse") -(autoload 'reftex-ensure-index-support "reftex-parse") -(autoload 'reftex-everything-regexp "reftex-parse") - -;; Labels and References -(autoload 'reftex-label-location "reftex-ref") -(autoload 'reftex-label-info-update "reftex-ref") -(autoload 'reftex-label-info "reftex-ref") -(autoload 'reftex-label "reftex-ref" - "Insert a unique label." t) -(autoload 'reftex-reference "reftex-ref" - "Make a LaTeX reference." t) +;;; Autoloads - see end for automatic autoloads + +;; We autoload tons of functions from these files, but some have +;; a single function that needs to be globally autoloaded. +;; The alternative is to use a Makefile rule + distinct autoload +;; cookie (eg ;;;###reftex-autoload) for internal autoloads, +;; as eg calendar/ does. But that seemed like overkill for 4 functions. + +;;;###autoload(autoload 'reftex-citation "reftex-cite" nil t) +;;;###autoload(autoload 'reftex-all-document-files "reftex-parse") +;;;###autoload(autoload 'reftex-isearch-minor-mode "reftex-global" nil t) +;;;###autoload(autoload 'reftex-index-phrases-mode "reftex-index" nil t) + +;; Generated functions. (autoload 'reftex-varioref-vref "reftex-ref" "Make a varioref reference." t) (autoload 'reftex-fancyref-fref "reftex-ref" "Make a fancyref \\fref reference." t) (autoload 'reftex-fancyref-Fref "reftex-ref" "Make a fancyref \\Fref reference." t) -(autoload 'reftex-show-label-location "reftex-ref") -(autoload 'reftex-query-label-type "reftex-ref") -(autoload 'reftex-goto-label "reftex-ref" - "Prompt for label name and go to that location." t) - -;; Table of contents -(autoload 'reftex-toc "reftex-toc" - "Show the table of contents for the current document." t) -(autoload 'reftex-toc-recenter "reftex-toc" - "Display the TOC window and highlight line corresponding to current position." t) -(autoload 'reftex-toggle-auto-toc-recenter "reftex-toc" - "Toggle automatic recentering of TOC window." t) - -;; BibTeX citations. -(autoload 'reftex-citep "reftex-cite") -(autoload 'reftex-citet "reftex-cite") -(autoload 'reftex-make-cite-echo-string "reftex-cite") -(autoload 'reftex-get-bibfile-list "reftex-cite") -(autoload 'reftex-pop-to-bibtex-entry "reftex-cite") -(autoload 'reftex-end-of-bib-entry "reftex-cite") -(autoload 'reftex-parse-bibtex-entry "reftex-cite") -(autoload 'reftex-citation "reftex-cite" - "Make a citation using BibTeX database files." t) -(autoload 'reftex-default-bibliography "reftex-cite") -(autoload 'reftex-bib-or-thebib "reftex-cite") -(autoload 'reftex-create-bibtex-file "reftex-cite" - "Create a new BibTeX database BIBFILE with all entries referenced in document." - t) - -;; Selection -(autoload 'reftex-select-label-mode "reftex-sel") -(autoload 'reftex-select-bib-mode "reftex-sel") -(autoload 'reftex-find-start-point "reftex-sel") -(autoload 'reftex-insert-docstruct "reftex-sel") -(autoload 'reftex-get-offset "reftex-sel") -(autoload 'reftex-select-item "reftex-sel") - -;; Index support -(autoload 'reftex-index "reftex-index" - "Query for an index macro and insert it along with its arguments." t) -(autoload 'reftex-index-selection-or-word "reftex-index" - "Put selection or the word near point into the default index macro." t) -(autoload 'reftex-index-phrase-selection-or-word "reftex-index" - "Put selection or the word near point into Index Phrases File." t) -(autoload 'reftex-display-index "reftex-index" - "Display a buffer with an index compiled from the current document." t) -(autoload 'reftex-index-visit-phrases-buffer "reftex-index" - "Visit the Index Phrases File." t) -(autoload 'reftex-index-phrases-mode "reftex-index" - "Major mode for managing the Index phrases of a LaTeX document." t) -(autoload 'reftex-index-complete-tag "reftex-index") -(autoload 'reftex-index-complete-key "reftex-index") -(autoload 'reftex-index-show-entry "reftex-index") -(autoload 'reftex-index-select-tag "reftex-index") - -;; View cross references -(autoload 'reftex-view-crossref "reftex-dcr" - "View cross reference of \\ref or \\cite macro at point." t) -(autoload 'reftex-mouse-view-crossref "reftex-dcr" - "View cross reference of \\ref or \\cite macro where you click." t) -(autoload 'reftex-toggle-auto-view-crossref "reftex-dcr") -(autoload 'reftex-view-crossref-from-bibtex "reftex-dcr" - "View location in a LaTeX document which cites the BibTeX entry at point." t) - -;; Operations on entire Multifile documents -(autoload 'reftex-create-tags-file "reftex-global" - "Create TAGS file by running `etags' on the current document." t) -(autoload 'reftex-grep-document "reftex-global" - "Run grep query through all files related to this document." t) -(autoload 'reftex-search-document "reftex-global" - "Regexp search through all files of the current TeX document." t) -(autoload 'reftex-query-replace-document "reftex-global" - "Run a query-replace-regexp of FROM with TO over the entire TeX document." t) -(autoload 'reftex-find-duplicate-labels "reftex-global" - "Produce a list of all duplicate labels in the document." t) -(autoload 'reftex-change-label "reftex-global" - "Query replace FROM with TO in all \\label and \\ref commands." t) -(autoload 'reftex-renumber-simple-labels "reftex-global" - "Renumber all simple labels in the document to make them sequentially." t) -(autoload 'reftex-save-all-document-buffers "reftex-global" - "Save all documents associated with the current document." t) - -;; AUCTeX Interface -(autoload 'reftex-arg-label "reftex-auc") -(autoload 'reftex-arg-cite "reftex-auc") -(autoload 'reftex-arg-index-tag "reftex-auc") -(autoload 'reftex-arg-index "reftex-auc") -(autoload 'reftex-plug-into-AUCTeX "reftex-auc") -(autoload 'reftex-toggle-plug-into-AUCTeX "reftex-auc" - "Toggle Interface between AUCTeX and RefTeX on and off." t) -(autoload 'reftex-add-label-environments "reftex-auc") -(autoload 'reftex-add-to-label-alist "reftex-auc") -(autoload 'reftex-add-section-levels "reftex-auc") -(autoload 'reftex-notice-new-section "reftex-auc") - ;;; ========================================================================= ;;; @@ -2493,6 +2378,703 @@ Your bug report will be posted to the AUCTeX bug reporting list. ;;; That's it! ---------------------------------------------------------------- (setq reftex-tables-dirty t) ; in case this file is evaluated by hand + + +;;; Start of automatically extracted autoloads. + +;;;### (autoloads nil "reftex-auc" "reftex-auc.el" "cf606f7918831321cb46f254436dc66e") +;;; Generated autoloads from reftex-auc.el + +(autoload 'reftex-arg-label "reftex-auc" "\ +Use `reftex-label', `reftex-reference' or AUCTeX's code to insert label arg. +What is being used depends upon `reftex-plug-into-AUCTeX'. + +\(fn OPTIONAL &optional PROMPT DEFINITION)" nil nil) + +(autoload 'reftex-arg-cite "reftex-auc" "\ +Use `reftex-citation' or AUCTeX's code to insert a cite-key macro argument. +What is being used depends upon `reftex-plug-into-AUCTeX'. + +\(fn OPTIONAL &optional PROMPT DEFINITION)" nil nil) + +(autoload 'reftex-arg-index-tag "reftex-auc" "\ +Prompt for an index tag with completion. +This is the name of an index, not the entry. + +\(fn OPTIONAL &optional PROMPT &rest ARGS)" nil nil) + +(autoload 'reftex-arg-index "reftex-auc" "\ +Prompt for an index entry completing with known entries. +Completion is specific for just one index, if the macro or a tag +argument identify one of multiple indices. + +\(fn OPTIONAL &optional PROMPT &rest ARGS)" nil nil) + +(autoload 'reftex-plug-into-AUCTeX "reftex-auc" "\ + + +\(fn)" nil nil) + +(autoload 'reftex-toggle-plug-into-AUCTeX "reftex-auc" "\ +Toggle Interface between AUCTeX and RefTeX on and off. + +\(fn)" t nil) + +(autoload 'reftex-add-label-environments "reftex-auc" "\ +Add label environment descriptions to `reftex-label-alist-style'. +The format of ENTRY-LIST is exactly like `reftex-label-alist'. See there +for details. +This function makes it possible to support RefTeX from AUCTeX style files. +The entries in ENTRY-LIST will be processed after the user settings in +`reftex-label-alist', and before the defaults (specified in +`reftex-default-label-alist-entries'). Any changes made to +`reftex-label-alist-style' will raise a flag to the effect that +the label information is recompiled on next use. + +\(fn ENTRY-LIST)" nil nil) + +(defalias 'reftex-add-to-label-alist 'reftex-add-label-environments) + +(autoload 'reftex-add-section-levels "reftex-auc" "\ +Add entries to the value of `reftex-section-levels'. +The added values are kept local to the current document. The format +of ENTRY-LIST is a list of cons cells (\"MACRONAME\" . LEVEL). See +`reftex-section-levels' for an example. + +\(fn ENTRY-LIST)" nil nil) + +(autoload 'reftex-notice-new-section "reftex-auc" "\ + + +\(fn)" nil nil) + +;;;*** + +;;;### (autoloads nil "reftex-cite" "reftex-cite.el" "5a53c260fa01268c04ea2f558add9d7d") +;;; Generated autoloads from reftex-cite.el + +(autoload 'reftex-default-bibliography "reftex-cite" "\ +Return the expanded value of variable `reftex-default-bibliography'. +The expanded value is cached. + +\(fn)" nil nil) + +(autoload 'reftex-bib-or-thebib "reftex-cite" "\ +Test if BibTeX or egin{thebibliography} should be used for the citation. +Find the bof of the current file + +\(fn)" nil nil) + +(autoload 'reftex-get-bibfile-list "reftex-cite" "\ +Return list of bibfiles for current document. +When using the chapterbib or bibunits package you should either +use the same database files everywhere, or separate parts using +different databases into different files (included into the mater file). +Then this function will return the applicable database files. + +\(fn)" nil nil) + +(autoload 'reftex-pop-to-bibtex-entry "reftex-cite" "\ +Find BibTeX KEY in any file in FILE-LIST in another window. +If MARK-TO-KILL is non-nil, mark new buffer to kill. +If HIGHLIGHT is non-nil, highlight the match. +If ITEM in non-nil, search for bibitem instead of database entry. +If RETURN is non-nil, just return the entry and restore point. + +\(fn KEY FILE-LIST &optional MARK-TO-KILL HIGHLIGHT ITEM RETURN)" nil nil) + +(autoload 'reftex-end-of-bib-entry "reftex-cite" "\ + + +\(fn ITEM)" nil nil) + +(autoload 'reftex-parse-bibtex-entry "reftex-cite" "\ +Parse BibTeX ENTRY. +If ENTRY is nil then parse the entry in current buffer between FROM and TO. +If RAW is non-nil, keep double quotes/curly braces delimiting fields. + +\(fn ENTRY &optional FROM TO RAW)" nil nil) + +(autoload 'reftex-citation "reftex-cite" "\ +Make a citation using BibTeX database files. +After prompting for a regular expression, scans the buffers with +bibtex entries (taken from the \\bibliography command) and offers the +matching entries for selection. The selected entry is formatted according +to `reftex-cite-format' and inserted into the buffer. + +If NO-INSERT is non-nil, nothing is inserted, only the selected key returned. + +FORMAT-KEY can be used to pre-select a citation format. + +When called with a `C-u' prefix, prompt for optional arguments in +cite macros. When called with a numeric prefix, make that many +citations. When called with point inside the braces of a `\\cite' +command, it will add another key, ignoring the value of +`reftex-cite-format'. + +The regular expression uses an expanded syntax: && is interpreted as `and'. +Thus, `aaaa&&bbb' matches entries which contain both `aaaa' and `bbb'. +While entering the regexp, completion on knows citation keys is possible. +`=' is a good regular expression to match all entries in all files. + +\(fn &optional NO-INSERT FORMAT-KEY)" t nil) + +(autoload 'reftex-citep "reftex-cite" "\ +Call `reftex-citation' with a format selector `?p'. + +\(fn)" t nil) + +(autoload 'reftex-citet "reftex-cite" "\ +Call `reftex-citation' with a format selector `?t'. + +\(fn)" t nil) + +(autoload 'reftex-make-cite-echo-string "reftex-cite" "\ +Format a bibtex ENTRY for the echo area and cache the result. + +\(fn ENTRY DOCSTRUCT-SYMBOL)" nil nil) + +(autoload 'reftex-create-bibtex-file "reftex-cite" "\ +Create a new BibTeX database BIBFILE with all entries referenced in document. +The command prompts for a filename and writes the collected +entries to that file. Only entries referenced in the current +document with any \\cite-like macros are used. The sequence in +the new file is the same as it was in the old database. + +Entries referenced from other entries must appear after all +referencing entries. + +You can define strings to be used as header or footer for the +created files in the variables `reftex-create-bibtex-header' or +`reftex-create-bibtex-footer' respectively. + +\(fn BIBFILE)" t nil) + +;;;*** + +;;;### (autoloads nil "reftex-dcr" "reftex-dcr.el" "08fc5bd6c35f9d6ab4a6ad336d3769c0") +;;; Generated autoloads from reftex-dcr.el + +(autoload 'reftex-view-crossref "reftex-dcr" "\ +View cross reference of macro at point. Point must be on the KEY +argument. When at a `\\ref' macro, show corresponding `\\label' +definition, also in external documents (`xr'). When on a label, show +a locations where KEY is referenced. Subsequent calls find additional +locations. When on a `\\cite', show the associated `\\bibitem' macro or +the BibTeX database entry. When on a `\\bibitem', show a `\\cite' macro +which uses this KEY. When on an `\\index', show other locations marked +by the same index entry. +To define additional cross referencing items, use the option +`reftex-view-crossref-extra'. See also `reftex-view-crossref-from-bibtex'. +With one or two C-u prefixes, enforce rescanning of the document. +With argument 2, select the window showing the cross reference. +AUTO-HOW is only for the automatic crossref display and is handed through +to the functions `reftex-view-cr-cite' and `reftex-view-cr-ref'. + +\(fn &optional ARG AUTO-HOW FAIL-QUIETLY)" t nil) + +(autoload 'reftex-mouse-view-crossref "reftex-dcr" "\ +View cross reference of \\ref or \\cite macro where you click. +If the macro at point is a \\ref, show the corresponding label definition. +If it is a \\cite, show the BibTeX database entry. +If there is no such macro at point, search forward to find one. +With argument, actually select the window showing the cross reference. + +\(fn EV)" t nil) + +(autoload 'reftex-toggle-auto-view-crossref "reftex-dcr" "\ +Toggle the automatic display of crossref information in the echo area. +When active, leaving point idle in the argument of a \\ref or \\cite macro +will display info in the echo area. + +\(fn)" t nil) + +(autoload 'reftex-view-crossref-from-bibtex "reftex-dcr" "\ +View location in a LaTeX document which cites the BibTeX entry at point. +Since BibTeX files can be used by many LaTeX documents, this function +prompts upon first use for a buffer in RefTeX mode. To reset this +link to a document, call the function with a prefix arg. +Calling this function several times find successive citation locations. + +\(fn &optional ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "reftex-global" "reftex-global.el" "5fdd9c2edced0882471f86baf4b4b234") +;;; Generated autoloads from reftex-global.el + +(autoload 'reftex-create-tags-file "reftex-global" "\ +Create TAGS file by running `etags' on the current document. +The TAGS file is also immediately visited with `visit-tags-table'. + +\(fn)" t nil) + +(autoload 'reftex-grep-document "reftex-global" "\ +Run grep query through all files related to this document. +With prefix arg, force to rescan document. +No active TAGS table is required. + +\(fn GREP-CMD)" t nil) + +(autoload 'reftex-search-document "reftex-global" "\ +Regexp search through all files of the current document. +Starts always in the master file. Stops when a match is found. +To continue searching for next match, use command \\[tags-loop-continue]. +No active TAGS table is required. + +\(fn &optional REGEXP)" t nil) + +(autoload 'reftex-query-replace-document "reftex-global" "\ +Do `query-replace-regexp' of FROM with TO over the entire document. +Third arg DELIMITED (prefix arg) means replace only word-delimited matches. +If you exit (\\[keyboard-quit], RET or q), you can resume the query replace +with the command \\[tags-loop-continue]. +No active TAGS table is required. + +\(fn &optional FROM TO DELIMITED)" t nil) + +(autoload 'reftex-find-duplicate-labels "reftex-global" "\ +Produce a list of all duplicate labels in the document. + +\(fn)" t nil) + +(autoload 'reftex-change-label "reftex-global" "\ +Run `query-replace-regexp' of FROM with TO in all macro arguments. +Works on the entire multifile document. +If you exit (\\[keyboard-quit], RET or q), you can resume the query replace +with the command \\[tags-loop-continue]. +No active TAGS table is required. + +\(fn &optional FROM TO)" t nil) + +(autoload 'reftex-renumber-simple-labels "reftex-global" "\ +Renumber all simple labels in the document to make them sequentially. +Simple labels are the ones created by RefTeX, consisting only of the +prefix and a number. After the command completes, all these labels will +have sequential numbers throughout the document. Any references to +the labels will be changed as well. For this, RefTeX looks at the +arguments of any macros which either start or end in the string `ref'. +This command should be used with care, in particular in multifile +documents. You should not use it if another document refers to this +one with the `xr' package. + +\(fn)" t nil) + +(autoload 'reftex-save-all-document-buffers "reftex-global" "\ +Save all documents associated with the current document. +The function is useful after a global action like replacing or renumbering +labels. + +\(fn)" t nil) + +(autoload 'reftex-isearch-minor-mode "reftex-global" "\ +When on, isearch searches the whole document, not only the current file. +This minor mode allows isearch to search through all the files of +the current TeX document. + +With no argument, this command toggles +`reftex-isearch-minor-mode'. With a prefix argument ARG, turn +`reftex-isearch-minor-mode' on if ARG is positive, otherwise turn it off. + +\(fn &optional ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "reftex-index" "reftex-index.el" "d80e84d499050e32569a454d8db16861") +;;; Generated autoloads from reftex-index.el + +(autoload 'reftex-index-selection-or-word "reftex-index" "\ +Put selection or the word near point into the default index macro. +This uses the information in `reftex-index-default-macro' to make an index +entry. The phrase indexed is the current selection or the word near point. +When called with one `C-u' prefix, let the user have a chance to edit the +index entry. When called with 2 `C-u' as prefix, also ask for the index +macro and other stuff. +When called inside TeX math mode as determined by the `texmathp.el' library +which is part of AUCTeX, the string is first processed with the +`reftex-index-math-format', which see. + +\(fn &optional ARG PHRASE)" t nil) + +(autoload 'reftex-index "reftex-index" "\ +Query for an index macro and insert it along with its arguments. +The index macros available are those defined in `reftex-index-macro' or +by a call to `reftex-add-index-macros', typically from an AUCTeX style file. +RefteX provides completion for the index tag and the index key, and +will prompt for other arguments. + +\(fn &optional CHAR KEY TAG SEL NO-INSERT)" t nil) + +(autoload 'reftex-index-complete-tag "reftex-index" "\ + + +\(fn &optional ITAG OPT-ARGS)" nil nil) + +(autoload 'reftex-index-select-tag "reftex-index" "\ + + +\(fn)" nil nil) + +(autoload 'reftex-index-complete-key "reftex-index" "\ + + +\(fn &optional TAG OPTIONAL INITIAL)" nil nil) + +(autoload 'reftex-index-show-entry "reftex-index" "\ + + +\(fn DATA &optional NO-REVISIT)" nil nil) + +(autoload 'reftex-display-index "reftex-index" "\ +Display a buffer with an index compiled from the current document. +When the document has multiple indices, first prompts for the correct one. +When index support is turned off, offer to turn it on. +With one or two `C-u' prefixes, rescan document first. +With prefix 2, restrict index to current document section. +With prefix 3, restrict index to region. + +\(fn &optional TAG OVERRIDING-RESTRICTION REDO &rest LOCATIONS)" t nil) + +(autoload 'reftex-index-phrase-selection-or-word "reftex-index" "\ +Add current selection or word at point to the phrases buffer. +When you are in transient-mark-mode and the region is active, the +selection will be used - otherwise the word at point. +You get a chance to edit the entry in the phrases buffer - finish with +`C-c C-c'. + +\(fn ARG)" t nil) + +(autoload 'reftex-index-visit-phrases-buffer "reftex-index" "\ +Switch to the phrases buffer, initialize if empty. + +\(fn)" t nil) + +(autoload 'reftex-index-phrases-mode "reftex-index" "\ +Major mode for managing the Index phrases of a LaTeX document. +This buffer was created with RefTeX. + +To insert new phrases, use + - `C-c \\' in the LaTeX document to copy selection or word + - `\\[reftex-index-new-phrase]' in the phrases buffer. + +To index phrases use one of: + +\\[reftex-index-this-phrase] index current phrase +\\[reftex-index-next-phrase] index next phrase (or N with prefix arg) +\\[reftex-index-all-phrases] index all phrases +\\[reftex-index-remaining-phrases] index current and following phrases +\\[reftex-index-region-phrases] index the phrases in the region + +You can sort the phrases in this buffer with \\[reftex-index-sort-phrases]. +To display information about the phrase at point, use \\[reftex-index-phrases-info]. + +For more information see the RefTeX User Manual. + +Here are all local bindings. + +\\{reftex-index-phrases-mode-map} + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "reftex-parse" "reftex-parse.el" "c327a848a6d168412b1a9be9f2e3dce8") +;;; Generated autoloads from reftex-parse.el + +(autoload 'reftex-parse-one "reftex-parse" "\ +Re-parse this file. + +\(fn)" t nil) + +(autoload 'reftex-parse-all "reftex-parse" "\ +Re-parse entire document. + +\(fn)" t nil) + +(autoload 'reftex-do-parse "reftex-parse" "\ +Do a document rescan. +When allowed, do only a partial scan from FILE. + +\(fn RESCAN &optional FILE)" nil nil) + +(autoload 'reftex-everything-regexp "reftex-parse" "\ + + +\(fn)" nil nil) + +(autoload 'reftex-all-document-files "reftex-parse" "\ +Return a list of all files belonging to the current document. +When RELATIVE is non-nil, give file names relative to directory +of master file. + +\(fn &optional RELATIVE)" nil nil) + +(autoload 'reftex-locate-bibliography-files "reftex-parse" "\ +Scan buffer for bibliography macros and return file list. + +\(fn MASTER-DIR &optional FILES)" nil nil) + +(autoload 'reftex-section-info "reftex-parse" "\ +Return a section entry for the current match. +Careful: This function expects the match-data to be still in place! + +\(fn FILE)" nil nil) + +(autoload 'reftex-ensure-index-support "reftex-parse" "\ +When index support is turned off, ask to turn it on and +set the current prefix argument so that `reftex-access-scan-info' +will rescan the entire document. + +\(fn &optional ABORT)" nil nil) + +(autoload 'reftex-index-info-safe "reftex-parse" "\ + + +\(fn FILE)" nil nil) + +(autoload 'reftex-index-info "reftex-parse" "\ +Return an index entry for the current match. +Careful: This function expects the match-data to be still in place! + +\(fn FILE)" nil nil) + +(autoload 'reftex-short-context "reftex-parse" "\ +Get about one line of useful context for the label definition at point. + +\(fn ENV PARSE &optional BOUND DERIVE)" nil nil) + +(autoload 'reftex-where-am-I "reftex-parse" "\ +Return the docstruct entry above point. +Actually returns a cons cell in which the cdr is a flag indicating +if the information is exact (t) or approximate (nil). + +\(fn)" nil nil) + +(autoload 'reftex-notice-new "reftex-parse" "\ +Hook to handshake with RefTeX after something new has been inserted. + +\(fn &optional N FORCE)" nil nil) + +(autoload 'reftex-what-macro-safe "reftex-parse" "\ +Call `reftex-what-macro' with special syntax table. + +\(fn WHICH &optional BOUND)" nil nil) + +(autoload 'reftex-what-macro "reftex-parse" "\ +Find out if point is within the arguments of any TeX-macro. +The return value is either (\"\\macro\" . (point)) or a list of them. + +If WHICH is nil, immediately return nil. +If WHICH is 1, return innermost enclosing macro. +If WHICH is t, return list of all macros enclosing point. +If WHICH is a list of macros, look only for those macros and return the + name of the first macro in this list found to enclose point. +If the optional BOUND is an integer, bound backwards directed + searches to this point. If it is nil, limit to nearest \\section - + like statement. + +This function is pretty stable, but can be fooled if the text contains +things like \\macro{aa}{bb} where \\macro is defined to take only one +argument. As RefTeX cannot know this, the string \"bb\" would still be +considered an argument of macro \\macro. + +\(fn WHICH &optional BOUND)" nil nil) + +(autoload 'reftex-what-environment "reftex-parse" "\ +Find out if point is inside a LaTeX environment. +The return value is (e.g.) either (\"equation\" . (point)) or a list of +them. + +If WHICH is nil, immediately return nil. +If WHICH is 1, return innermost enclosing environment. +If WHICH is t, return list of all environments enclosing point. +If WHICH is a list of environments, look only for those environments and + return the name of the first environment in this list found to enclose + point. + +If the optional BOUND is an integer, bound backwards directed searches to +this point. If it is nil, limit to nearest \\section - like statement. + +\(fn WHICH &optional BOUND)" nil nil) + +(autoload 'reftex-what-special-env "reftex-parse" "\ +Run the special environment parsers and return the matches. + +The return value is (e.g.) either (\"my-parser-function\" . (point)) +or a list of them. + +If WHICH is nil, immediately return nil. +If WHICH is 1, return innermost enclosing environment. +If WHICH is t, return list of all environments enclosing point. +If WHICH is a list of environments, look only for those environments and + return the name of the first environment in this list found to enclose + point. + +\(fn WHICH &optional BOUND)" nil nil) + +(autoload 'reftex-nth-arg "reftex-parse" "\ +Return the Nth following {} or [] parentheses content. +OPT-ARGS is a list of argument numbers which are optional. + +\(fn N &optional OPT-ARGS)" nil nil) + +(autoload 'reftex-move-over-touching-args "reftex-parse" "\ + + +\(fn)" nil nil) + +(autoload 'reftex-init-section-numbers "reftex-parse" "\ +Initialize the section numbers with zeros or with what is found in the TOC-ENTRY. + +\(fn &optional TOC-ENTRY APPENDIX)" nil nil) + +(autoload 'reftex-section-number "reftex-parse" "\ +Return a string with the current section number. +When LEVEL is non-nil, increase section numbers on that level. + +\(fn &optional LEVEL STAR)" nil nil) + +;;;*** + +;;;### (autoloads nil "reftex-ref" "reftex-ref.el" "64cd7a4eaec426177a8fb3689139d935") +;;; Generated autoloads from reftex-ref.el + +(autoload 'reftex-label-location "reftex-ref" "\ +Return the environment or macro which determines the label type at point. +If optional BOUND is an integer, limit backward searches to that point. + +\(fn &optional BOUND)" nil nil) + +(autoload 'reftex-label-info-update "reftex-ref" "\ + + +\(fn CELL)" nil nil) + +(autoload 'reftex-label-info "reftex-ref" "\ + + +\(fn LABEL &optional FILE BOUND DERIVE ENV-OR-MAC)" nil nil) + +(autoload 'reftex-label "reftex-ref" "\ +Insert a unique label. Return the label. +If ENVIRONMENT is given, don't bother to find out yourself. +If NO-INSERT is non-nil, do not insert label into buffer. +With prefix arg, force to rescan document first. +When you are prompted to enter or confirm a label, and you reply with +just the prefix or an empty string, no label at all will be inserted. +A new label is also recorded into the label list. +This function is controlled by the settings of reftex-insert-label-flags. + +\(fn &optional ENVIRONMENT NO-INSERT)" t nil) + +(autoload 'reftex-reference "reftex-ref" "\ +Make a LaTeX reference. Look only for labels of a certain TYPE. +With prefix arg, force to rescan buffer for labels. This should only be +necessary if you have recently entered labels yourself without using +reftex-label. Rescanning of the buffer can also be requested from the +label selection menu. +The function returns the selected label or nil. +If NO-INSERT is non-nil, do not insert \\ref command, just return label. +When called with 2 C-u prefix args, disable magic word recognition. + +\(fn &optional TYPE NO-INSERT CUT)" t nil) + +(autoload 'reftex-query-label-type "reftex-ref" "\ + + +\(fn)" nil nil) + +(autoload 'reftex-show-label-location "reftex-ref" "\ + + +\(fn DATA FORWARD NO-REVISIT &optional STAY ERROR)" nil nil) + +(autoload 'reftex-goto-label "reftex-ref" "\ +Prompt for a label (with completion) and jump to the location of this label. +Optional prefix argument OTHER-WINDOW goes to the label in another window. + +\(fn &optional OTHER-WINDOW)" t nil) + +;;;*** + +;;;### (autoloads nil "reftex-sel" "reftex-sel.el" "faea36cbe37033efd3f9063187eef7ee") +;;; Generated autoloads from reftex-sel.el + +(autoload 'reftex-select-label-mode "reftex-sel" "\ +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 +selection process. +To select a label, move the cursor to it and press RET. +Press `?' for a summary of important key bindings. + +During a selection process, these are the local bindings. + +\\{reftex-select-label-mode-map} + +\(fn)" t nil) + +(autoload 'reftex-select-bib-mode "reftex-sel" "\ +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 +selection process. +In order to select a citation, move the cursor to it and press RET. +Press `?' for a summary of important key bindings. + +During a selection process, these are the local bindings. + +\\{reftex-select-label-mode-map} + +\(fn)" t nil) + +(autoload 'reftex-get-offset "reftex-sel" "\ + + +\(fn BUF HERE-AM-I &optional TYPEKEY TOC INDEX FILE)" nil nil) + +(autoload 'reftex-insert-docstruct "reftex-sel" "\ + + +\(fn BUF TOC LABELS INDEX-ENTRIES FILES CONTEXT COUNTER SHOW-COMMENTED HERE-I-AM XR-PREFIX TOC-BUFFER)" nil nil) + +(autoload 'reftex-find-start-point "reftex-sel" "\ + + +\(fn FALLBACK &rest LOCATIONS)" nil nil) + +(autoload 'reftex-select-item "reftex-sel" "\ + + +\(fn REFTEX-SELECT-PROMPT HELP-STRING KEYMAP &optional OFFSET CALL-BACK CB-FLAG)" nil nil) + +;;;*** + +;;;### (autoloads nil "reftex-toc" "reftex-toc.el" "e04344fac7ba4c2043439e130bdd283f") +;;; Generated autoloads from reftex-toc.el + +(autoload 'reftex-toc "reftex-toc" "\ +Show the table of contents for the current document. +When called with a raw C-u prefix, rescan the document first. + +\(fn &optional REBUILD REUSE)" t nil) + +(autoload 'reftex-toc-recenter "reftex-toc" "\ +Display the TOC window and highlight line corresponding to current position. + +\(fn &optional ARG)" t nil) + +(autoload 'reftex-toggle-auto-toc-recenter "reftex-toc" "\ +Toggle the automatic recentering of the TOC window. +When active, leaving point idle will make the TOC window jump to the correct +section. + +\(fn)" t nil) + +;;;*** + +;;; End of automatically extracted autoloads. + (provide 'reftex) ;;; reftex.el ends here diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el index 31bcb34314d..35eaffa9284 100644 --- a/lisp/textmodes/remember.el +++ b/lisp/textmodes/remember.el @@ -319,9 +319,7 @@ With a prefix or a visible region, use the region as INITIAL." (defsubst remember-mail-date (&optional rfc822-p) "Return a simple date. Nothing fancy." - (if rfc822-p - (format-time-string "%a, %e %b %Y %T %z" (current-time)) - (format-time-string "%a %b %e %T %Y" (current-time)))) + (format-time-string (if rfc822-p "%a, %e %b %Y %T %z" "%a %b %e %T %Y"))) (defun remember-buffer-desc () "Using the first line of the current buffer, create a short description." @@ -461,8 +459,7 @@ Used by `remember-store-in-files'." "Store remember data in a file in `remember-data-directory'. The file is named by calling `format-time-string' using `remember-directory-file-name-format' as the format string." - (let ((name (format-time-string - remember-directory-file-name-format (current-time))) + (let ((name (format-time-string remember-directory-file-name-format)) (text (buffer-string))) (with-temp-buffer (insert text) @@ -499,6 +496,8 @@ If this is nil, then `diary-file' will be used instead." :type '(choice (const :tag "diary-file" nil) file) :group 'remember) +(defvar calendar-date-style) ; calendar.el + (defun remember-diary-convert-entry (entry) "Translate MSG to an entry readable by diary." (save-match-data @@ -511,23 +510,17 @@ If this is nil, then `diary-file' will be used instead." ;; which requires calendar. (require 'calendar) (replace-match - (let ((style (if (boundp 'calendar-date-style) - calendar-date-style - ;; Don't complain about obsolescence. - (if (with-no-warnings european-calendar-style) - 'european - 'american)))) - (cond ((eq style 'european) - (concat (match-string 3 entry) "/" - (match-string 2 entry) "/" - (match-string 1 entry))) - ((eq style 'iso) - (concat (match-string 1 entry) "-" + (cond ((eq calendar-date-style 'european) + (concat (match-string 3 entry) "/" + (match-string 2 entry) "/" + (match-string 1 entry))) + ((eq calendar-date-style 'iso) + (concat (match-string 1 entry) "-" (match-string 2 entry) "-" (match-string 3 entry))) - (t (concat (match-string 2 entry) "/" - (match-string 3 entry) "/" - (match-string 1 entry))))) + (t (concat (match-string 2 entry) "/" + (match-string 3 entry) "/" + (match-string 1 entry)))) t t entry)) entry))) diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index fcaf85508a5..cda9703ea6b 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -3121,7 +3121,7 @@ newlines as mandated by `comment-line-break-function'." (defun rst-comment-region (beg end &optional arg) "Comment or uncomment the current region. -Region is from from BEG to END. Uncomment if ARG." +Region is from BEG to END. Uncomment if ARG." (save-excursion (if (consp arg) (rst-uncomment-region beg end arg) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 7dd9c8a6ed2..12d98c8238a 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -240,12 +240,21 @@ This takes effect when first loading the `sgml-mode' library.") "A table for mapping non-ASCII characters into SGML entity names. Currently, only Latin-1 characters are supported.") -;; nsgmls is a free SGML parser in the SP suite available from -;; ftp.jclark.com and otherwise packaged for GNU systems. -;; Its error messages can be parsed by next-error. -;; The -s option suppresses output. - -(defcustom sgml-validate-command "nsgmls -s" ; replaced old `sgmls' +(defcustom sgml-validate-command + ;; prefer tidy because (o)nsgmls is often built without --enable-http + ;; which makes it next to useless + (cond ((executable-find "tidy") + ;; tidy is available from http://tidy.sourceforge.net/ + "tidy --gnu-emacs yes -utf8 -e -q") + ((executable-find "nsgmls") + ;; nsgmls is a free SGML parser in the SP suite available from + ;; ftp.jclark.com, replaced old `sgmls'. + "nsgmls -s") + ((executable-find "onsgmls") + ;; onsgmls is the community version of `nsgmls' + ;; hosted on http://openjade.sourceforge.net/ + "onsgmls -s") + (t "Install (o)nsgmls, tidy, or some other SGML validator, and set `sgml-validate-command'")) "The command to validate an SGML document. The file name of current buffer file name will be appended to this, separated by a space." @@ -447,6 +456,9 @@ This function is designed for use in `fill-nobreak-predicate'. (skip-chars-backward "/?!") (eq (char-before) ?<)))) +(defvar tildify-space-string) +(defvar tildify-foreach-region-function) + ;;;###autoload (define-derived-mode sgml-mode text-mode '(sgml-xml-mode "XML" "SGML") "Major mode for editing SGML documents. @@ -468,6 +480,27 @@ Do \\[describe-key] on the following bindings to discover what they do. \\{sgml-mode-map}" (make-local-variable 'sgml-saved-validate-command) (make-local-variable 'facemenu-end-add-face) + ;; If encoding does not allow non-break space character, use reference. + ;; FIXME: Perhaps use if possible (e.g. when we know its HTML)? + (setq-local tildify-space-string + (if (equal (decode-coding-string + (encode-coding-string " " buffer-file-coding-system) + buffer-file-coding-system) " ") + " " " ")) + ;; FIXME: Use the fact that we're parsing the document already + ;; rather than using regex-based filtering. + (setq-local tildify-foreach-region-function + (apply-partially + 'tildify-foreach-ignore-environments + `((,(eval-when-compile + (concat + "<\\(" + (regexp-opt '("pre" "dfn" "code" "samp" "kbd" "var" + "PRE" "DFN" "CODE" "SAMP" "KBD" "VAR")) + "\\)\\>[^>]*>")) + . ("</" 1 ">")) + ("<! *--" . "-- *>") + ("<" . ">")))) ;;(make-local-variable 'facemenu-remove-face-function) ;; A start or end tag by itself on a line separates a paragraph. ;; This is desirable because SGML discards a newline that appears diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index fa149c6ae2b..e9c7e2f114e 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1203,9 +1203,32 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook (setq tex-command slitex-run-command) (setq tex-start-of-header "\\\\documentstyle{slides}\\|\\\\documentclass{slides}")) +(defvar tildify-space-string) +(defvar tildify-foreach-region-function) + (defun tex-common-initialization () ;; Regexp isearch should accept newline and formfeed as whitespace. (setq-local search-whitespace-regexp "[ \t\r\n\f]+") + ;; Use tilde as hard-space character in tildify package. + (setq-local tildify-space-string "~") + ;; FIXME: Use the fact that we're parsing the document already + ;; rather than using regex-based filtering. + (setq-local tildify-foreach-region-function + (apply-partially + 'tildify-foreach-ignore-environments + `(("\\\\\\\\" . "") ; do not remove this + (,(eval-when-compile + (concat "\\\\begin{\\(" + (regexp-opt '("verbatim" "math" "displaymath" + "equation" "eqnarray" "eqnarray*")) + "\\)}")) + . ("\\\\end{" 1 "}")) + ("\\\\verb\\*?\\(.\\)" . (1)) + ("\\$\\$?" . (0)) + ("\\\\(" . "\\\\)") + ("\\\\[[]" . "\\\\[]]") + ("\\\\[a-zA-Z]+\\( +\\|{}\\)[a-zA-Z]*" . "") + ("%" . "$")))) ;; A line containing just $$ is treated as a paragraph separator. (setq-local paragraph-start "[ \t]*$\\|[\f\\\\%]\\|[ \t]*\\$\\$") ;; A line starting with $$ starts a paragraph, @@ -2603,18 +2626,28 @@ line LINE of the window, or centered if LINE is nil." (prefix-numeric-value linenum) (/ (window-height) 2))))))) +(defcustom tex-print-file-extension ".dvi" + "The TeX-compiled file extension for viewing and printing. +If you use pdflatex instead of latex, set this to \".pdf\" and modify + `tex-dvi-view-command' and `tex-dvi-print-command' appropriately." + :type 'string + :group 'tex-view + :version "25.1") + (defun tex-print (&optional alt) "Print the .dvi file made by \\[tex-region], \\[tex-buffer] or \\[tex-file]. Runs the shell command defined by `tex-dvi-print-command'. If prefix argument is provided, use the alternative command, `tex-alt-dvi-print-command'." (interactive "P") - (let ((print-file-name-dvi (tex-append tex-print-file ".dvi")) + (let ((print-file-name-dvi (tex-append tex-print-file + tex-print-file-extension)) test-name) (if (and (not (equal (current-buffer) tex-last-buffer-texed)) (buffer-file-name) ;; Check that this buffer's printed file is up to date. (file-newer-than-file-p - (setq test-name (tex-append (buffer-file-name) ".dvi")) + (setq test-name (tex-append (buffer-file-name) + tex-print-file-extension)) (buffer-file-name))) (setq print-file-name-dvi test-name)) (if (not (file-exists-p print-file-name-dvi)) diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el index 6a63108a134..df05b670095 100644 --- a/lisp/textmodes/texnfo-upd.el +++ b/lisp/textmodes/texnfo-upd.el @@ -1145,24 +1145,40 @@ For example, \"unnumberedsubsec\". Return \"top\" for top node. Searches forward for a section. Hence, point must be before the section whose type will be found. Does not move point. Signal an error if the node is not the top node and a section is not found." - (let ((case-fold-search t)) - (save-excursion - (cond - ((re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" - ;; Following search limit by cph but causes a bug - ;;(line-end-position) - nil - t) - "top") - ((re-search-forward texinfo-section-types-regexp nil t) - (buffer-substring-no-properties - (progn (beginning-of-line) ; copy its name - (1+ (point))) - (progn (forward-word 1) - (point)))) - (t - (error - "texinfo-specific-section-type: Chapter or section not found")))))) + (let* ((case-fold-search t) + ;; The Texinfo manual has a second Top node inside @verbatim + ;; near the end, which dupes us into thinking we are at top + ;; level, no matter where we are when invoked. We don't + ;; really grok @verbatim, so we cheat: only consider us to be + ;; at top level if the position of the Top node we found is + ;; before any other sectioning command. + (top-pos (save-excursion + (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" + ;; Following search limit causes a bug + ;;(line-end-position) + nil + t))) + (sec-pos (save-excursion + (re-search-forward texinfo-section-types-regexp nil t))) + sec-name) + (if sec-pos + (save-excursion + (goto-char sec-pos) + (setq sec-name (buffer-substring-no-properties + (progn (beginning-of-line) ; copy its name + (1+ (point))) + (progn (forward-word 1) + (point)))))) + (cond + ((or sec-pos top-pos) + (if (and top-pos sec-pos) + (if (< top-pos sec-pos) + "top" + sec-name) + (or sec-name "top"))) + (t + (error + "texinfo-specific-section-type: Chapter or section not found"))))) (defun texinfo-hierarchic-level () "Return the general hierarchical level of the next node in a texinfo file. diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el index 08c2f074c2d..0eae67ae83a 100644 --- a/lisp/textmodes/tildify.el +++ b/lisp/textmodes/tildify.el @@ -1,9 +1,10 @@ -;;; tildify.el --- adding hard spaces into texts +;;; tildify.el --- adding hard spaces into texts -*- lexical-binding: t -*- ;; Copyright (C) 1997-2015 Free Software Foundation, Inc. ;; Author: Milan Zamazal <pdm@zamazal.org> -;; Version: 4.5 +;; Michal Nazarewicz <mina86@mina86.com> +;; Version: 4.6.1 ;; Keywords: text, TeX, SGML, wp ;; This file is part of GNU Emacs. @@ -55,8 +56,21 @@ :version "21.1" :group 'wp) -(defcustom tildify-pattern-alist - '((t "\\([,:;(][ \t]*[a]\\|\\<[AIKOSUVZikosuvz]\\)\\([ \t]+\\|[ \t]*\n[ \t]*\\)\\(\\w\\|[([{\\]\\|<[a-zA-Z]\\)" 2)) +(defcustom tildify-pattern + "\\(?:[,:;(][ \t]*[a]\\|\\<[AIKOSUVZikosuvz]\\)\\([ \t]+\\|[ \t]*\n[ \t]*\\)\\(?:\\w\\|[([{\\]\\|<[a-zA-Z]\\)" + "A pattern specifying where to insert hard spaces. + +`tildify-buffer' function will replace first capturing group of the regexp with +a hard space (as defined by `tildify-space-string' variable). (Hint: \\(…\\) +non-capturing groups can be used for grouping prior to the part of the regexp +matching the white space). The pattern is matched case-sensitive regardless of +the value of `case-fold-search' setting." + :version "25.1" + :group 'tildify + :type 'string + :safe t) + +(defcustom tildify-pattern-alist () "Alist specifying where to insert hard spaces. Each alist item is of the form (MAJOR-MODE REGEXP NUMBER) or @@ -77,16 +91,33 @@ by the hard space character. The form (MAJOR-MODE . SYMBOL) defines alias item for MAJOR-MODE. For this mode, the item for the mode SYMBOL is looked up in the alist instead." :group 'tildify - :type '(repeat (choice (list symbol regexp integer) (cons symbol symbol)))) - -(defcustom tildify-string-alist - '((latex-mode . "~") - (tex-mode . latex-mode) - (plain-tex-mode . latex-mode) - (sgml-mode . " ") - (xml-mode . sgml-mode) - (html-mode . sgml-mode) - (t . " ")) + :type '(repeat (cons :tag "Entry for major mode" + (choice (const :tag "Default" t) + (symbol :tag "Major mode")) + (choice (list :tag "Regexp" + regexp + (integer :tag "Group ")) + (symbol :tag "Like other"))))) +(make-obsolete-variable 'tildify-pattern-alist 'tildify-pattern "25.1") + +(defcustom tildify-space-string "\u00A0" + "Representation of a hard (a.k.a. no-break) space in current major mode. + +Used by `tildify-buffer' in places where space is required but line +cannot be broken. For example \"~\" for TeX or \" \" for SGML, +HTML and XML modes. A no-break space Unicode character (\"\\u00A0\") +might be used for other modes if compatible encoding is used. + +If nil, current major mode has no way to represent a hard space." + :version "25.1" + :group 'tildify + :type '(choice (const :tag "Space character (no hard-space representation)" + " ") + (const :tag "No-break space (U+00A0)" "\u00A0") + (string :tag "Custom string")) + :safe t) + +(defcustom tildify-string-alist () "Alist specifying what is a hard space in the current major mode. Each alist item is of the form (MAJOR-MODE . STRING) or @@ -98,47 +129,45 @@ MAJOR-MODE defines major mode, for which the item applies. It can be either: alist item STRING defines the hard space, which is inserted at places defined by -`tildify-pattern-alist'. For example it can be \"~\" for TeX or \" \" -for SGML. +`tildify-pattern'. For example it can be \"~\" for TeX or \" \" for SGML. The form (MAJOR-MODE . SYMBOL) defines alias item for MAJOR-MODE. For this mode, the item for the mode SYMBOL is looked up in the alist instead." :group 'tildify - :type '(repeat (cons symbol (choice string symbol)))) - -(defcustom tildify-ignored-environments-alist - '((latex-mode - ("\\\\\\\\" . "") ; do not remove this - ("\\\\begin{verbatim}" . "\\\\end{verbatim}") - ("\\\\verb\\*?\\(.\\)" . (1)) - ("\\$\\$" . "\\$\\$") - ("\\$" . "\\$") - ("\\\\(" . "\\\\)") - ("\\\\[[]" . "\\\\[]]") - ("\\\\begin{math}" . "\\\\end{math}") - ("\\\\begin{displaymath}" . "\\\\end{displaymath}") - ("\\\\begin{equation}" . "\\\\end{equation}") - ("\\\\begin{eqnarray\\*?}" . "\\\\end{eqnarray\\*?}") - ("\\\\[a-zA-Z]+\\( +\\|{}\\)[a-zA-Z]*" . "") - ("%" . "$")) - (plain-tex-mode . latex-mode) - (html-mode - ("<pre[^>]*>" . "</pre>") - ("<dfn>" . "</dfn>") - ("<code>" . "</code>") - ("<samp>" . "</samp>") - ("<kbd>" . "</kbd>") - ("<var>" . "</var>") - ("<PRE[^>]*>" . "</PRE>") - ("<DFN>" . "</DFN>") - ("<CODE>" . "</CODE>") - ("<SAMP>" . "</SAMP>") - ("<KBD>" . "</KBD>") - ("<VAR>" . "</VAR>") - ("<! *--" . "-- *>") - ("<" . ">")) - (sgml-mode . html-mode) - (t nil)) + :type '(repeat (cons :tag "Entry for major mode" + (choice (const :tag "Default" t) + (symbol :tag "Major mode")) + (choice (const :tag "No-break space (U+00A0)" "\u00A0") + (string :tag "String ") + (symbol :tag "Like other"))))) +(make-obsolete-variable 'tildify-string-alist + 'tildify-space-string "25.1") + +(defcustom tildify-foreach-region-function + 'tildify--deprecated-ignore-evironments + "A function calling a callback on portions of the buffer to tildify. + +The function is called from `tildify-buffer' function with three arguments: FUNC +BEG END. FUNC is a callback accepting two arguments -- REG-BEG REG-END -- +specifying a portion of buffer to operate on. + +The BEG and END arguments may be used to limit portion of the buffer being +scanned, but the `tildify-foreach-region-function' is not required to make use +of them. IT must, however, terminate as soon as FUNC returns nil. + +For example, if `tildify-buffer' function should operate on the whole buffer, +a simple pass through function could be used: + (setq-local tildify-foreach-region-function + (lambda (cb beg end) (funcall cb beg end))) +or better still: + (setq-local tildify-foreach-region-function 'funcall) +See `tildify-foreach-ignore-environments' function for other ways to use the +variable." + :version "25.1" + :group 'tildify + :type 'function) + +(defcustom tildify-ignored-environments-alist () "Alist specifying ignored structured text environments. Parts of text defined in this alist are skipped without performing hard space insertion on them. These setting allow skipping text parts like verbatim or @@ -152,141 +181,165 @@ MAJOR-MODE defines major mode, for which the item applies. It can be either: - t for default item, this applies to all major modes not defined in another alist item -BEG-REGEX is a regexp matching beginning of a text part to be skipped. -END-REGEX defines end of the corresponding text part and can be either: -- a regexp matching the end of the skipped text part -- a list of regexps and numbers, which will compose the ending regexp by - concatenating themselves, while replacing the numbers with corresponding - subexpressions of BEG-REGEX (this is used to solve cases like - \\\\verb<character> in TeX)." +See `tildify-foreach-ignore-environments' function for description of BEG-REGEX +and END-REGEX." :group 'tildify - :type '(repeat (cons symbol (choice symbol (repeat sexp))))) - - -;;; *** Internal variables *** - -(defvar tildify-count nil - "Counter for replacements.") + :type '(repeat + (cons :tag "Entry for major mode" + (choice (const :tag "Default" t) + (symbol :tag "Major mode")) + (choice + (const :tag "None") + (repeat + :tag "Environments" + (cons :tag "Regexp pair" + (regexp :tag "Open ") + (choice :tag "Close" + (regexp :tag "Regexp") + (list :tag "Regexp and groups (concatenated)" + (choice (regexp :tag "Regexp") + (integer :tag "Group ")))))) + (symbol :tag "Like other"))))) +(make-obsolete-variable 'tildify-ignored-environments-alist + 'tildify-foreach-region-function "25.1") ;;; *** Interactive functions *** ;;;###autoload -(defun tildify-region (beg end) +(defun tildify-region (beg end &optional dont-ask) "Add hard spaces in the region between BEG and END. -See variables `tildify-pattern-alist', `tildify-string-alist', and +See variables `tildify-pattern', `tildify-space-string', and `tildify-ignored-environments-alist' for information about configuration parameters. -This function performs no refilling of the changed text." - (interactive "*r") - (setq tildify-count 0) - (let (a - z - (marker-end (copy-marker end)) - end-env - finish - (ask t) - (case-fold-search nil) - (regexp (tildify-build-regexp)) ; beginnings of environments - aux) - (if regexp - ;; Yes, ignored environments exist for the current major mode, - ;; tildify just texts outside them - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (not finish) - (setq a (point)) - (setq end-env (tildify-find-env regexp)) - (setq z (copy-marker (if end-env (1- (point)) (point-max)))) - (if (>= (marker-position z) beg) - (progn - (or (>= a beg) (setq a beg)) - (or (<= (marker-position z) (marker-position marker-end)) - (setq z marker-end)) - (setq aux (tildify-tildify a (marker-position z) ask)) - (if (eq aux 'force) - (setq ask nil) - (if (eq aux nil) - (setq finish t))))) - (if (>= (marker-position z) (marker-position marker-end)) - (setq finish t)) - (or (>= (point) (marker-position z)) - (goto-char (marker-position z))) - (if (not finish) - (if (re-search-forward end-env nil t) - (if (> (point) (marker-position marker-end)) - (setq finish t)) - (message - "End of environment not found: %s" end-env) - (setq finish t)))))) - ;; No ignored environments, tildify directly - (tildify-tildify beg end ask))) - (message "%d spaces replaced." tildify-count)) +This function performs no refilling of the changed text. +If DONT-ASK is set, or called interactively with prefix argument, user +won't be prompted for confirmation of each substitution." + (interactive "*rP") + (let (case-fold-search (count 0) (ask (not dont-ask))) + (tildify--foreach-region + (lambda (beg end) + (let ((aux (tildify-tildify beg end ask))) + (setq count (+ count (car aux))) + (if (not (eq (cdr aux) 'force)) + (cdr aux) + (setq ask nil) + t))) + beg end) + (message "%d spaces replaced." count))) ;;;###autoload -(defun tildify-buffer () +(defun tildify-buffer (&optional dont-ask) "Add hard spaces in the current buffer. -See variables `tildify-pattern-alist', `tildify-string-alist', and +See variables `tildify-pattern', `tildify-space-string', and `tildify-ignored-environments-alist' for information about configuration parameters. -This function performs no refilling of the changed text." - (interactive "*") - (tildify-region (point-min) (point-max))) +This function performs no refilling of the changed text. +If DONT-ASK is set, or called interactively with prefix argument, user +won't be prompted for confirmation of each substitution." + (interactive "*P") + (tildify-region (point-min) (point-max) dont-ask)) ;;; *** Auxiliary functions *** -(defun tildify-build-regexp () - "Build start of environment regexp." - (let ((alist (tildify-mode-alist tildify-ignored-environments-alist)) - regexp) - (when alist - (setq regexp (caar alist)) - (setq alist (cdr alist)) - (while alist - (setq regexp (concat regexp "\\|" (caar alist))) - (setq alist (cdr alist))) - regexp))) - -(defun tildify-mode-alist (mode-alist &optional mode) +(defun tildify--pick-alist-entry (mode-alist &optional mode) "Return alist item for the MODE-ALIST in the current major MODE." - (if (null mode) - (setq mode major-mode)) - (let ((alist (cdr (or (assoc mode mode-alist) + (let ((alist (cdr (or (assoc (or mode major-mode) mode-alist) (assoc t mode-alist))))) (if (and alist (symbolp alist)) - (tildify-mode-alist mode-alist alist) + (tildify--pick-alist-entry mode-alist alist) alist))) - -(defun tildify-find-env (regexp) +(make-obsolete 'tildify--pick-alist-entry + "it should not be used in new code." "25.1") + +(defun tildify--deprecated-ignore-evironments (callback beg end) + "Call CALLBACK on regions between BEG and END. + +Call CALLBACK on each region outside of environment to ignore. Stop scanning +the region as soon as CALLBACK returns nil. Environments to ignore are +defined by deprecated `tildify-ignored-environments-alist'. CALLBACK may be +called on portions of the buffer outside of [BEG END)." + (let ((pairs (tildify--pick-alist-entry tildify-ignored-environments-alist))) + (if pairs + (tildify-foreach-ignore-environments pairs callback beg end) + (funcall callback beg end)))) +(make-obsolete 'tildify--deprecated-ignore-evironments + "it should not be used in new code." "25.1") + +(defun tildify-foreach-ignore-environments (pairs callback _beg end) + "Outside of environments defined by PAIRS call CALLBACK. + +PAIRS is a list of (BEG-REGEX . END-REGEX) cons. BEG-REGEX is a regexp matching +beginning of a text part to be skipped. END-REGEX defines end of the +corresponding text part and can be either: +- a regexp matching the end of the skipped text part +- a list of regexps and numbers, which will compose the ending regexp by + concatenating themselves, while replacing the numbers with corresponding + subexpressions of BEG-REGEX (this is used to solve cases like + \\\\verb<character> in TeX). + +CALLBACK is a function accepting two arguments -- REG-BEG and REG-END -- that +will be called for portions of the buffer outside of the environments defined by +PAIRS regexes. + +The function will return as soon as CALLBACK returns nil or point goes past END. +CALLBACK may be called on portions of the buffer outside of [BEG END); in fact +BEG argument is ignored. + +This function is meant to be used to set `tildify-foreach-region-function' +variable. For example, for an XML file one might use: + (setq-local tildify-foreach-region-function + (apply-partially 'tildify-foreach-ignore-environments + '((\"<! *--\" . \"-- *>\") (\"<\" . \">\"))))" + (let ((beg-re (concat "\\(?:" (mapconcat 'car pairs "\\)\\|\\(?:") "\\)")) + p end-re) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (and (< (setq p (point)) end) + (if (setq end-re (tildify--find-env beg-re pairs)) + (and (funcall callback p (match-beginning 0)) + (< (point) end) + (re-search-forward end-re nil t)) + (funcall callback p end) + nil))))))) + +(defun tildify--foreach-region (callback beg end) + "Call CALLBACK on portions of the buffer between BEG and END. + +Which portions to call CALLBACK on is determined by +`tildify-foreach-region-function' variable. This function merely makes sure +CALLBACK is not called with portions of the buffer outside of [BEG END)." + (let ((func (lambda (reg-beg reg-end) + (setq reg-beg (max reg-beg beg) reg-end (min reg-end end)) + (and (or (>= reg-beg reg-end) + (funcall callback reg-beg reg-end)) + (< reg-end end))))) + (funcall tildify-foreach-region-function func beg end))) + +(defun tildify--find-env (regexp pairs) "Find environment using REGEXP. -Return regexp for the end of the environment or nil if no environment was -found." +Return regexp for the end of the environment found in PAIRS or nil if +no environment was found." ;; Find environment - (if (re-search-forward regexp nil t) - ;; Build end-env regexp - (let ((match (match-string 0)) - (alist (tildify-mode-alist tildify-ignored-environments-alist)) - expression) - (save-match-data - (while (not (eq (string-match (caar alist) match) 0)) - (setq alist (cdr alist)))) - (if (stringp (setq expression (cdar alist))) - expression - (let ((result "") - aux) - (while expression - (setq result (concat result - (if (stringp (setq aux (car expression))) - expression - (regexp-quote (match-string aux))))) - (setq expression (cdr expression))) - result))) - ;; Return nil if not found - nil)) + (when (re-search-forward regexp nil t) + (save-match-data + (let ((match (match-string 0))) + (while (not (eq (string-match (caar pairs) match) 0)) + (setq pairs (cdr pairs))) + (let ((expression (cdar pairs))) + (if (stringp expression) + expression + (mapconcat + (lambda (expr) + (if (stringp expr) + expr + (regexp-quote (match-string expr match)))) + expression + ""))))))) (defun tildify-tildify (beg end ask) "Add tilde characters in the region between BEG and END. @@ -295,20 +348,26 @@ macros. If ASK is nil, perform replace without asking user for confirmation. -Returns one of symbols: t (all right), nil (quit), force (replace without -further questions)." +Returns (count . response) cons where count is number of string +replacements done and response is one of symbols: t (all right), nil +(quit), force (replace without further questions)." (save-excursion (goto-char beg) - (let* ((alist (tildify-mode-alist tildify-pattern-alist)) - (regexp (car alist)) - (match-number (cadr alist)) - (tilde (tildify-mode-alist tildify-string-alist)) - (end-marker (copy-marker end)) - answer - bad-answer - replace - quit - (message-log-max nil)) + (let ((regexp tildify-pattern) + (match-number 1) + (tilde (or (tildify--pick-alist-entry tildify-string-alist) + tildify-space-string)) + (end-marker (copy-marker end)) + answer + bad-answer + replace + quit + (message-log-max nil) + (count 0)) + ;; For the time being, tildify-pattern-alist overwrites tildify-pattern + (let ((alist (tildify--pick-alist-entry tildify-pattern-alist))) + (when alist + (setq regexp (car alist) match-number (cadr alist)))) (while (and (not quit) (re-search-forward regexp (marker-position end-marker) t)) (when (or (not ask) @@ -335,12 +394,114 @@ further questions)." (setq bad-answer t))) replace)) (replace-match tilde t t nil match-number) - (setq tildify-count (1+ tildify-count)))) + (setq count (1+ count)))) ;; Return value + (cons count (cond (quit nil) + ((not ask) 'force) + (t t)))))) + + +;;; *** Tildify Mode *** + +(defcustom tildify-space-pattern "[,:;(][ \t]*[a]\\|\\<[AIKOSUVWZikosuvwz]" + "Pattern specifying whether to insert a hard space at point. + +If the pattern matches `looking-back', a hard space needs to be inserted instead +of a space at point. The regexp is always case sensitive, regardless of the +current `case-fold-search' setting." + :version "25.1" + :group 'tildify + :type 'string) + +(defcustom tildify-space-predicates '(tildify-space-region-predicate) + "A list of predicate functions for `tildify-space' function." + :version "25.1" + :group 'tildify + :type '(repeat 'function)) + +(defcustom tildify-double-space-undos t + "Weather `tildify-space' should undo hard space when space is typed again." + :version "25.1" + :group 'tildify + :type 'boolean) + +;;;###autoload +(defun tildify-space () + "Convert space before point into a hard space if the context is right. + +If + * character before point is a space character, + * character before that has “w” character syntax (i.e. it's a word + constituent), + * `tildify-space-pattern' matches when `looking-back' (no more than 10 + characters) from before the space character, and + * all predicates in `tildify-space-predicates' return non-nil, +replace the space character with value of `tildify-space-string' and +return t. + +Otherwise, if + * `tildify-double-space-undos' variable is non-nil, + * character before point is a space character, and + * text before that is a hard space as defined by + `tildify-space-string' variable, +remove the hard space and leave only the space character. + +This function is meant to be used as a `post-self-insert-hook'." + (interactive) + (let* ((p (point)) (p-1 (1- p)) (n (- p (point-min))) + (l (length tildify-space-string)) (l+1 (1+ l)) + case-fold-search) + (when (and (> n 2) (eq (preceding-char) ?\s)) (cond - (quit nil) - ((not ask) 'force) - (t t))))) + ((and (eq (char-syntax (char-before p-1)) ?w) + (save-excursion + (goto-char p-1) + (looking-back tildify-space-pattern (max (point-min) (- p 10)))) + (run-hook-with-args-until-failure 'tildify-space-predicates)) + (delete-char -1) + (insert tildify-space-string) + t) + ((and tildify-double-space-undos + (> n l+1) + (string-equal tildify-space-string + (buffer-substring (- p l+1) p-1))) + (goto-char p-1) + (delete-char (- l)) + (goto-char (1+ (point))) + nil))))) + +(defun tildify-space-region-predicate () + "Check whether character before point should be tildified. +Based on `tildify-foreach-region-function', check whether character before, +which is assumed to be a space character, should be replaced with a hard space." + (catch 'found + (tildify--foreach-region (lambda (_b _e) (throw 'found t)) (1- (point)) (point)))) + +;;;###autoload +(define-minor-mode tildify-mode + "Adds electric behaviour to space character. + +When space is inserted into a buffer in a position where hard space is required +instead (determined by `tildify-space-pattern' and `tildify-space-predicates'), +that space character is replaced by a hard space specified by +`tildify-space-string'. Converting of the space is done by `tildify-space'. + +When `tildify-mode' is enabled, if `tildify-string-alist' specifies a hard space +representation for current major mode, the `tildify-space-string' buffer-local +variable will be set to the representation." + nil " ~" nil + (when tildify-mode + (let ((space (tildify--pick-alist-entry tildify-string-alist))) + (if (not (string-equal " " (or space tildify-space-string))) + (when space + (setq tildify-space-string space)) + (message (eval-when-compile + (concat "Hard space is a single space character, tildify-" + "mode won't have any effect, disabling."))) + (setq tildify-mode nil)))) + (if tildify-mode + (add-hook 'post-self-insert-hook 'tildify-space nil t) + (remove-hook 'post-self-insert-hook 'tildify-space t))) ;;; *** Announce *** diff --git a/lisp/timezone.el b/lisp/timezone.el index 0f3ac1e3e5e..284da2139da 100644 --- a/lisp/timezone.el +++ b/lisp/timezone.el @@ -295,13 +295,9 @@ Gregorian date Sunday, December 31, 1 BC." ;; (timezone-absolute-from-gregorian 1 1 1970) (days (- date current-time-origin)) (seconds-per-day (float 86400)) - (seconds (+ seconds (* days seconds-per-day))) - (current-time-arithmetic-base (float 65536)) - (hi (floor (/ seconds current-time-arithmetic-base))) - (hibase (* hi current-time-arithmetic-base)) - (lo (floor (- seconds hibase)))) - (and (< (abs (- seconds (+ hibase lo))) 2) ;; Check for integer overflow. - (cons hi lo)))) + (day-seconds (* days seconds-per-day))) + (condition-case nil (time-add day-seconds seconds) + (range-error)))) (defun timezone-time-zone-from-absolute (date seconds) "Compute the local time zone for DATE at time SECONDS after midnight. diff --git a/lisp/tmm.el b/lisp/tmm.el index ab2e107ef04..2ddeeeeae8e 100644 --- a/lisp/tmm.el +++ b/lisp/tmm.el @@ -371,7 +371,6 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'." (unless tmm-c-prompt (error "No active menu entries")) (setq tmm-old-mb-map (tmm-define-keys t)) - ;; Get window and hide it for electric mode to get correct size (or tmm-completion-prompt (add-hook 'completion-setup-hook 'tmm-completion-delete-prompt 'append)) @@ -381,9 +380,15 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'." (with-current-buffer "*Completions*" (tmm-remove-inactive-mouse-face) (when tmm-completion-prompt - (let ((inhibit-read-only t)) + (let ((inhibit-read-only t) + (window (get-buffer-window "*Completions*"))) (goto-char (point-min)) - (insert tmm-completion-prompt)))) + (insert tmm-completion-prompt) + (when window + ;; Try to show everything just inserted and preserve height of + ;; *Completions* window. This should fix a behavior described + ;; in Bug#1291. + (fit-window-to-buffer window nil nil nil nil t))))) (insert tmm-c-prompt)) (defun tmm-shortcut () diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 04363cf05a5..e6382288379 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -215,11 +215,9 @@ This might return nil if the event did not occur over a buffer." "Change the value of KEY in alist ALIST to VALUE. If there's no association for KEY in ALIST, add one, otherwise change the existing association. Value is the resulting alist." - (let ((param (assq key alist))) - (if (consp param) - (setcdr param value) - (push (cons key value) alist)) - alist)) + (declare (obsolete "use (setf (alist-get ..) ..) instead" "25.1")) + (setf (alist-get key alist) value) + alist) (declare-function x-show-tip "xfns.c" (string &optional frame parms timeout dx dy)) @@ -244,10 +242,10 @@ in echo area." (fg (face-attribute 'tooltip :foreground)) (bg (face-attribute 'tooltip :background))) (when (stringp fg) - (setq params (tooltip-set-param params 'foreground-color fg)) - (setq params (tooltip-set-param params 'border-color fg))) + (setf (alist-get 'foreground-color params) fg) + (setf (alist-get 'border-color params) fg)) (when (stringp bg) - (setq params (tooltip-set-param params 'background-color bg))) + (setf (alist-get 'background-color params) bg)) (x-show-tip (propertize text 'face 'tooltip) (selected-frame) params @@ -286,10 +284,6 @@ is based on the current syntax table." (when (> (point) start) (buffer-substring start (point))))))) -(defmacro tooltip-region-active-p () - "Value is non-nil if the region should override command actions." - `(use-region-p)) - (defun tooltip-expr-to-print (event) "Return an expression that should be printed for EVENT. If a region is active and the mouse is inside the region, print @@ -297,7 +291,7 @@ the region. Otherwise, figure out the identifier around the point where the mouse is." (with-current-buffer (tooltip-event-buffer event) (let ((point (posn-point (event-end event)))) - (if (tooltip-region-active-p) + (if (use-region-p) (when (and (<= (region-beginning) point) (<= point (region-end))) (buffer-substring (region-beginning) (region-end))) (tooltip-identifier-from-point point))))) diff --git a/lisp/type-break.el b/lisp/type-break.el index 58e56214baf..a5a31c9ffd1 100644 --- a/lisp/type-break.el +++ b/lisp/type-break.el @@ -605,8 +605,7 @@ INTERVAL is the full length of an interval (defaults to TIME)." (type-break-time-warning-schedule time 'reset) (type-break-run-at-time (max 1 time) nil 'type-break-alarm) (setq type-break-time-next-break - (type-break-time-sum (or start (current-time)) - (or interval time)))) + (type-break-time-sum start (or interval time)))) (defun type-break-cancel-schedule () (type-break-cancel-time-warning-schedule) @@ -962,19 +961,11 @@ FRAC should be the inverse of the fractional value; for example, a value of (defun type-break-time-difference (a b) (round (float-time (time-subtract b a)))) -;; Return (in a new list the same in structure to that returned by -;; `current-time') the sum of the arguments. Each argument may be a time -;; list or a single integer, a number of seconds. -;; This function keeps the high and low 16 bits of the seconds properly -;; balanced so that the lower value never exceeds 16 bits. Otherwise, when -;; the result is passed to `current-time-string' it will toss some of the -;; "low" bits and format the time incorrectly. +;; Return a time value that is the sum of the time-value arguments. (defun type-break-time-sum (&rest tmlist) - (let ((sum '(0 0 0))) + (let ((sum '(0 0))) (dolist (tem tmlist) - (setq sum (time-add sum (if (integerp tem) - (list (floor tem 65536) (mod tem 65536)) - tem)))) + (setq sum (time-add sum tem))) sum)) (defun type-break-time-stamp (&optional when) diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 6e0c157e39c..920d692d319 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,20 +1,106 @@ -2014-10-20 Glenn Morris <rgm@gnu.org> +2015-01-22 Paul Eggert <eggert@cs.ucla.edu> - * url-vars.el (url-bug-address): Make into an obsolete alias. - * url-http.el (url-http-handle-authentication): - * url-news.el (url-news-fetch-message-id): - Use M-x report-emacs-bug in help messages. + Don't downcase system diagnostics' first letters + * url-dav.el (url-dav-delete-directory, url-dav-delete-file) + (url-dav-directory-files): Keep diagnostics consistent with system's. + +2014-12-12 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * url-http.el (url-http-parse-headers): `gnutls-available-p' is + now always available. + +2014-12-11 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * url-http.el (url-http-parse-headers): Check that + `gnutls-available-p' is defined (bug#19346). + +2014-12-09 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * url-http.el (url-http-parse-headers): Pass the GnuTLS status of + the connection to the caller. + (url-http-parse-headers): When being redirected, make sure we + flush the previous certificate. + +2014-12-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * url-http.el (url-http-activate-callback): Make debug more verbose. + +2014-12-05 Stefan Monnier <monnier@iro.umontreal.ca> + + * url-future.el (url-future-done-p, url-future-completed-p) + (url-future-errored-p, url-future-cancelled-p): + * url-dav.el (url-dav-http-success-p): Use define-inline. + +2014-11-23 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * url-http.el (url-http): Respect `url-request-noninteractive'. + + * url-queue.el (url-queue-start-retrieve): Fetching through + url-queue should always be noninteractive. + + * url-vars.el (url-request-noninteractive): New variable. + +2014-11-14 David Reitter <david.reitter@gmail.com> + + * url-domsuf.el (url-domsuf-parse-file): Read compressed + publicsuffix file if available. + +2014-11-05 Teodor Zlatanov <tzz@lifelogs.com> + + * url-http.el (url-user-agent): New variable, can be function or + string. Suggested by Vibhav Pant <vibhavp@ubuntu.com>. + Add :version. (Bug#16498) + + (url-http-user-agent-string): Use it. + +2014-10-29 Paul Eggert <eggert@cs.ucla.edu> + + Simplify use of current-time and friends. + * url-cache.el (url-cache-prune-cache): + Rename local var to avoid confusion. + * url-util.el (url-get-normalized-date): + Omit unnecessary call to current-time. 2014-10-20 Glenn Morris <rgm@gnu.org> - * Version 24.4 released. + * Merge in all changes up to 24.4 release. + +2014-10-07 Eli Zaretskii <eliz@gnu.org> + + * url-http.el (url-http-create-request): Recheck zlib availability + on windows-nt each time it might be required. (Bug#18650) + +2014-09-28 Ulf Jasper <ulf.jasper@web.de> + + * url-gw.el (url-open-stream): New optional parameter + `gateway-method'. If non-nil use it instead of global variable + `url-gateway-method'. -2014-09-19 Dmitry Gutov <dgutov@yandex.ru> + * url/url-http.el (url-http): New optional parameter + `gateway-method', pass it to `url-http-find-free-connection'. + (url-http-find-free-connection): New optional parameter + gateway-method, pass it to `url-open-stream'. + (url-https-create-secure-wrapper): Do not modify + `url-gateway-method' but explicitly provide 'tls as gateway-method + parameter to `url-https'. + +2014-09-22 Dmitry Gutov <dgutov@yandex.ru> * url.el (url-retrieve-internal): Clarify the docstring. * url-http.el (url-http): Same. (Bug#18116) +2014-08-07 Reuben Thomas <rrt@sc3d.org> + + * url-handlers.el: Remove a comment about VMS, which we no longer + support. + +2014-08-03 Paul Eggert <eggert@cs.ucla.edu> + + Don't mishandle dates in the year 9999 (Bug#18176). + * url-cookie.el (url-cookie-expired-p): Treat out-of-range + expiration dates as if they were far in the future. + 2014-06-26 Leo Liu <sdl.web@gmail.com> * url-http.el (url-http-end-of-headers): Remove duplicate defvar. @@ -23,15 +109,34 @@ (url-insert-file-contents): Condition on url-http-response-status for the HTTP/S specific part. (Bug#17549) -2014-05-09 Michael Albinus <michael.albinus@gmx.de> +2014-05-14 Glenn Morris <rgm@gnu.org> + + * url-util.el (url-make-private-file): Use with-file-modes. + +2014-05-12 Michael Albinus <michael.albinus@gmx.de> * url-handlers.el (url-file-handler-load-in-progress): New defvar. (url-file-handler): Use it, in order to avoid recursive load. -2014-05-01 Glenn Morris <rgm@gnu.org> +2014-05-04 Glenn Morris <rgm@gnu.org> * url-parse.el (url-generic-parse-url): Doc fix (replace `iff'). +2014-04-01 Michael Albinus <michael.albinus@gmx.de> + + * url-tramp.el: New file. + + * url-handlers.el (url-handler-regexp): Add ssh, scp, rsync and telnet. + Add :version. + (url-file-handler): Call `url-tramp-file-handler' if appropriate. + +2014-03-28 Glenn Morris <rgm@gnu.org> + + * url-vars.el (url-bug-address): Make into an obsolete alias. + * url-http.el (url-http-handle-authentication): + * url-news.el (url-news-fetch-message-id): + Use M-x report-emacs-bug in help messages. + 2014-03-26 Juanma Barranquero <lekktu@gmail.com> * url-handlers.el (url-http-parse-response): Add autoload. @@ -86,19 +191,19 @@ 2013-08-12 Lars Magne Ingebrigtsen <larsi@gnus.org> - * url-http.el (url-handle-content-transfer-encoding): Renamed + * url-http.el (url-handle-content-transfer-encoding): Rename `zlib-decompress-gzipped-region' and check whether it's available, too. - (url-handle-content-transfer-encoding): Renamed - `zlib-decompress-region' again. + (url-handle-content-transfer-encoding): + Rename `zlib-decompress-region' again. 2013-08-11 Lars Magne Ingebrigtsen <larsi@gnus.org> * url-vars.el (url-mime-encoding-string): If we have built-in gzip support, say that we accept gzipped content. - * url-http.el (url-handle-content-transfer-encoding): Support - decompressing gzipped content. + * url-http.el (url-handle-content-transfer-encoding): + Support decompressing gzipped content. 2013-07-31 Stefan Monnier <monnier@iro.umontreal.ca> diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el index 2e2db8c1b69..8e9d128b56c 100644 --- a/lisp/url/url-cache.el +++ b/lisp/url/url-cache.el @@ -212,7 +212,7 @@ If `url-standalone-mode' is non-nil, cached items never expire." "Remove all expired files from the cache. `url-cache-expire-time' says how old a file has to be to be considered \"expired\"." - (let ((current-time (current-time)) + (let ((now (current-time)) (total-files 0) (deleted-files 0)) (setq directory (or directory url-cache-directory)) @@ -228,7 +228,7 @@ considered \"expired\"." (time-add (nth 5 (file-attributes file)) (seconds-to-time url-cache-expire-time)) - current-time) + now) (delete-file file) (setq deleted-files (1+ deleted-files)))))) (if (< deleted-files total-files) diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el index b23ab2719f6..a7b3d16d46d 100644 --- a/lisp/url/url-cookie.el +++ b/lisp/url/url-cookie.el @@ -104,9 +104,10 @@ telling Microsoft that." (insert ";; Emacs-W3 HTTP cookies file\n" ";; Automatically generated file!!! DO NOT EDIT!!!\n\n" "(setq url-cookie-storage\n '") - (pp url-cookie-storage (current-buffer)) - (insert ")\n(setq url-cookie-secure-storage\n '") - (pp url-cookie-secure-storage (current-buffer)) + (let ((print-length nil) (print-level nil)) + (pp url-cookie-storage (current-buffer)) + (insert ")\n(setq url-cookie-secure-storage\n '") + (pp url-cookie-secure-storage (current-buffer))) (insert ")\n") (insert " \n;; Local Variables:\n" ";; version-control: never\n" @@ -158,7 +159,9 @@ telling Microsoft that." "Return non-nil if COOKIE is expired." (let ((exp (url-cookie-expires cookie))) (and (> (length exp) 0) - (> (float-time) (float-time (date-to-time exp)))))) + (condition-case () + (> (float-time) (float-time (date-to-time exp))) + (error nil))))) (defun url-cookie-retrieve (host &optional localpart secure) "Retrieve all cookies for a specified HOST and LOCALPART." diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el index 01cffcb3e54..61ca0885ec5 100644 --- a/lisp/url/url-dav.el +++ b/lisp/url/url-dav.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2001, 2004-2015 Free Software Foundation, Inc. ;; Author: Bill Perry <wmperry@gnu.org> -;; Maintainer: Bill Perry <wmperry@gnu.org> +;; Maintainer: emacs-devel@gnu.org ;; Keywords: url, vc ;; This file is part of GNU Emacs. @@ -479,9 +479,9 @@ names (ie: DAV:resourcetype)." " <DAV:allprop/>") depth nil namespaces)) -(defmacro url-dav-http-success-p (status) +(define-inline url-dav-http-success-p (status) "Return whether STATUS was the result of a successful DAV request." - `(= (/ (or ,status 500) 100) 2)) + (inline-quote (= (/ (or ,status 500) 100) 2))) ;;; Locking support @@ -741,7 +741,7 @@ files in the collection as well." (if (and (not recursive) (/= (length props) 1)) (signal 'file-error (list "Removing directory" - "directory not empty" url))))) + "Directory not empty" url))))) (mapc (lambda (result) (setq status (plist-get (cdr result) 'DAV:status)) @@ -760,7 +760,7 @@ files in the collection as well." url lock-token (setq props (url-dav-get-properties url)) (if (eq (plist-get (cdar props) 'DAV:resourcetype) 'DAV:collection) - (signal 'file-error (list "Removing old name" "is a collection" url))))) + (signal 'file-error (list "Removing old name" "Is a collection" url))))) (mapc (lambda (result) (setq status (plist-get (cdr result) 'DAV:status)) @@ -787,7 +787,7 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable. (when (and (= (length properties) 1) (not (url-dav-file-directory-p url))) - (signal 'file-error (list "Opening directory" "not a directory" url))) + (signal 'file-error (list "Opening directory" "Not a directory" url))) (while properties (setq child-props (pop properties) diff --git a/lisp/url/url-domsuf.el b/lisp/url/url-domsuf.el index a301159630a..97c07590edb 100644 --- a/lisp/url/url-domsuf.el +++ b/lisp/url/url-domsuf.el @@ -32,8 +32,12 @@ (defun url-domsuf-parse-file () (with-temp-buffer - (insert-file-contents - (expand-file-name "publicsuffix.txt" data-directory)) + (with-auto-compression-mode + (insert-file-contents + (let* ((suffixfile (expand-file-name "publicsuffix.txt" data-directory)) + (compressed-file (concat suffixfile ".gz"))) + (or (and (file-readable-p compressed-file) compressed-file) + suffixfile)))) (let ((domains nil) domain exception) (while (not (eobp)) diff --git a/lisp/url/url-future.el b/lisp/url/url-future.el index bca3e50756a..f611c817231 100644 --- a/lisp/url/url-future.el +++ b/lisp/url/url-future.el @@ -44,17 +44,17 @@ (cl-defstruct url-future callback errorback status value) -(defmacro url-future-done-p (url-future) - `(url-future-status ,url-future)) +(define-inline url-future-done-p (url-future) + (inline-quote (url-future-status ,url-future))) -(defmacro url-future-completed-p (url-future) - `(eq (url-future-status ,url-future) t)) +(define-inline url-future-completed-p (url-future) + (inline-quote (eq (url-future-status ,url-future) t))) -(defmacro url-future-errored-p (url-future) - `(eq (url-future-status ,url-future) 'error)) +(define-inline url-future-errored-p (url-future) + (inline-quote (eq (url-future-status ,url-future) 'error))) -(defmacro url-future-cancelled-p (url-future) - `(eq (url-future-status ,url-future) 'cancel)) +(define-inline url-future-cancelled-p (url-future) + (inline-quote (eq (url-future-status ,url-future) 'cancel))) (defun url-future-finish (url-future &optional status) (if (url-future-done-p url-future) diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el index 2fcd355d7cb..cc0e4f8f8d6 100644 --- a/lisp/url/url-gw.el +++ b/lisp/url/url-gw.el @@ -3,6 +3,7 @@ ;; Copyright (C) 1997-1998, 2004-2015 Free Software Foundation, Inc. ;; Author: Bill Perry <wmperry@gnu.org> +;; Maintainer: emacs-devel@gnu.org ;; Keywords: comm, data, processes ;; This file is part of GNU Emacs. @@ -202,20 +203,24 @@ linked Emacs under SunOS 4.x." proc))) ;;;###autoload -(defun url-open-stream (name buffer host service) +(defun url-open-stream (name buffer host service &optional gateway-method) "Open a stream to HOST, possibly via a gateway. Args per `open-network-stream'. Will not make a connection if `url-gateway-unplugged' is non-nil. -Might do a non-blocking connection; use `process-status' to check." +Might do a non-blocking connection; use `process-status' to check. + +Optional arg GATEWAY-METHOD specifies the gateway to be used, +overriding the value of `url-gateway-method'." (unless url-gateway-unplugged - (let ((gw-method (if (and url-gateway-local-host-regexp - (not (eq 'tls url-gateway-method)) - (not (eq 'ssl url-gateway-method)) - (string-match - url-gateway-local-host-regexp - host)) - 'native - url-gateway-method)) + (let* ((gwm (or gateway-method url-gateway-method)) + (gw-method (if (and url-gateway-local-host-regexp + (not (eq 'tls gwm)) + (not (eq 'ssl gwm)) + (string-match + url-gateway-local-host-regexp + host)) + 'native + gwm)) ;; An attempt to deal with denied connections, and attempt ;; to reconnect (cur-retries 0) diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index 9c16cffd4af..23006e1e087 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -51,7 +51,7 @@ ;; delete-directory Finished (DAV) ;; delete-file Finished (DAV) ;; diff-latest-backup-file -;; directory-file-name unnecessary (what about VMS)? +;; directory-file-name unnecessary ;; directory-files Finished (DAV) ;; dired-call-process ;; dired-compress-file @@ -111,7 +111,7 @@ the mode if ARG is omitted or nil." (push (cons url-handler-regexp 'url-file-handler) file-name-handler-alist))) -(defcustom url-handler-regexp "\\`\\(https?\\|ftp\\|file\\|nfs\\)://" +(defcustom url-handler-regexp "\\`\\(https?\\|ftp\\|file\\|nfs\\|ssh\\|scp\\|rsync\\|telnet\\)://" "Regular expression for URLs handled by `url-handler-mode'. When URL Handler mode is enabled, this regular expression is added to `file-name-handler-alist'. @@ -122,6 +122,7 @@ regular expression avoids conflicts with local files that look like URLs \(Gnus is particularly bad at this\)." :group 'url :type 'regexp + :version "25.1" :set (lambda (symbol value) (let ((enable url-handler-mode)) (url-handler-mode 0) @@ -147,21 +148,30 @@ the arguments that would have been passed to OPERATION." ;; Avoid recursive load. (if (and load-in-progress url-file-handler-load-in-progress) (url-run-real-handler operation args) - (let ((url-file-handler-load-in-progress load-in-progress) - (fn (get operation 'url-file-handlers)) - (val nil) - (hooked nil)) - (if (and (not fn) (intern-soft (format "url-%s" operation)) - (fboundp (intern-soft (format "url-%s" operation)))) - (error "Missing URL handler mapping for %s" operation)) - (if fn - (setq hooked t - val (save-match-data (apply fn args))) - (setq hooked nil - val (url-run-real-handler operation args))) - (url-debug 'handlers "%s %S%S => %S" (if hooked "Hooked" "Real") - operation args val) - val))) + (let ((url-file-handler-load-in-progress load-in-progress)) + ;; Check, whether there are arguments we want pass to Tramp. + (if (catch :do + (dolist (url (cons default-directory args)) + (and (member + (url-type (url-generic-parse-url (and (stringp url) url))) + url-tramp-protocols) + (throw :do t)))) + (apply 'url-tramp-file-handler operation args) + ;; Otherwise, let's do the job. + (let ((fn (get operation 'url-file-handlers)) + (val nil) + (hooked nil)) + (if (and (not fn) (intern-soft (format "url-%s" operation)) + (fboundp (intern-soft (format "url-%s" operation)))) + (error "Missing URL handler mapping for %s" operation)) + (if fn + (setq hooked t + val (save-match-data (apply fn args))) + (setq hooked nil + val (url-run-real-handler operation args))) + (url-debug 'handlers "%s %S%S => %S" (if hooked "Hooked" "Real") + operation args val) + val))))) (defun url-file-handler-identity (&rest args) ;; Identity function diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 680097ab86f..d766952ebf3 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -3,6 +3,7 @@ ;; Copyright (C) 1999, 2001, 2004-2015 Free Software Foundation, Inc. ;; Author: Bill Perry <wmperry@gnu.org> +;; Maintainer: emacs-devel@gnu.org ;; Keywords: comm, data, processes ;; This file is part of GNU Emacs. @@ -24,7 +25,9 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) +(eval-when-compile + (require 'cl-lib) + (require 'subr-x)) (defvar url-callback-arguments) (defvar url-callback-function) @@ -39,6 +42,7 @@ (defvar url-http-data) (defvar url-http-end-of-headers) (defvar url-http-extra-headers) +(defvar url-http-noninteractive) (defvar url-http-method) (defvar url-http-no-retry) (defvar url-http-process) @@ -131,6 +135,17 @@ request.") (507 insufficient-storage "Insufficient storage")) "The HTTP return codes and their text.") +(defcustom url-user-agent (format "User-Agent: %sURL/%s\r\n" + (if url-package-name + (concat url-package-name "/" + url-package-version " ") + "") url-version) + "User Agent used by the URL package." + :type '(choice (string :tag "A static User-Agent string") + (function :tag "Call a function to get the User-Agent string")) + :version "25.1" + :group 'url) + ;(eval-when-compile ;; These are all macros so that they are hidden from external sight ;; when the file is byte-compiled. @@ -170,7 +185,7 @@ request.") url-http-open-connections)) nil) -(defun url-http-find-free-connection (host port) +(defun url-http-find-free-connection (host port &optional gateway-method) (let ((conns (gethash (cons host port) url-http-open-connections)) (connection nil)) (while (and conns (not connection)) @@ -192,7 +207,7 @@ request.") ;; `url-open-stream' needs a buffer in which to do things ;; like authentication. But we use another buffer afterwards. (unwind-protect - (let ((proc (url-open-stream host buf host port))) + (let ((proc (url-open-stream host buf host port gateway-method))) ;; url-open-stream might return nil. (when (processp proc) ;; Drop the temp buffer link before killing the buffer. @@ -213,11 +228,9 @@ request.") (and (listp url-privacy-level) (memq 'agent url-privacy-level))) "" - (format "User-Agent: %sURL/%s\r\n" - (if url-package-name - (concat url-package-name "/" url-package-version " ") - "") - url-version))) + (if (functionp url-user-agent) + (funcall url-user-agent) + url-user-agent))) (defun url-http-create-request (&optional ref-url) "Create an HTTP request for `url-http-target-url', referred to by REF-URL." @@ -312,7 +325,14 @@ request.") (concat "From: " url-personal-mail-address "\r\n")) ;; Encodings we understand - (if url-mime-encoding-string + (if (or url-mime-encoding-string + ;; MS-Windows loads zlib dynamically, so recheck + ;; in case they made it available since + ;; initialization in url-vars.el. + (and (eq 'system-type 'windows-nt) + (fboundp 'zlib-available-p) + (zlib-available-p) + (setq url-mime-encoding-string "gzip"))) (concat "Accept-encoding: " url-mime-encoding-string "\r\n")) (if url-mime-charset-string @@ -474,7 +494,14 @@ should be shown to the user." (url-http-mark-connection-as-free (url-host url-current-object) (url-port url-current-object) url-http-process) - + ;; Pass the https certificate on to the caller. + (when (gnutls-available-p) + (let ((status (gnutls-peer-status url-http-process))) + (when (or status + (plist-get (car url-callback-arguments) :peer)) + (setcar url-callback-arguments + (plist-put (car url-callback-arguments) + :peer status))))) (if (or (not (boundp 'url-http-end-of-headers)) (not url-http-end-of-headers)) (error "Trying to parse headers in odd buffer: %s" (buffer-name))) @@ -874,7 +901,8 @@ should be shown to the user." (url-http-mark-connection-as-free (url-host url-current-object) (url-port url-current-object) url-http-process) - (url-http-debug "Activating callback in buffer (%s)" (buffer-name)) + (url-http-debug "Activating callback in buffer (%s): %S %S" + (buffer-name) url-callback-function url-callback-arguments) (apply url-callback-function url-callback-arguments)) ;; ) @@ -1166,7 +1194,7 @@ the end of the document." (when (eq process-buffer (current-buffer)) (goto-char (point-max))))) -(defun url-http (url callback cbargs &optional retry-buffer) +(defun url-http (url callback cbargs &optional retry-buffer gateway-method) "Retrieve URL via HTTP asynchronously. URL must be a parsed URL. See `url-generic-parse-url' for details. @@ -1177,11 +1205,17 @@ request, as described in the docstring of `url-retrieve' (if in doubt, specify nil). Optional arg RETRY-BUFFER, if non-nil, specifies the buffer of a -previous `url-http' call, which is being re-attempted." +previous `url-http' call, which is being re-attempted. + +Optional arg GATEWAY-METHOD specifies the gateway to be used, +overriding the value of `url-gateway-method'." (cl-check-type url vector "Need a pre-parsed URL.") (let* ((host (url-host (or url-using-proxy url))) (port (url-port (or url-using-proxy url))) - (connection (url-http-find-free-connection host port)) + (nsm-noninteractive (or url-request-noninteractive + (and (boundp 'url-http-noninteractive) + url-http-noninteractive))) + (connection (url-http-find-free-connection host port gateway-method)) (buffer (or retry-buffer (generate-new-buffer (format " *http %s:%d*" host port))))) @@ -1212,6 +1246,7 @@ previous `url-http' call, which is being re-attempted." url-http-process url-http-method url-http-extra-headers + url-http-noninteractive url-http-data url-http-target-url url-http-no-retry @@ -1221,6 +1256,7 @@ previous `url-http' call, which is being re-attempted." (setq url-http-method (or url-request-method "GET") url-http-extra-headers url-request-extra-headers + url-http-noninteractive url-request-noninteractive url-http-data url-request-data url-http-process connection url-http-chunked-length nil @@ -1439,9 +1475,8 @@ p3p (defmacro url-https-create-secure-wrapper (method args) `(defun ,(intern (format (if method "url-https-%s" "url-https") method)) ,args ,(format "HTTPS wrapper around `%s' call." (or method "url-http")) - (let ((url-gateway-method 'tls)) - (,(intern (format (if method "url-http-%s" "url-http") method)) - ,@(remove '&rest (remove '&optional args)))))) + (,(intern (format (if method "url-http-%s" "url-http") method)) + ,@(remove '&rest (remove '&optional (append args (if method nil '(nil 'tls)))))))) ;;;###autoload (autoload 'url-https "url-http") (url-https-create-secure-wrapper nil (url callback cbargs)) diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el index cc69d8324ea..c667cb932d5 100644 --- a/lisp/url/url-queue.el +++ b/lisp/url/url-queue.el @@ -133,10 +133,11 @@ The variable `url-queue-timeout' sets a timeout." (defun url-queue-start-retrieve (job) (setf (url-queue-buffer job) (ignore-errors - (url-retrieve (url-queue-url job) - #'url-queue-callback-function (list job) - (url-queue-silentp job) - (url-queue-inhibit-cookiesp job))))) + (let ((url-request-noninteractive t)) + (url-retrieve (url-queue-url job) + #'url-queue-callback-function (list job) + (url-queue-silentp job) + (url-queue-inhibit-cookiesp job)))))) (defun url-queue-prune-old-entries () (let (dead-jobs) diff --git a/lisp/url/url-tramp.el b/lisp/url/url-tramp.el new file mode 100644 index 00000000000..d0b1a5c3420 --- /dev/null +++ b/lisp/url/url-tramp.el @@ -0,0 +1,79 @@ +;;; url-tramp.el --- file-name-handler magic invoking Tramp for some protocols + +;; Copyright (C) 2014-2015 Free Software Foundation, Inc. + +;; Author: Michael Albinus <michael.albinus@gmx.de> +;; Keywords: comm, data, processes, hypermedia + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'url-parse) +(require 'tramp) +(require 'password-cache) + +;;;###autoload +(defcustom url-tramp-protocols '("ftp" "ssh" "scp" "rsync" "telnet") + "List of URL protocols the work is handled by Tramp. +They must also be covered by `url-handler-regexp'." + :group 'url + :version "25.1" + :type '(list string)) + +(defun url-tramp-convert-url-to-tramp (url) + "Convert URL to a Tramp file name." + (let ((obj (url-generic-parse-url (and (stringp url) url)))) + (if (member (url-type obj) url-tramp-protocols) + (progn + (if (url-password obj) + (password-cache-add + (tramp-make-tramp-file-name + (url-type obj) (url-user obj) (url-host obj) "") + (url-password obj)) + (tramp-make-tramp-file-name + (url-type obj) (url-user obj) (url-host obj) (url-filename obj)))) + url))) + +(defun url-tramp-convert-tramp-to-url (file) + "Convert FILE, a Tramp file name, to a URL." + (let ((obj (ignore-errors (tramp-dissect-file-name file)))) + (if (member (tramp-file-name-method obj) url-tramp-protocols) + (url-recreate-url + (url-parse-make-urlobj + (tramp-file-name-method obj) + (tramp-file-name-user obj) + nil ; password. + (tramp-file-name-host obj) + nil ; port. + (tramp-file-name-localname obj) + nil nil t)) ; target attributes fullness. + file))) + +;;;###autoload +(defun url-tramp-file-handler (operation &rest args) + "Function called from the `file-name-handler-alist' routines. +OPERATION is what needs to be done. ARGS are the arguments that +would have been passed to OPERATION." + (let ((default-directory (url-tramp-convert-url-to-tramp default-directory)) + (args (mapcar 'url-tramp-convert-url-to-tramp args))) + (url-tramp-convert-tramp-to-url (apply operation args)))) + +(provide 'url-tramp) + +;;; url-tramp.el ends here diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index 0011e9960f5..13b97744131 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -4,6 +4,7 @@ ;; Inc. ;; Author: Bill Perry <wmperry@gnu.org> +;; Maintainer: emacs-devel@gnu.org ;; Keywords: comm, data, processes ;; This file is part of GNU Emacs. @@ -189,8 +190,7 @@ Will not do anything if `url-show-status' is nil." (defun url-get-normalized-date (&optional specified-time) "Return a 'real' date string that most HTTP servers can understand." (let ((system-time-locale "C")) - (format-time-string "%a, %d %b %Y %T GMT" - (or specified-time (current-time)) t))) + (format-time-string "%a, %d %b %Y %T GMT" specified-time t))) ;;;###autoload (defun url-eat-trailing-space (x) @@ -628,14 +628,9 @@ Creates FILE and its parent directories if they do not exist." (make-directory dir t))) ;; Based on doc-view-make-safe-dir. (condition-case nil - (let ((umask (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes #o0600) - (with-temp-buffer - (write-region (point-min) (point-max) - file nil 'silent nil 'excl))) - (set-default-file-modes umask))) + (with-file-modes #o0600 + (with-temp-buffer + (write-region (point-min) (point-max) file nil 'silent nil 'excl))) (file-already-exists (if (file-symlink-p file) (error "Danger: `%s' is a symbolic link" file)) diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index c55a98b173e..7e752776ba9 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -210,6 +210,9 @@ document." "A list of extra headers to send with the next request. Should be an assoc list of headers/contents.") +(defvar url-request-noninteractive nil + "If non-nil, the request is done in a noninteractive context.") + (defvar url-request-method nil "The method to use for the next request.") (defvar url-mime-encoding-string (and (fboundp 'zlib-available-p) diff --git a/lisp/url/url.el b/lisp/url/url.el index 370cead2b73..095637765a3 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el @@ -4,6 +4,7 @@ ;; Inc. ;; Author: Bill Perry <wmperry@gnu.org> +;; Maintainer: emacs-devel@gnu.org ;; Keywords: comm, data, processes, hypermedia ;; This file is part of GNU Emacs. diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index 84ae389697c..eb7e5bfdfad 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -1097,12 +1097,17 @@ file were isearch was started." (ignore-errors (version< (substring b (length name)) (substring a (length name)))))))) - (files (if isearch-forward files (reverse files)))) - (find-file-noselect - (if wrap - (car files) - (cadr (member (file-name-nondirectory (buffer-file-name buffer)) - files)))))) + (files (if isearch-forward files (reverse files))) + (file (if wrap + (car files) + (cadr (member (file-name-nondirectory (buffer-file-name buffer)) + files))))) + ;; If there are no files that match the default pattern ChangeLog.[0-9], + ;; return the current buffer to force isearch wrapping to its beginning. + ;; If file is nil, multi-isearch-search-fun will signal "end of multi". + (if (file-exists-p file) + (find-file-noselect file) + (current-buffer)))) (defun change-log-fill-forward-paragraph (n) "Cut paragraphs so filling preserves open parentheses at beginning of lines." diff --git a/lisp/vc/compare-w.el b/lisp/vc/compare-w.el index 2ba142933f3..07c07682186 100644 --- a/lisp/vc/compare-w.el +++ b/lisp/vc/compare-w.el @@ -30,6 +30,8 @@ ;;; Code: +(require 'diff-mode) ; For diff faces. + (defgroup compare-windows nil "Compare text between windows." :prefix "compare-" @@ -128,11 +130,19 @@ out all highlighting later with the command `compare-windows-dehighlight'." :group 'compare-windows :version "22.1") -(defface compare-windows - '((t :inherit lazy-highlight)) - "Face for highlighting of compare-windows difference regions." +(defface compare-windows-removed + '((t :inherit diff-removed)) + "Face for highlighting of compare-windows removed regions." :group 'compare-windows - :version "22.1") + :version "25.1") + +(defface compare-windows-added + '((t :inherit diff-added)) + "Face for highlighting of compare-windows added regions." + :group 'compare-windows + :version "25.1") + +(define-obsolete-face-alias 'compare-windows 'compare-windows-added "25.1") (defvar compare-windows-overlay1 nil) (defvar compare-windows-overlay2 nil) @@ -140,9 +150,44 @@ out all highlighting later with the command `compare-windows-dehighlight'." (defvar compare-windows-overlays2 nil) (defvar compare-windows-sync-point nil) +(defcustom compare-windows-get-window-function 'compare-windows-get-recent-window + "Function that provides the window to compare with." + :type '(choice + (function-item :tag "Most recently used window" + compare-windows-get-recent-window) + (function-item :tag "Next window" + compare-windows-get-next-window) + (function :tag "Your function")) + :group 'compare-windows + :version "25.0") + +(defun compare-windows-get-recent-window () + "Return the most recently used window. +First try to get the most recently used window on a visible frame, +then try to get a window on an iconified frame, and finally +consider all existing frames." + (or (get-mru-window 'visible t t) + (get-mru-window 0 t t) + (get-mru-window t t t) + (error "No other window"))) + +(defun compare-windows-get-next-window () + "Return the window next in the cyclic ordering of windows. +In the selected frame contains only one window, consider windows +on all visible frames." + (let ((w2 (next-window))) + (if (eq w2 (selected-window)) + (setq w2 (next-window (selected-window) nil 'visible))) + (if (eq w2 (selected-window)) + (error "No other window")) + w2)) + ;;;###autoload (defun compare-windows (ignore-whitespace) - "Compare text in current window with text in next window. + "Compare text in current window with text in another window. +The option `compare-windows-get-window-function' defines how +to get another window. + Compares the text starting at point in each window, moving over text in each one as far as they match. @@ -179,11 +224,7 @@ on third call it again advances points to the next difference and so on." 'compare-windows-sync-regexp compare-windows-sync))) (setq p1 (point) b1 (current-buffer)) - (setq w2 (next-window)) - (if (eq w2 (selected-window)) - (setq w2 (next-window (selected-window) nil 'visible))) - (if (eq w2 (selected-window)) - (error "No other window")) + (setq w2 (funcall compare-windows-get-window-function)) (setq p2 (window-point w2) b2 (window-buffer w2)) (setq opoint2 p2) @@ -212,7 +253,7 @@ on third call it again advances points to the next difference and so on." ;; optionally skip over it. (and skip-func-1 (save-excursion - (let (p1a p2a w1 w2 result1 result2) + (let (p1a p2a result1 result2) (setq result1 (funcall skip-func-1 opoint1)) (setq p1a (point)) (set-buffer b2) @@ -255,12 +296,15 @@ on third call it again advances points to the next difference and so on." (recenter (car compare-windows-recenter)) (with-selected-window w2 (recenter (cadr compare-windows-recenter)))) ;; If points are still not synchronized, then ding - (when (and (= p1 opoint1) (= p2 opoint2)) - ;; Display error message when current points in two windows - ;; are unmatched and next matching points can't be found. - (compare-windows-dehighlight) - (ding) - (message "No more matching points")))))) + (if (and (= p1 opoint1) (= p2 opoint2)) + (progn + ;; Display error message when current points in two windows + ;; are unmatched and next matching points can't be found. + (compare-windows-dehighlight) + (ding) + (message "No more matches with %s" b2)) + (message "Diff -%s,%s +%s,%s with %s" opoint2 p2 opoint1 p1 b2))) + (message "Match -%s,%s +%s,%s with %s" opoint2 p2 opoint1 p1 b2)))) ;; Move forward over whatever might be called whitespace. ;; compare-windows-whitespace is a regexp that matches whitespace. @@ -303,7 +347,7 @@ on third call it again advances points to the next difference and so on." (defun compare-windows-sync-default-function () (if (not compare-windows-sync-point) (let* ((w1 (selected-window)) - (w2 (next-window w1)) + (w2 (funcall compare-windows-get-window-function)) (b2 (window-buffer w2)) (point-max2 (with-current-buffer b2 (point-max))) (op2 (window-point w2)) @@ -360,13 +404,13 @@ on third call it again advances points to the next difference and so on." (if compare-windows-overlay1 (move-overlay compare-windows-overlay1 beg1 end1 b1) (setq compare-windows-overlay1 (make-overlay beg1 end1 b1)) - (overlay-put compare-windows-overlay1 'face 'compare-windows) + (overlay-put compare-windows-overlay1 'face 'compare-windows-added) (overlay-put compare-windows-overlay1 'priority 1000)) (overlay-put compare-windows-overlay1 'window w1) (if compare-windows-overlay2 (move-overlay compare-windows-overlay2 beg2 end2 b2) (setq compare-windows-overlay2 (make-overlay beg2 end2 b2)) - (overlay-put compare-windows-overlay2 'face 'compare-windows) + (overlay-put compare-windows-overlay2 'face 'compare-windows-removed) (overlay-put compare-windows-overlay2 'priority 1000)) (overlay-put compare-windows-overlay2 'window w2) (if (not (eq compare-windows-highlight 'persistent)) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 2bf04fc131d..a9614e95d6d 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -302,14 +302,9 @@ well." (defvar diff-added-face 'diff-added) (defface diff-changed - ;; We normally apply a `shadow'-based face on the `diff-context' - ;; face, and keep `diff-changed' the default. - '((((class color grayscale) (min-colors 88))) - ;; If the terminal lacks sufficient colors for shadowing, - ;; highlight changed lines explicitly. - (((class color)) - :foreground "yellow")) + '((t nil)) "`diff-mode' face used to highlight changed lines." + :version "25.1" :group 'diff-mode) (define-obsolete-face-alias 'diff-changed-face 'diff-changed "22.1") (defvar diff-changed-face 'diff-changed) @@ -343,8 +338,12 @@ well." (defvar diff-function-face 'diff-function) (defface diff-context - '((((class color grayscale) (min-colors 88)) :inherit shadow)) + '((((class color grayscale) (min-colors 88) (background light)) + :foreground "#333333") + (((class color grayscale) (min-colors 88) (background dark)) + :foreground "#dddddd")) "`diff-mode' face used to highlight context and other side-information." + :version "25.1" :group 'diff-mode) (define-obsolete-face-alias 'diff-context-face 'diff-context "22.1") (defvar diff-context-face 'diff-context) @@ -1221,6 +1220,9 @@ else cover the whole buffer." (?- (cl-incf minus)) (?! (cl-incf bang)) ((or ?\\ ?#) nil) + (?\n (if diff-valid-unified-empty-line + (cl-incf space) + (setq space 0 plus 0 minus 0 bang 0))) (_ (setq space 0 plus 0 minus 0 bang 0))) (cond ((looking-at diff-hunk-header-re-unified) @@ -1815,6 +1817,16 @@ With a prefix argument, try to REVERSE the hunk." (diff-hunk-status-msg line-offset (diff-xor reverse switched) t))) +(defun diff-kill-applied-hunks () + "Kill all hunks that have already been applied starting at point." + (interactive) + (while (not (eobp)) + (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched) + (diff-find-source-location nil nil))) + (if (and line-offset switched) + (diff-hunk-kill) + (diff-hunk-next))))) + (defalias 'diff-mouse-goto-source 'diff-goto-source) (defun diff-goto-source (&optional other-file event) diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index a0507851501..d6b538cff2b 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -24,6 +24,8 @@ ;;; Code: +(require 'cl-lib) + ;; Start compiler pacifier (defvar ediff-metajob-name) (defvar ediff-meta-buffer) @@ -118,11 +120,8 @@ It needs to be killed when we quit the session.") (?C . ediff-buffer-C))) ;;; Macros -(defmacro ediff-odd-p (arg) - `(eq (logand ,arg 1) 1)) - -(defmacro ediff-buffer-live-p (buf) - `(and ,buf (get-buffer ,buf) (buffer-name (get-buffer ,buf)))) +(defsubst ediff-buffer-live-p (buf) + (and buf (get-buffer buf) (buffer-name (get-buffer buf)))) (defmacro ediff-get-buffer (arg) `(cond ((eq ,arg 'A) ediff-buffer-A) @@ -949,7 +948,9 @@ this variable represents.") (defface ediff-current-diff-Ancestor (if (featurep 'emacs) - '((((class color) (min-colors 16)) + '((((class color) (min-colors 88)) + (:background "VioletRed")) + (((class color) (min-colors 16)) (:foreground "Black" :background "VioletRed")) (((class color)) (:foreground "black" :background "magenta3")) @@ -1057,7 +1058,9 @@ this variable represents.") (defface ediff-fine-diff-Ancestor (if (featurep 'emacs) - '((((class color) (min-colors 16)) + '((((class color) (min-colors 88)) + (:background "Green")) + (((class color) (min-colors 16)) (:foreground "Black" :background "Green")) (((class color)) (:foreground "red3" :background "green")) @@ -1091,6 +1094,8 @@ this variable represents.") (if (featurep 'emacs) `((((type pc)) (:foreground "green3" :background "light grey")) + (((class color) (min-colors 88)) + (:background "light grey")) (((class color) (min-colors 16)) (:foreground "Black" :background "light grey")) (((class color)) @@ -1115,7 +1120,9 @@ this variable represents.") (defface ediff-even-diff-B (if (featurep 'emacs) - `((((class color) (min-colors 16)) + `((((class color) (min-colors 88)) + (:background "Grey")) + (((class color) (min-colors 16)) (:foreground "White" :background "Grey")) (((class color)) (:foreground "blue3" :background "Grey" :weight bold)) @@ -1138,6 +1145,8 @@ this variable represents.") (if (featurep 'emacs) `((((type pc)) (:foreground "yellow3" :background "light grey")) + (((class color) (min-colors 88)) + (:background "light grey")) (((class color) (min-colors 16)) (:foreground "Black" :background "light grey")) (((class color)) @@ -1164,6 +1173,8 @@ this variable represents.") (if (featurep 'emacs) `((((type pc)) (:foreground "cyan3" :background "light grey")) + (((class color) (min-colors 88)) + (:background "Grey")) (((class color) (min-colors 16)) (:foreground "White" :background "Grey")) (((class color)) @@ -1197,6 +1208,8 @@ this variable represents.") (if (featurep 'emacs) '((((type pc)) (:foreground "green3" :background "gray40")) + (((class color) (min-colors 88)) + (:background "Grey")) (((class color) (min-colors 16)) (:foreground "White" :background "Grey")) (((class color)) @@ -1222,6 +1235,8 @@ this variable represents.") (if (featurep 'emacs) '((((type pc)) (:foreground "White" :background "gray40")) + (((class color) (min-colors 88)) + (:background "light grey")) (((class color) (min-colors 16)) (:foreground "Black" :background "light grey")) (((class color)) @@ -1246,6 +1261,8 @@ this variable represents.") (if (featurep 'emacs) '((((type pc)) (:foreground "yellow3" :background "gray40")) + (((class color) (min-colors 88)) + (:background "Grey")) (((class color) (min-colors 16)) (:foreground "White" :background "Grey")) (((class color)) @@ -1268,7 +1285,9 @@ this variable represents.") (defface ediff-odd-diff-Ancestor (if (featurep 'emacs) - '((((class color) (min-colors 16)) + '((((class color) (min-colors 88)) + (:background "gray40")) + (((class color) (min-colors 16)) (:foreground "cyan3" :background "gray40")) (((class color)) (:foreground "green3" :background "black" :weight bold)) @@ -1326,7 +1345,7 @@ this variable represents.") (ediff-defvar-local ediff-current-diff-overlay-Ancestor nil "Overlay for the current difference region in the ancestor buffer.") -(defvar ediff-toggle-read-only-function 'toggle-read-only +(defvar ediff-toggle-read-only-function 'read-only-mode "Function to be used to toggle read-only status of the buffer. If nil, Ediff tries using the command bound to C-x C-q.") @@ -1436,7 +1455,7 @@ This default should work without changes." ;; The value of dif-num is always 1- the one that user sees. ;; This is why even face is used when dif-num is odd. (ediff-get-symbol-from-alist - buf-type (if (ediff-odd-p dif-num) + buf-type (if (cl-oddp dif-num) ediff-even-diff-face-alist ediff-odd-diff-face-alist) )) diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index e15f4c88271..62a0d9da0ab 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -1027,8 +1027,8 @@ of the current buffer." (file-writable-p file))) (toggle-ro-cmd (cond (ediff-toggle-read-only-function) ((ediff-file-checked-out-p file) - 'toggle-read-only) - (file-writable 'toggle-read-only) + 'read-only-mode) + (file-writable 'read-only-mode) (t (key-binding "\C-x\C-q"))))) ;; If the file is checked in, make sure we don't make buffer modifiable ;; without warning the user. The user can fool our checks by making the @@ -1039,7 +1039,7 @@ of the current buffer." ;; non-interactively, in which case don't ask questions ctl-buf) (cond ((not buffer-read-only) - (setq toggle-ro-cmd 'toggle-read-only)) + (setq toggle-ro-cmd 'read-only-mode)) ((and (or (beep 1) t) ; always beep (y-or-n-p (format @@ -1054,13 +1054,13 @@ of the current buffer." (ediff-change-saved-variable 'buffer-read-only nil buf-type))) (t - (setq toggle-ro-cmd 'toggle-read-only) + (setq toggle-ro-cmd 'read-only-mode) (beep 1) (beep 1) (message "Boy, this is risky! Don't modify this file...") (sit-for 3)))) ; let the user see the warning (if (and toggle-ro-cmd - (string-match "toggle-read-only" (symbol-name toggle-ro-cmd))) + (string-match "read-only-mode" (symbol-name toggle-ro-cmd))) (save-excursion (save-window-excursion (select-window (ediff-get-visible-buffer-window buf)) diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el index d4638616dd7..b17d11d34a4 100644 --- a/lisp/vc/emerge.el +++ b/lisp/vc/emerge.el @@ -2883,17 +2883,11 @@ keymap. Leaves merge in fast mode." (setq vars (cdr vars)) (setq values (cdr values)))) -;; Make a temporary file that only we have access to. -;; PREFIX is appended to emerge-temp-file-prefix to make the filename prefix. +;; When the pointless option emerge-temp-file-prefix goes, +;; make this function obsolete too, and just use make-temp-file. (defun emerge-make-temp-file (prefix) - (let (f (old-modes (default-file-modes))) - (unwind-protect - (progn - ;; This has no effect, since make-temp-file sets umask = 700. - (set-default-file-modes emerge-temp-file-mode) - (setq f (make-temp-file (concat emerge-temp-file-prefix prefix)))) - (set-default-file-modes old-modes)) - f)) + "Make a private temporary file based on `emerge-temp-file-prefix'." + (make-temp-file (concat emerge-temp-file-prefix prefix))) ;;; Functions that query the user before he can write out the current buffer. diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 55476566849..9f9224c226c 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -1132,6 +1132,19 @@ repeating the command will highlight other two parts." (unless smerge-use-changed-face '((smerge . refine) (face . smerge-refined-added)))))) +(defun smerge-swap () + "Swap the \"Mine\" and the \"Other\" chunks. +Can be used before things like `smerge-keep-all' or `smerge-resolve' where the +ordering can have some subtle influence on the result, such as preferring the +spacing of the \"Other\" chunk." + (interactive) + (smerge-match-conflict) + (goto-char (match-beginning 3)) + (let ((txt3 (delete-and-extract-region (point) (match-end 3)))) + (insert (delete-and-extract-region (match-beginning 1) (match-end 1))) + (goto-char (match-beginning 1)) + (insert txt3))) + (defun smerge-diff (n1 n2) (smerge-match-conflict) (smerge-ensure-match n1) diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el index 0eefaaf9e66..8bcea5f164d 100644 --- a/lisp/vc/vc-annotate.el +++ b/lisp/vc/vc-annotate.el @@ -40,6 +40,29 @@ :value "20.5")) :group 'vc) +(defcustom vc-annotate-background-mode + (not (or (eq (or frame-background-mode + (frame-parameter nil 'background-mode)) + 'dark) + (and (tty-display-color-p) (<= (display-color-cells) 8)))) + "Non-nil means `vc-annotate-color-map' is applied to the background. + +When non-nil, the color range from `vc-annotate-color-map' is applied +to the background, while the foreground remains default. + +When nil, the color range from `vc-annotate-color-map' is applied +to the foreground, and the color from the option `vc-annotate-background' +is applied to the background." + :type 'boolean + :set (lambda (symbol value) + (set-default symbol value) + (when (boundp 'vc-annotate-color-map) + (with-demoted-errors + ;; Update the value of the dependent variable. + (custom-reevaluate-setting 'vc-annotate-color-map)))) + :version "25.1" + :group 'vc) + (defcustom vc-annotate-color-map (if (and (tty-display-color-p) (<= (display-color-cells) 8)) ;; A custom sorted TTY colormap @@ -71,25 +94,49 @@ (prog1 (cons date x) (setq date (+ date delta)))) colors)) - ;; Normal colormap: hue stepped from 0-240deg, value=1., saturation=0.75 - '(( 20. . "#FF3F3F") - ( 40. . "#FF6C3F") - ( 60. . "#FF993F") - ( 80. . "#FFC63F") - (100. . "#FFF33F") - (120. . "#DDFF3F") - (140. . "#B0FF3F") - (160. . "#83FF3F") - (180. . "#56FF3F") - (200. . "#3FFF56") - (220. . "#3FFF83") - (240. . "#3FFFB0") - (260. . "#3FFFDD") - (280. . "#3FF3FF") - (300. . "#3FC6FF") - (320. . "#3F99FF") - (340. . "#3F6CFF") - (360. . "#3F3FFF"))) + (cond + ;; Normal colormap for background colors with dark foreground: + ;; hue stepped from 0-240deg, value=1., saturation=0.20 + (vc-annotate-background-mode + '(( 20. . "#FFCCCC") + ( 40. . "#FFD8CC") + ( 60. . "#FFE4CC") + ( 80. . "#FFF0CC") + (100. . "#FFFCCC") + (120. . "#F6FFCC") + (140. . "#EAFFCC") + (160. . "#DEFFCC") + (180. . "#D2FFCC") + (200. . "#CCFFD2") + (220. . "#CCFFDE") + (240. . "#CCFFEA") + (260. . "#CCFFF6") + (280. . "#CCFCFF") + (300. . "#CCF0FF") + (320. . "#CCE4FF") + (340. . "#CCD8FF") + (360. . "#CCCCFF"))) + ;; Normal colormap for foreground colors on dark background: + ;; hue stepped from 0-240deg, value=1., saturation=0.75 + (t + '(( 20. . "#FF3F3F") + ( 40. . "#FF6C3F") + ( 60. . "#FF993F") + ( 80. . "#FFC63F") + (100. . "#FFF33F") + (120. . "#DDFF3F") + (140. . "#B0FF3F") + (160. . "#83FF3F") + (180. . "#56FF3F") + (200. . "#3FFF56") + (220. . "#3FFF83") + (240. . "#3FFFB0") + (260. . "#3FFFDD") + (280. . "#3FF3FF") + (300. . "#3FC6FF") + (320. . "#3F99FF") + (340. . "#3F6CFF") + (360. . "#3F3FFF"))))) "Association list of age versus color, for \\[vc-annotate]. Ages are given in units of fractional days. Default is eighteen steps using a twenty day increment, from red to blue. For TTY @@ -98,12 +145,12 @@ all other colors between (excluding black and white)." :type 'alist :group 'vc) -(defcustom vc-annotate-very-old-color "#3F3FFF" +(defcustom vc-annotate-very-old-color (if vc-annotate-background-mode "#CCCCFF" "#3F3FFF") "Color for lines older than the current color range in \\[vc-annotate]." :type 'string :group 'vc) -(defcustom vc-annotate-background "black" +(defcustom vc-annotate-background nil "Background color for \\[vc-annotate]. Default color is used if nil." :type '(choice (const :tag "Default background" nil) (color)) @@ -206,7 +253,7 @@ cover the range from the oldest annotation to the newest." (interactive "P") (let ((newest 0.0) (oldest 999999.) ;Any CVS users at the founding of Rome? - (current (vc-annotate-convert-time (current-time))) + (current (vc-annotate-convert-time)) date) (message "Redisplaying annotation...") ;; Run through this file and find the oldest and newest dates annotated. @@ -347,7 +394,9 @@ Customization variables: `vc-annotate-menu-elements' customizes the menu elements of the mode-specific menu. `vc-annotate-color-map' and `vc-annotate-very-old-color' define the mapping of time to colors. -`vc-annotate-background' specifies the background color." +`vc-annotate-background' specifies the background color. +`vc-annotate-background-mode' specifies whether the color map +should be applied to the background or to the foreground." (interactive (save-current-buffer (vc-ensure-vc-buffer) @@ -615,11 +664,10 @@ nil if no such cell exists." (setq i (+ i 1))) tmp-cons)) ; Return the appropriate value -(defun vc-annotate-convert-time (time) - "Convert a time value to a floating-point number of days. -The argument TIME is a list as returned by `current-time' or -`encode-time', only the first two elements of that list are considered." - (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600)) +(defun vc-annotate-convert-time (&optional time) + "Convert optional value TIME to a floating-point number of days. +TIME defaults to the current time." + (/ (float-time time) 86400)) (defun vc-annotate-difference (&optional offset) "Return the time span in days to the next annotation. @@ -634,7 +682,7 @@ or OFFSET if present." (defun vc-default-annotate-current-time (_backend) "Return the current time, encoded as fractional days." - (vc-annotate-convert-time (current-time))) + (vc-annotate-convert-time)) (defvar vc-annotate-offset nil) @@ -666,10 +714,13 @@ The annotations are relative to the current time, unless overridden by OFFSET." ;; Make the face if not done. (face (or (intern-soft face-name) (let ((tmp-face (make-face (intern face-name)))) - (set-face-foreground tmp-face (cdr color)) - (when vc-annotate-background - (set-face-background tmp-face - vc-annotate-background)) + (cond + (vc-annotate-background-mode + (set-face-background tmp-face (cdr color))) + (t + (set-face-foreground tmp-face (cdr color)) + (when vc-annotate-background + (set-face-background tmp-face vc-annotate-background)))) tmp-face)))) ; Return the face (put-text-property start end 'face face))))) ;; Pretend to font-lock there were no matches. diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 2d902da2937..96d6d1da48c 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -493,12 +493,20 @@ in the branch repository (or whose status not be determined)." (add-hook 'after-save-hook 'vc-bzr-resolve-when-done nil t) (message "There are unresolved conflicts in this file"))) -(defun vc-bzr-workfile-unchanged-p (file) - (eq 'unchanged (car (vc-bzr-status file)))) +(defun vc-bzr-version-dirstate (dir) + "Try to return as a string the bzr revision ID of directory DIR. +This uses the dirstate file's parent revision entry. +Returns nil if unable to find this information." + (let ((file (expand-file-name ".bzr/checkout/dirstate" dir))) + (when (file-readable-p file) + (with-temp-buffer + (insert-file-contents file) + (and (looking-at "#bazaar dirstate flat format 3") + (forward-line 3) + (looking-at "[0-9]+\0\\([^\0\n]+\\)\0") + (match-string 1)))))) (defun vc-bzr-working-revision (file) - ;; Together with the code in vc-state-heuristic, this makes it possible - ;; to get the initial VC state of a Bzr file even if Bzr is not installed. (let* ((rootdir (vc-bzr-root file)) (branch-format-file (expand-file-name vc-bzr-admin-branch-format-file rootdir)) @@ -543,8 +551,8 @@ in the branch repository (or whose status not be determined)." ;; files exist. (and (file-exists-p branch-format-file) (file-exists-p lastrev-file) - (equal (emacs-bzr-version-dirstate l-c-parent-dir) - (emacs-bzr-version-dirstate rootdir)))))) + (equal (vc-bzr-version-dirstate l-c-parent-dir) + (vc-bzr-version-dirstate rootdir)))))) t))) (with-temp-buffer (insert-file-contents branch-format-file) @@ -580,10 +588,6 @@ in the branch repository (or whose status not be determined)." "Create a new Bzr repository." (vc-bzr-command "init" nil 0 nil)) -(defun vc-bzr-init-revision (&optional _file) - "Always return nil, as Bzr cannot register explicit versions." - nil) - (defun vc-bzr-previous-revision (_file rev) (if (string-match "\\`[0-9]+\\'" rev) (number-to-string (1- (string-to-number rev))) @@ -594,11 +598,8 @@ in the branch repository (or whose status not be determined)." (number-to-string (1+ (string-to-number rev))) (error "Don't know how to compute the next revision of %s" rev))) -(defun vc-bzr-register (files &optional rev _comment) - "Register FILES under bzr. -Signal an error unless REV is nil. -COMMENT is ignored." - (if rev (error "Can't register explicit revision with bzr")) +(defun vc-bzr-register (files &optional _comment) + "Register FILES under bzr. COMMENT is ignored." (vc-bzr-command "add" nil 0 files)) ;; Could run `bzr status' in the directory and see if it succeeds, but @@ -608,18 +609,6 @@ COMMENT is ignored." The criterion is that there is a `.bzr' directory in the same or a superior directory.") -(defun vc-bzr-could-register (file) - "Return non-nil if FILE could be registered under bzr." - (and (vc-bzr-responsible-p file) ; shortcut - (condition-case () - (with-temp-buffer - (vc-bzr-command "add" t 0 file "--dry-run") - ;; The command succeeds with no output if file is - ;; registered (in bzr 0.8). - (goto-char (point-min)) - (looking-at "added ")) - (error)))) - (defun vc-bzr-unregister (file) "Unregister FILE from bzr." (vc-bzr-command "remove" nil 0 file "--keep")) @@ -634,10 +623,8 @@ or a superior directory.") "" (replace-regexp-in-string "\n[ \t]?" " " str))))) -(defun vc-bzr-checkin (files rev comment) - "Check FILES in to bzr with log message COMMENT. -REV non-nil gets an error." - (if rev (error "Can't check in a specific revision with bzr")) +(defun vc-bzr-checkin (files comment) + "Check FILES in to bzr with log message COMMENT." (apply 'vc-bzr-command "commit" nil 0 files (cons "-m" (log-edit-extract-headers `(("Author" . ,(vc-bzr--sanitize-header "--author")) @@ -657,7 +644,7 @@ REV non-nil gets an error." (expand-file-name ".bzrignore" (vc-bzr-root file))) -(defun vc-bzr-checkout (_file &optional _editable rev) +(defun vc-bzr-checkout (_file &optional rev) (if rev (error "Operation not supported") ;; Else, there's nothing to do. nil)) @@ -793,7 +780,7 @@ If LIMIT is non-nil, show no more than this many entries." (autoload 'vc-switches "vc") -(defun vc-bzr-diff (files &optional rev1 rev2 buffer) +(defun vc-bzr-diff (files &optional rev1 rev2 buffer async) "VC bzr backend for diff." (let* ((switches (vc-switches 'bzr 'diff)) (args @@ -809,7 +796,7 @@ If LIMIT is non-nil, show no more than this many entries." (or rev2 ""))))))) ;; `bzr diff' exits with code 1 if diff is non-empty. (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") - (if vc-disable-async-diff 1 'async) files + (if async 1 'async) files args))) @@ -993,9 +980,9 @@ stream. Standard error output is discarded." (forward-line)) (funcall update-function result))) -(defun vc-bzr-dir-status (dir update-function) +(defun vc-bzr-dir-status-files (dir files update-function) "Return a list of conses (file . state) for DIR." - (vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S") + (apply 'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files) (vc-run-delayed (vc-bzr-after-dir-status update-function ;; "bzr status" results are relative to @@ -1007,13 +994,6 @@ stream. Standard error output is discarded." ;; frob the results accordingly. (file-relative-name dir (vc-bzr-root dir))))) -(defun vc-bzr-dir-status-files (dir files _default-state update-function) - "Return a list of conses (file . state) for DIR." - (apply 'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files) - (vc-run-delayed - (vc-bzr-after-dir-status update-function - (file-relative-name dir (vc-bzr-root dir))))) - (defvar vc-bzr-shelve-map (let ((map (make-sparse-keymap))) ;; Turn off vc-dir marking @@ -1132,11 +1112,12 @@ stream. Standard error output is discarded." (file &optional keep noquery reset-vc-info)) (defun vc-bzr-shelve (name) - "Create a shelve." + "Shelve the changes of the selected files." (interactive "sShelf name: ") - (let ((root (vc-bzr-root default-directory))) + (let ((root (vc-bzr-root default-directory)) + (fileset (vc-deduce-fileset))) (when root - (vc-bzr-command "shelve" nil 0 nil "--all" "-m" name) + (vc-bzr-command "shelve" nil 0 (nth 1 fileset) "--all" "-m" name) (vc-resynch-buffer root t t)))) (defun vc-bzr-shelve-show (name) @@ -1166,10 +1147,7 @@ stream. Standard error output is discarded." "Create a stash with the current tree state." (interactive) (vc-bzr-command "shelve" nil 0 nil "--all" "-m" - (let ((ct (current-time))) - (concat - (format-time-string "Snapshot on %Y-%m-%d" ct) - (format-time-string " at %H:%M" ct)))) + (format-time-string "Snapshot on %Y-%m-%d at %H:%M")) (vc-bzr-command "unshelve" nil 0 nil "--apply" "--keep") (vc-resynch-buffer (vc-bzr-root default-directory) t t)) diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 81409585990..d803c16d7cf 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -48,9 +48,9 @@ ;; If the file is not writable (despite CVSREAD being ;; undefined), this is probably because the file is being ;; "watched" by other developers. - ;; (If vc-mistrust-permissions was t, we actually shouldn't - ;; trust this, but there is no other way to learn this from - ;; CVS at the moment (version 1.9).) + ;; (We actually shouldn't trust this, but there is + ;; no other way to learn this from CVS at the + ;; moment (version 1.9).) (string-match "r-..-..-." (nth 8 attrib))) 'announce 'implicit)))))) @@ -110,7 +110,7 @@ This is only meaningful if you don't use the implicit checkout model :version "21.1" :group 'vc-cvs) -(defcustom vc-cvs-stay-local 'only-file +(defcustom vc-stay-local 'only-file "Non-nil means use local operations when possible for remote repositories. This avoids slow queries over the network and instead uses heuristics and past information to determine the current status of a file. @@ -222,7 +222,7 @@ See also variable `vc-cvs-sticky-date-format-string'." (defun vc-cvs-state (file) "CVS-specific version of `vc-state'." - (if (vc-stay-local-p file 'CVS) + (if (vc-cvs-stay-local-p file) (let ((state (vc-file-getprop file 'vc-state))) ;; If we should stay local, use the heuristic but only if ;; we don't have a more precise state already available. @@ -282,7 +282,7 @@ committed and support display of sticky tags." (autoload 'vc-switches "vc") -(defun vc-cvs-register (files &optional _rev comment) +(defun vc-cvs-register (files &optional comment) "Register FILES into the CVS version-control system. COMMENT can be used to provide an initial description of FILES. Passes either `vc-cvs-register-switches' or `vc-register-switches' @@ -321,20 +321,38 @@ its parents." (directory-file-name dir)))) (eq dir t))) -(defun vc-cvs-checkin (files rev comment) +;; vc-cvs-checkin used to take a 'rev' second argument that allowed +;; checking in onto a specified branch tip rather than the current +;; default branch, but nothing in the entire rest of VC exercised +;; this code. Removing it simplifies the backend interface for all +;; modes. +;; +;; Here's the setup code preserved in amber, in case the logic needs +;; to be broken out into a method someday; (if rev (concat "-r" rev)) +;; used to be part of the switches passed to vc-cvs-command. +;; +;; (unless (or (not rev) (vc-cvs-valid-revision-number-p rev)) +;; (if (not (vc-cvs-valid-symbolic-tag-name-p rev)) +;; (error "%s is not a valid symbolic tag name" rev) +;; ;; If the input revision is a valid symbolic tag name, we create it +;; ;; as a branch, commit and switch to it. +;; (apply 'vc-cvs-command nil 0 files "tag" "-b" (list rev)) +;; (apply 'vc-cvs-command nil 0 files "update" "-r" (list rev)) +;; (mapc (lambda (file) (vc-file-setprop file 'vc-cvs-sticky-tag rev)) +;; files))) +;; +;; The following postamble cleaned up after the branch change: +;; +;; ;; if this was an explicit check-in (does not include creation of +;; ;; a branch), remove the sticky tag. +;; (if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev))) +;; (vc-cvs-command nil 0 files "update" "-A")))) +;; files))) +;; +(defun vc-cvs-checkin (files comment) "CVS-specific version of `vc-backend-checkin'." - (unless (or (not rev) (vc-cvs-valid-revision-number-p rev)) - (if (not (vc-cvs-valid-symbolic-tag-name-p rev)) - (error "%s is not a valid symbolic tag name" rev) - ;; If the input revision is a valid symbolic tag name, we create it - ;; as a branch, commit and switch to it. - (apply 'vc-cvs-command nil 0 files "tag" "-b" (list rev)) - (apply 'vc-cvs-command nil 0 files "update" "-r" (list rev)) - (mapc (lambda (file) (vc-file-setprop file 'vc-cvs-sticky-tag rev)) - files))) (let ((status (apply 'vc-cvs-command nil 1 files - "ci" (if rev (concat "-r" rev)) - (concat "-m" comment) + "ci" (concat "-m" comment) (vc-switches 'CVS 'checkin)))) (set-buffer "*vc*") (goto-char (point-min)) @@ -365,12 +383,7 @@ its parents." ;; tell it from the permissions of the file (see ;; vc-cvs-checkout-model). (mapc (lambda (file) (vc-file-setprop file 'vc-checkout-model nil)) - files) - - ;; if this was an explicit check-in (does not include creation of - ;; a branch), remove the sticky tag. - (if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev))) - (vc-cvs-command nil 0 files "update" "-A")))) + files))) (defun vc-cvs-find-revision (file rev buffer) (apply 'vc-cvs-command @@ -382,9 +395,8 @@ its parents." "-p" (vc-switches 'CVS 'checkout))) -(defun vc-cvs-checkout (file &optional editable rev) +(defun vc-cvs-checkout (file &optional rev) "Checkout a revision of FILE into the working area. -EDITABLE non-nil means that the file should be writable. REV is the revision to check out." (message "Checking out %s..." file) ;; Change buffers to get local value of vc-checkout-switches. @@ -392,7 +404,7 @@ REV is the revision to check out." (if (and (file-exists-p file) (not rev)) ;; If no revision was specified, just make the file writable ;; if necessary (using `cvs-edit' if requested). - (and editable (not (eq (vc-cvs-checkout-model (list file)) 'implicit)) + (and (not (eq (vc-cvs-checkout-model (list file)) 'implicit)) (if vc-cvs-use-edit (vc-cvs-command nil 0 file "edit") (set-file-modes file (logior (file-modes file) 128)) @@ -400,7 +412,7 @@ REV is the revision to check out." ;; Check out a particular revision (or recreate the file). (vc-file-setprop file 'vc-working-revision nil) (apply 'vc-cvs-command nil 0 file - (and editable "-w") + "-w" "update" (when rev (unless (eq rev t) @@ -428,6 +440,35 @@ REV is the revision to check out." ;; Make the file read-only by switching off all w-bits (set-file-modes file (logand (file-modes file) 3950))))) +(defun vc-cvs-merge-file (file) + "Accept a file merge request, prompting for revisions." + (let* ((first-revision + (vc-read-revision + (concat "Merge " file + " from branch or revision " + "(default news on current branch): ") + (list file) + 'CVS)) + second-revision + status) + (cond + ((string= first-revision "") + (setq status (vc-cvs-merge-news file))) + (t + (if (not (vc-branch-p first-revision)) + (setq second-revision + (vc-read-revision + "Second revision: " + (list file) 'CVS nil + (concat (vc-branch-part first-revision) "."))) + ;; We want to merge an entire branch. Set revisions + ;; accordingly, so that vc-cvs-merge understands us. + (setq second-revision first-revision) + ;; first-revision must be the starting point of the branch + (setq first-revision (vc-branch-part first-revision))) + (setq status (vc-cvs-merge file first-revision second-revision)))) + status)) + (defun vc-cvs-merge (file first-revision &optional second-revision) "Merge changes into current working copy of FILE. The changes are between FIRST-REVISION and SECOND-REVISION." @@ -515,7 +556,7 @@ Remaining arguments are ignored." ;; It's just the catenation of the individual logs. (vc-cvs-command buffer - (if (vc-stay-local-p files 'CVS) 'async 0) + (if (vc-cvs-stay-local-p files) 'async 0) files "log") (with-current-buffer buffer (vc-run-delayed (vc-rcs-print-log-cleanup))) @@ -528,11 +569,10 @@ Remaining arguments are ignored." (autoload 'vc-version-backup-file "vc") (declare-function vc-coding-system-for-diff "vc" (file)) -(defun vc-cvs-diff (files &optional oldvers newvers buffer) +(defun vc-cvs-diff (files &optional oldvers newvers buffer async) "Get a difference report using CVS between two revisions of FILE." (let* (process-file-side-effects - (async (and (not vc-disable-async-diff) - (vc-stay-local-p files 'CVS))) + (async (and async (vc-cvs-stay-local-p files))) (invoke-cvs-diff-list nil) status) ;; Look through the file list and see if any files have backups @@ -584,7 +624,7 @@ Remaining arguments are ignored." "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER. Optional arg REVISION is a revision to annotate from." (vc-cvs-command buffer - (if (vc-stay-local-p file 'CVS) + (if (vc-cvs-stay-local-p file) 'async 0) file "annotate" (if revision (concat "-r" revision))) @@ -605,7 +645,7 @@ Optional arg REVISION is a revision to annotate from." "Return the current time, based at midnight of the current day, and encoded as fractional days." (vc-annotate-convert-time - (apply 'encode-time 0 0 0 (nthcdr 3 (decode-time (current-time)))))) + (apply 'encode-time 0 0 0 (nthcdr 3 (decode-time))))) (defun vc-cvs-annotate-time () "Return the time of the next annotation (as fraction of days) @@ -721,7 +761,7 @@ If UPDATE is non-nil, then update (resynch) any affected buffers." (defun vc-cvs-make-version-backups-p (file) "Return non-nil if version backups should be made for FILE." - (vc-stay-local-p file 'CVS)) + (vc-cvs-stay-local-p file)) (defun vc-cvs-check-headers () "Check if the current file has any headers in it." @@ -745,8 +785,34 @@ and that it passes `vc-cvs-global-switches' to it before FLAGS." (append vc-cvs-global-switches flags)))) -(defun vc-cvs-stay-local-p (file) ;Back-compatibility. - (vc-stay-local-p file 'CVS)) +(defun vc-cvs-stay-local-p (file) + "Return non-nil if VC should stay local when handling FILE. +If FILE is a list of files, return non-nil if any of them +individually should stay local." + (if (listp file) + (delq nil (mapcar (lambda (arg) (vc-cvs-stay-local-p arg)) file)) + (let* ((sym (vc-make-backend-sym 'CVS 'stay-local)) + (stay-local (if (boundp sym) (symbol-value sym) vc-stay-local))) + (if (symbolp stay-local) stay-local + (let ((dirname (if (file-directory-p file) + (directory-file-name file) + (file-name-directory file)))) + (eq 'yes + (or (vc-file-getprop dirname 'vc-cvs-stay-local-p) + (vc-file-setprop + dirname 'vc-cvs-stay-local-p + (let ((hostname (vc-cvs-repository-hostname dirname))) + (if (not hostname) + 'no + (let ((default t)) + (if (eq (car-safe stay-local) 'except) + (setq default nil stay-local (cdr stay-local))) + (when (consp stay-local) + (setq stay-local + (mapconcat 'identity stay-local "\\|"))) + (if (if (string-match stay-local hostname) + default (not default)) + 'yes 'no)))))))))))) (defun vc-cvs-repository-hostname (dirname) "Hostname of the CVS server associated to workarea DIRNAME." @@ -1003,13 +1069,14 @@ state." (if basedir result (funcall update-function result)))) -(defun vc-cvs-dir-status (dir update-function) - "Create a list of conses (file . state) for DIR." - ;; FIXME check all files in DIR instead? - (let ((local (vc-stay-local-p dir 'CVS))) - (if (and local (not (eq local 'only-file))) +(defun vc-cvs-dir-status-files (dir files update-function) + "Create a list of conses (file . state) for FILES in DIR. +Query all files in DIR if files is nil." + (let ((local (vc-cvs-stay-local-p dir))) + (if (and (not files) local (not (eq local 'only-file))) (vc-cvs-dir-status-heuristic dir update-function) - (vc-cvs-command (current-buffer) 'async dir "-f" "status") + (if (not files) (setq files (vc-expand-dirs (list dir) 'CVS))) + (vc-cvs-command (current-buffer) 'async dir "-f" "status" files) ;; Alternative implementation: use the "update" command instead of ;; the "status" command. ;; (vc-cvs-command (current-buffer) 'async @@ -1018,12 +1085,6 @@ state." (vc-run-delayed (vc-cvs-after-dir-status update-function))))) -(defun vc-cvs-dir-status-files (dir files _default-state update-function) - "Create a list of conses (file . state) for DIR." - (apply 'vc-cvs-command (current-buffer) 'async dir "-f" "status" files) - (vc-run-delayed - (vc-cvs-after-dir-status update-function))) - (defun vc-cvs-file-to-string (file) "Read the content of FILE and return it as a string." (condition-case nil diff --git a/lisp/vc/vc-dav.el b/lisp/vc/vc-dav.el index a20886b0246..3326f2964c9 100644 --- a/lisp/vc/vc-dav.el +++ b/lisp/vc/vc-dav.el @@ -77,19 +77,17 @@ See `vc-checkout-model' for a list of possible values." "Return the current workfile version of URL." "Unknown") -(defun vc-dav-register (url &optional rev comment) +(defun vc-dav-register (url &optional _comment) "Register URL in the DAV backend." ;; Do we need to do anything here? FIXME? ) -(defun vc-dav-checkin (url rev comment) - "Commit changes in URL to WebDAV. -If REV is non-nil, that should become the new revision number. -COMMENT is used as a check-in comment." +(defun vc-dav-checkin (url comment) + "Commit changes in URL to WebDAV. COMMENT is used as a check-in comment." ;; This should PUT the resource and release any locks that we hold. ) -(defun vc-dav-checkout (url &optional editable rev destfile) +(defun vc-dav-checkout (url &optional rev destfile) "Check out revision REV of URL into the working area. If EDITABLE is non-nil URL should be writable by the user and if @@ -119,7 +117,7 @@ only needs to update the status of URL within the backend. "Insert the revision log of URL into the *vc* buffer." ) -(defun vc-dav-diff (url &optional rev1 rev2) +(defun vc-dav-diff (url &optional rev1 rev2 buffer async) "Insert the diff for URL into the *vc-diff* buffer. If REV1 and REV2 are non-nil report differences from REV1 to REV2. If REV1 is nil, use the current workfile version as the older version. @@ -135,10 +133,6 @@ It should return a status of either 0 (no differences found), or ;;; Optional functions -;; Should be faster than vc-dav-state - but how? -(defun vc-dav-state-heuristic (url) - "Estimate the version control state of URL at visiting time." - (vc-dav-state url)) ;; This should use url-dav-get-properties with a depth of `1' to get ;; all the properties. @@ -146,27 +140,13 @@ It should return a status of either 0 (no differences found), or "find the version control state of all files in DIR in a fast way." ) -(defun vc-dav-workfile-unchanged-p (url) - "Return non-nil if URL is unchanged from its current workfile version." - ;; Probably impossible with webdav - ) - (defun vc-dav-responsible-p (url) "Return non-nil if DAV considers itself `responsible' for URL." ;; Check for DAV support on the web server. t) -(defun vc-dav-could-register (url) - "Return non-nil if URL could be registered under this backend." - ;; Check for DAV support on the web server. - t) - ;;; Unimplemented functions ;; -;; vc-dav-latest-on-branch-p(URL) -;; Return non-nil if the current workfile version of FILE is the -;; latest on its branch. There are no branches in webdav yet. -;; ;; vc-dav-mode-line-string(url) ;; Return a dav-specific mode line string for URL. Are there any ;; specific states that we want exposed? diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 942032260f7..e050c947504 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -169,6 +169,9 @@ See `run-hooks'." (define-key map [ise] '(menu-item "Isearch Files..." vc-dir-isearch :help "Incremental search a string in the marked files")) + (define-key map [display] + '(menu-item "Display in Other Window" vc-dir-display-file + :help "Display the file on the current line, in another window")) (define-key map [open-other] '(menu-item "Open in Other Window" vc-dir-find-file-other-window :help "Find the file on the current line, in another window")) @@ -273,6 +276,7 @@ See `run-hooks'." (define-key map "e" 'vc-dir-find-file) ; dired-mode compatibility (define-key map "\C-m" 'vc-dir-find-file) (define-key map "o" 'vc-dir-find-file-other-window) + (define-key map "\C-o" 'vc-dir-display-file) (define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process) (define-key map [down-mouse-3] 'vc-dir-menu) (define-key map [mouse-2] 'vc-dir-toggle-mark) @@ -755,6 +759,13 @@ that share the same state." (if event (posn-set-point (event-end event))) (find-file-other-window (vc-dir-current-file))) +(defun vc-dir-display-file (&optional event) + "Display the file on the current line, in another window." + (interactive (list last-nonmenu-event)) + (if event (posn-set-point (event-end event))) + (display-buffer (find-file-noselect (vc-dir-current-file)) + t)) + (defun vc-dir-isearch () "Search for a string through all marked buffers using Isearch." (interactive) @@ -1014,7 +1025,7 @@ specific headers." (vc-call-backend backend 'dir-extra-headers dir) "\n")) -(defun vc-dir-refresh-files (files default-state) +(defun vc-dir-refresh-files (files) "Refresh some files in the *VC-dir* buffer." (let ((def-dir default-directory) (backend vc-dir-backend)) @@ -1032,7 +1043,7 @@ specific headers." (setq default-directory def-dir) (erase-buffer) (vc-call-backend - backend 'dir-status-files def-dir files default-state + backend 'dir-status-files def-dir files (lambda (entries &optional more-to-come) ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items. ;; If MORE-TO-COME is true, then more updates will come from @@ -1097,7 +1108,7 @@ Throw an error if another update process is in progress." (setq default-directory def-dir) (erase-buffer) (vc-call-backend - backend 'dir-status def-dir + backend 'dir-status-files def-dir nil (lambda (entries &optional more-to-come) ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items. ;; If MORE-TO-COME is true, then more updates will come from @@ -1110,8 +1121,7 @@ Throw an error if another update process is in progress." vc-ewoc 'vc-dir-fileinfo->needs-update))) (if remaining (vc-dir-refresh-files - (mapcar 'vc-dir-fileinfo->name remaining) - 'up-to-date) + (mapcar 'vc-dir-fileinfo->name remaining)) (setq mode-line-process nil)))))))))))) (defun vc-dir-show-fileentry (file) @@ -1125,18 +1135,18 @@ outside of VC) and one wants to do some operation on it." "Hide items that are in STATE from display. See `vc-state' for valid values of STATE. -If STATE is nil, default it to up-to-date. +If STATE is nil, hide both `up-to-date' and `ignored' items. Interactively, if `current-prefix-arg' is non-nil, set STATE to -state of item at point. Otherwise, set STATE to up-to-date." +state of item at point, if any." (interactive (list (and current-prefix-arg ;; Command is prefixed. Infer STATE from point. (let ((node (ewoc-locate vc-ewoc))) (and node (vc-dir-fileinfo->state (ewoc-data node))))))) - ;; If STATE is un-specified, use up-to-date. - (setq state (or state 'up-to-date)) - (message "Hiding items in state \"%s\"" state) + (if state + (message "Hiding items in state \"%s\"" state) + (message "Hiding up-to-date and ignored items")) (let ((crt (ewoc-nth vc-ewoc -1)) (first (ewoc-nth vc-ewoc 0))) ;; Go over from the last item to the first and remove the @@ -1157,8 +1167,10 @@ state of item at point. Otherwise, set STATE to up-to-date." ;; Next item is a directory. (vc-dir-fileinfo->directory (ewoc-data next)))) ;; Remove files in specified STATE. STATE can be a - ;; symbol or a user-name. - (equal (vc-dir-fileinfo->state data) state)) + ;; symbol, a user-name, or nil. + (if state + (equal (vc-dir-fileinfo->state data) state) + (memq (vc-dir-fileinfo->state data) '(up-to-date ignored)))) (ewoc-delete vc-ewoc crt)) (setq crt prev))))) @@ -1229,7 +1241,7 @@ These are the commands available for use in the file status buffer: ;; Otherwise if you do C-x v d -> C-x C-f -> C-c v d ;; you may get a new *vc-dir* buffer, different from the original (file-truename (read-directory-name "VC status for directory: " - default-directory default-directory t + (vc-root-dir) nil t nil)) (if current-prefix-arg (intern diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index a462870a4e2..4f8ec278896 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -429,7 +429,7 @@ If the current buffer is a Dired buffer, revert it." ;; even if the dispatcher client mode has messed with file contents (as in, ;; for example, VCS keyword expansion). -(declare-function view-mode-exit "view" (&optional return-to-alist exit-action all-win)) +(declare-function view-mode-exit "view" (&optional exit-only exit-action all-win)) (defun vc-position-context (posn) "Save a bit of the text around POSN in the current buffer. @@ -543,7 +543,7 @@ editing!" (if (file-writable-p file) (and view-mode (let ((view-old-buffer-read-only nil)) - (view-mode-exit))) + (view-mode-exit t))) (and (not view-mode) (not (eq (get major-mode 'mode-class) 'special)) (view-mode-enter)))) @@ -702,7 +702,7 @@ the buffer contents as a comment." ;; Now make sure we see the expanded headers (when log-fileset (mapc - (lambda (file) (vc-resynch-buffer file vc-keep-workfiles t)) + (lambda (file) (vc-resynch-buffer file t t)) log-fileset)) (when (vc-dispatcher-browsing) (vc-dir-move-to-goal-column)) diff --git a/lisp/vc/vc-filewise.el b/lisp/vc/vc-filewise.el new file mode 100644 index 00000000000..254d126b98a --- /dev/null +++ b/lisp/vc/vc-filewise.el @@ -0,0 +1,84 @@ +;;; vc-filewise.el --- common functions for file-oriented back ends. + +;; Copyright (C) 1992-1996, 1998-2015 Free Software Foundation, Inc. + +;; Author: FSF (see vc.el for full credits) +;; Maintainer: Andre Spiegel <spiegel@gnu.org> +;; Package: vc + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Common functions for file-oriented back ends - SCCS, RCS, SRC, CVS +;; +;; The main purpose of this file is so none of this code has to live +;; in the always-resident vc-hooks. A secondary purpose is to remove +;; code specific to this class of back ends from vc.el. + +;;; Code: + +(eval-when-compile (require 'vc)) + +(defun vc-master-name (file) + "Return the master name of FILE. +If the file is not registered, or the master name is not known, return nil." + (or (vc-file-getprop file 'vc-name) + ;; force computation of the property by calling + ;; vc-BACKEND-registered explicitly + (let ((backend (vc-backend file))) + (if (and backend + (vc-filewise-registered backend file)) + (vc-file-getprop file 'vc-name))))) + +(defun vc-rename-master (oldmaster newfile templates) + "Rename OLDMASTER to be the master file for NEWFILE based on TEMPLATES." + (let* ((dir (file-name-directory (expand-file-name oldmaster))) + (newdir (or (file-name-directory newfile) "")) + (newbase (file-name-nondirectory newfile)) + (masters + ;; List of potential master files for `newfile' + (mapcar + (lambda (s) (vc-possible-master s newdir newbase)) + templates))) + (when (or (file-symlink-p oldmaster) + (file-symlink-p (file-name-directory oldmaster))) + (error "This is unsafe in the presence of symbolic links")) + (rename-file + oldmaster + (catch 'found + ;; If possible, keep the master file in the same directory. + (dolist (f masters) + (when (and f (string= (file-name-directory (expand-file-name f)) dir)) + (throw 'found f))) + ;; If not, just use the first possible place. + (dolist (f masters) + (and f (or (not (setq dir (file-name-directory f))) + (file-directory-p dir)) + (throw 'found f))) + (error "New file lacks a version control directory"))))) + +(defun vc-filewise-registered (backend file) + "Check if FILE is registered in BACKEND using vc-BACKEND-master-templates." + (let ((sym (vc-make-backend-sym backend 'master-templates))) + (unless (get backend 'vc-templates-grabbed) + (put backend 'vc-templates-grabbed t)) + (let ((result (vc-check-master-templates file (symbol-value sym)))) + (if (stringp result) + (vc-file-setprop file 'vc-name result) + nil)))) ; Not registered + +(provide 'vc-filewise) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index ee8b9cd1663..a31c121b89b 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -50,32 +50,27 @@ ;; STATE-QUERYING FUNCTIONS ;; * registered (file) OK ;; * state (file) OK -;; - state-heuristic (file) NOT NEEDED +;; - dir-status-files (dir files uf) OK ;; * working-revision (file) OK -;; - latest-on-branch-p (file) NOT NEEDED ;; * checkout-model (files) OK -;; - workfile-unchanged-p (file) OK ;; - mode-line-string (file) OK ;; STATE-CHANGING FUNCTIONS ;; * create-repo () OK ;; * register (files &optional rev comment) OK -;; - init-revision (file) NOT NEEDED ;; - responsible-p (file) OK -;; - could-register (file) NOT NEEDED, DEFAULT IS GOOD ;; - receive-file (file rev) NOT NEEDED ;; - unregister (file) OK ;; * checkin (files rev comment) OK ;; * find-revision (file rev buffer) OK -;; * checkout (file &optional editable rev) OK +;; * checkout (file &optional rev) OK ;; * revert (file &optional contents-done) OK -;; - rollback (files) COULD BE SUPPORTED -;; - merge (file rev1 rev2) It would be possible to merge +;; - merge-file (file rev1 rev2) It would be possible to merge ;; changes into a single file, but ;; when committing they wouldn't ;; be identified as a merge ;; by git, so it's probably ;; not a good idea. -;; - merge-news (file) see `merge' +;; - merge-news (file) see `merge-file' ;; - steal-lock (file &optional revision) NOT NEEDED ;; HISTORY FUNCTIONS ;; * print-log (files buffer &optional shortlog start-revision limit) OK @@ -83,7 +78,7 @@ ;; - show-log-entry (revision) OK ;; - comment-history (file) ?? ;; - update-changelog (files) COULD BE SUPPORTED -;; * diff (file &optional rev1 rev2 buffer) OK +;; * diff (file &optional rev1 rev2 buffer async) OK ;; - revision-completion-table (files) OK ;; - annotate-command (file buf &optional rev) OK ;; - annotate-time () OK @@ -94,14 +89,13 @@ ;; - retrieve-tag (dir name update) OK ;; MISCELLANEOUS ;; - make-version-backups-p (file) NOT NEEDED -;; - repository-hostname (dirname) NOT NEEDED ;; - previous-revision (file rev) OK ;; - next-revision (file rev) OK ;; - check-headers () COULD BE SUPPORTED -;; - clear-headers () NOT NEEDED ;; - delete-file (file) OK ;; - rename-file (old new) OK -;; - find-file-hook () NOT NEEDED +;; - find-file-hook () OK +;; - conflicted-files OK ;;; Code: @@ -247,9 +241,6 @@ matching the resulting Git log output, and KEYWORDS is a list of str) (vc-git--rev-parse "HEAD")))) -(defun vc-git-workfile-unchanged-p (file) - (eq 'up-to-date (vc-git-state file))) - (defun vc-git-mode-line-string (file) "Return a string for `vc-mode-line' to put in the mode line for FILE." (let* ((rev (vc-working-revision file)) @@ -479,15 +470,11 @@ or an empty string if none." (vc-run-delayed (vc-git-after-dir-status-stage stage files update-function))) -(defun vc-git-dir-status (_dir update-function) +(defun vc-git-dir-status-files (_dir files update-function) "Return a list of (FILE STATE EXTRA) entries for DIR." ;; Further things that would have to be fixed later: ;; - how to handle unregistered directories ;; - how to support vc-dir on a subdir of the project tree - (vc-git-dir-status-goto-stage 'update-index nil update-function)) - -(defun vc-git-dir-status-files (_dir files _default-state update-function) - "Return a list of (FILE STATE EXTRA) entries for FILES in DIR." (vc-git-dir-status-goto-stage 'update-index files update-function)) (defvar vc-git-stash-map @@ -603,7 +590,7 @@ The car of the list is the current branch." "Create a new Git repository." (vc-git-command nil 0 nil "init")) -(defun vc-git-register (files &optional _rev _comment) +(defun vc-git-register (files &optional _comment) "Register FILES into the git version-control system." (let (flist dlist) (dolist (crt files) @@ -663,7 +650,7 @@ If toggling on, also insert its message into the buffer." "Major mode for editing Git log messages. It is based on `log-edit-mode', and has Git-specific extensions.") -(defun vc-git-checkin (files _rev comment) +(defun vc-git-checkin (files comment) (let* ((file1 (or (car files) default-directory)) (root (vc-git-root file1)) (default-directory (expand-file-name root)) @@ -707,7 +694,7 @@ It is based on `log-edit-mode', and has Git-specific extensions.") (expand-file-name ".gitignore" (vc-git-root file))) -(defun vc-git-checkout (file &optional _editable rev) +(defun vc-git-checkout (file &optional rev) (vc-git-command nil 0 file "checkout" (or rev "HEAD"))) (defun vc-git-revert (file &optional contents-done) @@ -768,6 +755,47 @@ This prompts for a branch to merge from." (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git))) (vc-set-async-update buffer))) +(defun vc-git-conflicted-files (directory) + "Return the list of files with conflicts in DIRECTORY." + (let* ((status + (vc-git--run-command-string directory "status" "--porcelain" "--")) + (lines (when status (split-string status "\n" 'omit-nulls))) + files) + (dolist (line lines files) + (when (string-match "\\([ MADRCU?!][ MADRCU?!]\\) \\(.+\\)\\(?: -> \\(.+\\)\\)?" + line) + (let ((state (match-string 1 line)) + (file (match-string 2 line))) + ;; See git-status(1). + (when (member state '("AU" "UD" "UA" ;; "DD" + "DU" "AA" "UU")) + (push (expand-file-name file directory) files))))))) + +(defun vc-git-resolve-when-done () + "Call \"git add\" if the conflict markers have been removed." + (save-excursion + (goto-char (point-min)) + (unless (re-search-forward "^<<<<<<< " nil t) + (vc-git-command nil 0 buffer-file-name "add") + ;; Remove the hook so that it is not called multiple times. + (remove-hook 'after-save-hook 'vc-git-resolve-when-done t)))) + +(defun vc-git-find-file-hook () + "Activate `smerge-mode' if there is a conflict." + (when (and buffer-file-name + ;; FIXME + ;; 1) the net result is to call git twice per file. + ;; 2) v-g-c-f is documented to take a directory. + ;; http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg01126.html + (vc-git-conflicted-files buffer-file-name) + (save-excursion + (goto-char (point-min)) + (re-search-forward "^<<<<<<< " nil 'noerror))) + (vc-file-setprop buffer-file-name 'vc-state 'conflict) + (smerge-start-session) + (add-hook 'after-save-hook 'vc-git-resolve-when-done nil 'local) + (message "There are unresolved conflicts in this file"))) + ;;; HISTORY FUNCTIONS (autoload 'vc-setup-buffer "vc-dispatcher") @@ -841,7 +869,7 @@ If LIMIT is non-nil, show no more than this many entries." (if (not (eq vc-log-view-type 'long)) (cadr vc-git-root-log-format) "^commit *\\([0-9a-z]+\\)")) - ;; Allow expanding short log entries + ;; Allow expanding short log entries. (when (eq vc-log-view-type 'short) (setq truncate-lines t) (set (make-local-variable 'log-view-expanded-log-entry-function) @@ -898,16 +926,73 @@ or BRANCH^ (where \"^\" can be repeated)." (indent-region (point-min) (point-max) 2) (buffer-string)))) + +(defun vc-git-region-history (file buffer lfrom lto) + (vc-git-command buffer 'async nil "log" "-p" ;"--follow" ;FIXME: not supported? + (format "-L%d,%d:%s" lfrom lto (file-relative-name file)))) + +(require 'diff-mode) + +(defvar vc-git-region-history-mode-map + (let ((map (make-composed-keymap + nil (make-composed-keymap + (list diff-mode-map vc-git-log-view-mode-map))))) + map)) + +(defvar vc-git--log-view-long-font-lock-keywords nil) +(defvar font-lock-keywords) +(defvar vc-git-region-history-font-lock-keywords + `((vc-git-region-history-font-lock))) + +(defun vc-git-region-history-font-lock (limit) + (let ((in-diff (save-excursion + (beginning-of-line) + (or (looking-at "^\\(?:diff\\|commit\\)\\>") + (re-search-backward "^\\(?:diff\\|commit\\)\\>" nil t)) + (eq ?d (char-after (match-beginning 0)))))) + (while + (let ((end (save-excursion + (if (re-search-forward "\n\\(diff\\|commit\\)\\>" + limit t) + (match-beginning 1) + limit)))) + (let ((font-lock-keywords (if in-diff diff-font-lock-keywords + vc-git--log-view-long-font-lock-keywords))) + (font-lock-fontify-keywords-region (point) end)) + (goto-char end) + (prog1 (< (point) limit) + (setq in-diff (eq ?d (char-after)))))) + nil)) + +(define-derived-mode vc-git-region-history-mode + vc-git-log-view-mode "Git-Region-History" + "Major mode to browse Git's \"log -p\" output." + (setq-local vc-git--log-view-long-font-lock-keywords + log-view-font-lock-keywords) + (setq-local font-lock-defaults + (cons 'vc-git-region-history-font-lock-keywords + (cdr font-lock-defaults)))) + + (autoload 'vc-switches "vc") -(defun vc-git-diff (files &optional rev1 rev2 buffer) +(defun vc-git-diff (files &optional rev1 rev2 buffer async) "Get a difference report using Git between two revisions of FILES." (let (process-file-side-effects) - (apply #'vc-git-command (or buffer "*vc-diff*") 1 files - (if (and rev1 rev2) "diff-tree" "diff-index") - "--exit-code" - (append (vc-switches 'git 'diff) - (list "-p" (or rev1 "HEAD") rev2 "--"))))) + (if vc-git-diff-switches + (apply #'vc-git-command (or buffer "*vc-diff*") + (if async 'async 1) + files + (if (and rev1 rev2) "diff-tree" "diff-index") + "--exit-code" + (append (vc-switches 'git 'diff) + (list "-p" (or rev1 "HEAD") rev2 "--"))) + (vc-git-command (or buffer "*vc-diff*") 1 files + "difftool" "--exit-code" "--no-prompt" "-x" + (concat "diff " + (mapconcat 'identity + (vc-switches nil 'diff) " ")) + (or rev1 "HEAD") rev2 "--")))) (defun vc-git-revision-table (_files) ;; What about `files'?!? --Stef diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 03aaa08ea6d..8b4067f536b 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -43,29 +43,22 @@ ;; STATE-QUERYING FUNCTIONS ;; * registered (file) OK ;; * state (file) OK -;; - state-heuristic (file) NOT NEEDED -;; - dir-status (dir update-function) OK -;; - dir-status-files (dir files ds uf) OK +;; - dir-status-files (dir files uf) OK ;; - dir-extra-headers (dir) OK ;; - dir-printer (fileinfo) OK ;; * working-revision (file) OK -;; - latest-on-branch-p (file) ?? ;; * checkout-model (files) OK -;; - workfile-unchanged-p (file) OK ;; - mode-line-string (file) NOT NEEDED ;; STATE-CHANGING FUNCTIONS ;; * register (files &optional rev comment) OK ;; * create-repo () OK -;; - init-revision () NOT NEEDED ;; - responsible-p (file) OK -;; - could-register (file) OK ;; - receive-file (file rev) ?? PROBABLY NOT NEEDED ;; - unregister (file) OK ;; * checkin (files rev comment) OK ;; * find-revision (file rev buffer) OK -;; * checkout (file &optional editable rev) OK +;; * checkout (file &optional rev) OK ;; * revert (file &optional contents-done) OK -;; - rollback (files) ?? PROBABLY NOT NEEDED ;; - merge (file rev1 rev2) NEEDED ;; - merge-news (file) NEEDED ;; - steal-lock (file &optional revision) NOT NEEDED @@ -82,15 +75,13 @@ ;; - annotate-current-time () NOT NEEDED ;; - annotate-extract-revision-at-line () OK ;; TAG SYSTEM -;; - create-tag (dir name branchp) NEEDED -;; - retrieve-tag (dir name update) NEEDED +;; - create-tag (dir name branchp) OK +;; - retrieve-tag (dir name update) OK FIXME UPDATE BUFFERS ;; MISCELLANEOUS ;; - make-version-backups-p (file) ?? -;; - repository-hostname (dirname) ?? ;; - previous-revision (file rev) OK ;; - next-revision (file rev) OK ;; - check-headers () ?? -;; - clear-headers () ?? ;; - delete-file (file) TEST IT ;; - rename-file (old new) OK ;; - find-file-hook () added for bug#10709 @@ -195,6 +186,7 @@ highlighting the Log View buffer." (defun vc-hg-state (file) "Hg-specific version of `vc-state'." + (setq file (expand-file-name file)) (let* ((status nil) (default-directory (file-name-directory file)) @@ -211,34 +203,28 @@ highlighting the Log View buffer." (append (list "TERM=dumb" "LANGUAGE=C" "HGPLAIN=1") process-environment))) - (if (file-remote-p file) - (process-file - "env" nil t nil - "HGPLAIN=1" vc-hg-program - "--config" "alias.status=status" - "--config" "defaults.status=" - "status" "-A" (file-relative-name file)) - (process-file - vc-hg-program nil t nil - "--config" "alias.status=status" - "--config" "defaults.status=" - "status" "-A" (file-relative-name file)))) + (process-file + vc-hg-program nil t nil + "--config" "alias.status=status" + "--config" "defaults.status=" + "status" "-A" (file-relative-name file))) ;; Some problem happened. E.g. We can't find an `hg' ;; executable. (error nil))))))) - (when (eq 0 status) - (when (null (string-match ".*: No such file or directory$" out)) - (let ((state (aref out 0))) - (cond - ((eq state ?=) 'up-to-date) - ((eq state ?A) 'added) - ((eq state ?M) 'edited) - ((eq state ?I) 'ignored) - ((eq state ?R) 'removed) - ((eq state ?!) 'missing) - ((eq state ??) 'unregistered) - ((eq state ?C) 'up-to-date) ;; Older mercurial versions use this. - (t 'up-to-date))))))) + (when (and (eq 0 status) + (> (length out) 0) + (null (string-match ".*: No such file or directory$" out))) + (let ((state (aref out 0))) + (cond + ((eq state ?=) 'up-to-date) + ((eq state ?A) 'added) + ((eq state ?M) 'edited) + ((eq state ?I) 'ignored) + ((eq state ?R) 'removed) + ((eq state ?!) 'missing) + ((eq state ??) 'unregistered) + ((eq state ?C) 'up-to-date) ;; Older mercurial versions use this. + (t 'up-to-date)))))) (defun vc-hg-working-revision (file) "Hg-specific version of `vc-working-revision'." @@ -327,7 +313,7 @@ If LIMIT is non-nil, show no more than this many entries." (autoload 'vc-switches "vc") -(defun vc-hg-diff (files &optional oldvers newvers buffer) +(defun vc-hg-diff (files &optional oldvers newvers buffer async) "Get a difference report using hg between two revisions of FILES." (let* ((firstfile (car files)) (working (and firstfile (vc-working-revision firstfile)))) @@ -335,7 +321,10 @@ If LIMIT is non-nil, show no more than this many entries." (setq oldvers nil)) (when (and (not oldvers) newvers) (setq oldvers working)) - (apply #'vc-hg-command (or buffer "*vc-diff*") nil files "diff" + (apply #'vc-hg-command + (or buffer "*vc-diff*") + (if async 'async nil) + files "diff" (append (vc-switches 'hg 'diff) (when oldvers @@ -396,8 +385,26 @@ Optional arg REVISION is a revision to annotate from." (if (match-beginning 3) (match-string-no-properties 1) (cons (match-string-no-properties 1) - (expand-file-name (match-string-no-properties 4) - (vc-hg-root default-directory))))))) + (expand-file-name (match-string-no-properties 4) + (vc-hg-root default-directory))))))) + +;;; Tag system + +(defun vc-hg-create-tag (dir name branchp) + "Attach the tag NAME to the state of the working copy." + (let ((default-directory dir)) + (and (vc-hg-command nil 0 nil "status") + (vc-hg-command nil 0 nil (if branchp "bookmark" "tag") name)))) + +(defun vc-hg-retrieve-tag (dir name _update) + "Retrieve the version tagged by NAME of all registered files at or below DIR." + (let ((default-directory dir)) + (vc-hg-command nil 0 nil "update" name) + ;; FIXME: update buffers if `update' is true + ;; TODO: update *vc-change-log* buffer so can see @ if --graph + )) + +;;; Miscellaneous (defun vc-hg-previous-revision (_file rev) (let ((newrev (1- (string-to-number rev)))) @@ -430,10 +437,8 @@ Optional arg REVISION is a revision to annotate from." "Rename file from OLD to NEW using `hg mv'." (vc-hg-command nil 0 new "mv" old)) -(defun vc-hg-register (files &optional _rev _comment) - "Register FILES under hg. -REV is ignored. -COMMENT is ignored." +(defun vc-hg-register (files &optional _comment) + "Register FILES under hg. COMMENT is ignored." (vc-hg-command nil 0 files "add")) (defun vc-hg-create-repo () @@ -442,24 +447,13 @@ COMMENT is ignored." (defalias 'vc-hg-responsible-p 'vc-hg-root) -;; Modeled after the similar function in vc-bzr.el -(defun vc-hg-could-register (file) - "Return non-nil if FILE could be registered under hg." - (and (vc-hg-responsible-p file) ; shortcut - (condition-case () - (with-temp-buffer - (vc-hg-command t nil file "add" "--dry-run")) - ;; The command succeeds with no output if file is - ;; registered. - (error)))) - (defun vc-hg-unregister (file) "Unregister FILE from hg." (vc-hg-command nil 0 file "forget")) (declare-function log-edit-extract-headers "log-edit" (headers string)) -(defun vc-hg-checkin (files _rev comment) +(defun vc-hg-checkin (files comment) "Hg-specific version of `vc-backend-checkin'. REV is ignored." (apply 'vc-hg-command nil 0 files @@ -481,7 +475,7 @@ REV is ignored." (vc-hg-root file))) ;; Modeled after the similar function in vc-bzr.el -(defun vc-hg-checkout (file &optional _editable rev) +(defun vc-hg-checkout (file &optional rev) "Retrieve a revision of FILE. EDITABLE is ignored. REV is the revision to check out into WORKFILE." @@ -522,10 +516,6 @@ REV is the revision to check out into WORKFILE." ;; Modeled after the similar function in vc-bzr.el -(defun vc-hg-workfile-unchanged-p (file) - (eq 'up-to-date (vc-hg-state file))) - -;; Modeled after the similar function in vc-bzr.el (defun vc-hg-revert (file &optional contents-done) (unless contents-done (with-temp-buffer (vc-hg-command t 0 file "revert")))) @@ -622,15 +612,12 @@ REV is the revision to check out into WORKFILE." ;; Follows vc-exec-after. (declare-function vc-set-async-update "vc-dispatcher" (process-buffer)) -(defun vc-hg-dir-status (dir update-function) - (vc-hg-command (current-buffer) 'async dir "status" "-C") - (vc-run-delayed - (vc-hg-after-dir-status update-function))) - -(defun vc-hg-dir-status-files (dir files _default-state update-function) - (apply 'vc-hg-command (current-buffer) 'async dir "status" "-mardui" "-C" files) +(defun vc-hg-dir-status-files (dir files update-function) + (apply 'vc-hg-command (current-buffer) 'async dir "status" + (concat "-mardu" (if files "i")) + "-C" files) (vc-run-delayed - (vc-hg-after-dir-status update-function))) + (vc-hg-after-dir-status update-function))) (defun vc-hg-dir-extra-header (name &rest commands) (concat (propertize name 'face 'font-lock-type-face) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index f3891fc6a29..7801f4f8ed9 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -32,6 +32,69 @@ (eval-when-compile (require 'cl-lib)) +;; Faces + +(defgroup vc-state-faces nil + "Faces used in the mode line by the VC state indicator." + :group 'vc-faces + :group 'mode-line + :version "25.1") + +(defface vc-state-base-face + '((default)) + "Base face for VC state indicator." + :group 'vc-faces + :group 'mode-line + :version "25.1") + +(defface vc-up-to-date-state + '((default :inherit vc-state-base-face)) + "Face for VC modeline state when the file is up to date." + :version "25.1" + :group 'vc-faces) + +(defface vc-needs-update-state + '((default :inherit vc-state-base-face)) + "Face for VC modeline state when the file needs update." + :version "25.1" + :group 'vc-faces) + +(defface vc-locked-state + '((default :inherit vc-state-base-face)) + "Face for VC modeline state when the file locked." + :version "25.1" + :group 'vc-faces) + +(defface vc-locally-added-state + '((default :inherit vc-state-base-face)) + "Face for VC modeline state when the file is locally added." + :version "25.1" + :group 'vc-faces) + +(defface vc-conflict-state + '((default :inherit vc-state-base-face)) + "Face for VC modeline state when the file contains merge conflicts." + :version "25.1" + :group 'vc-faces) + +(defface vc-removed-state + '((default :inherit vc-state-base-face)) + "Face for VC modeline state when the file was removed from the VC system." + :version "25.1" + :group 'vc-faces) + +(defface vc-missing-state + '((default :inherit vc-state-base-face)) + "Face for VC modeline state when the file is missing from the file system." + :version "25.1" + :group 'vc-faces) + +(defface vc-edited-state + '((default :inherit vc-state-base-face)) + "Face for VC modeline state when the file is up to date." + :version "25.1" + :group 'vc-faces) + ;; Customization Variables (the rest is in vc.el) (defcustom vc-ignore-dir-regexp @@ -44,8 +107,8 @@ interpreted as hostnames." :type 'regexp :group 'vc) -(defcustom vc-handled-backends '(RCS CVS SVN SCCS Bzr Git Hg Mtn Arch) - ;; RCS, CVS, SVN and SCCS come first because they are per-dir +(defcustom vc-handled-backends '(RCS CVS SVN SCCS SRC Bzr Git Hg Mtn) + ;; RCS, CVS, SVN, SCCS, and SRC come first because they are per-dir ;; rather than per-tree. RCS comes first because of the multibackend ;; support intended to use RCS for local commits (with a remote CVS server). "List of version control backends for which VC will be used. @@ -55,13 +118,14 @@ Removing an entry from the list prevents VC from being activated when visiting a file managed by that backend. An empty list disables VC altogether." :type '(repeat symbol) - :version "23.1" + :version "25.1" :group 'vc) ;; Note: we don't actually have a darcs back end yet. -;; Also, Meta-CVS (corresponding to MCVS) is unsupported. +;; Also, Meta-CVS (corresponding to MCVS) and Arch are unsupported. +;; The Arch back end will be retrieved and fixed if it is ever required. (defcustom vc-directory-exclusion-list (purecopy '("SCCS" "RCS" "CVS" "MCVS" - ".svn" ".git" ".hg" ".bzr" + ".src" ".svn" ".git" ".hg" ".bzr" "_MTN" "_darcs" "{arch}")) "List of directory names to be ignored when walking directory trees." :type '(repeat string) @@ -100,87 +164,6 @@ Otherwise, not displayed." :type 'boolean :group 'vc) -(defcustom vc-keep-workfiles t - "Whether to keep work files on disk after commits, on a locking VCS. -This variable has no effect on modern merging-based version -control systems." - :type 'boolean - :group 'vc) - -;; If you fix bug#11490, probably you can set this back to nil. -(defcustom vc-mistrust-permissions t - "If non-nil, don't assume permissions/ownership track version-control status. -If nil, do rely on the permissions. -See also variable `vc-consult-headers'." - :version "24.3" ; nil->t, bug#11490 - :type 'boolean - :group 'vc) - -(defun vc-mistrust-permissions (file) - "Internal access function to variable `vc-mistrust-permissions' for FILE." - (or (eq vc-mistrust-permissions 't) - (and vc-mistrust-permissions - (funcall vc-mistrust-permissions - (vc-backend-subdirectory-name file))))) - -(defcustom vc-stay-local 'only-file - "Non-nil means use local operations when possible for remote repositories. -This avoids slow queries over the network and instead uses heuristics -and past information to determine the current status of a file. - -If value is the symbol `only-file', `vc-dir' will connect to the -server, but heuristics will be used to determine the status for -all other VC operations. - -The value can also be a regular expression or list of regular -expressions to match against the host name of a repository; then VC -only stays local for hosts that match it. Alternatively, the value -can be a list of regular expressions where the first element is the -symbol `except'; then VC always stays local except for hosts matched -by these regular expressions." - :type '(choice - (const :tag "Always stay local" t) - (const :tag "Only for file operations" only-file) - (const :tag "Don't stay local" nil) - (list :format "\nExamine hostname and %v" :tag "Examine hostname ..." - (set :format "%v" :inline t (const :format "%t" :tag "don't" except)) - (regexp :format " stay local,\n%t: %v" :tag "if it matches") - (repeat :format "%v%i\n" :inline t (regexp :tag "or")))) - :version "23.1" - :group 'vc) - -(defun vc-stay-local-p (file &optional backend) - "Return non-nil if VC should stay local when handling FILE. -This uses the `repository-hostname' backend operation. -If FILE is a list of files, return non-nil if any of them -individually should stay local." - (if (listp file) - (delq nil (mapcar (lambda (arg) (vc-stay-local-p arg backend)) file)) - (setq backend (or backend (vc-backend file))) - (let* ((sym (vc-make-backend-sym backend 'stay-local)) - (stay-local (if (boundp sym) (symbol-value sym) vc-stay-local))) - (if (symbolp stay-local) stay-local - (let ((dirname (if (file-directory-p file) - (directory-file-name file) - (file-name-directory file)))) - (eq 'yes - (or (vc-file-getprop dirname 'vc-stay-local-p) - (vc-file-setprop - dirname 'vc-stay-local-p - (let ((hostname (vc-call-backend - backend 'repository-hostname dirname))) - (if (not hostname) - 'no - (let ((default t)) - (if (eq (car-safe stay-local) 'except) - (setq default nil stay-local (cdr stay-local))) - (when (consp stay-local) - (setq stay-local - (mapconcat 'identity stay-local "\\|"))) - (if (if (string-match stay-local hostname) - default (not default)) - 'yes 'no)))))))))))) - ;;; This is handled specially now. ;; Tell Emacs about this new kind of minor mode ;; (add-to-list 'minor-mode-alist '(vc-mode vc-mode)) @@ -190,6 +173,11 @@ individually should stay local." (make-variable-buffer-local 'vc-mode) (put 'vc-mode 'permanent-local t) +;;; We signal this error when we try to do something a VC backend +;;; doesn't support. Two arguments: the method that's not supported +;;; and the backend +(define-error 'vc-not-supported "VC method not implemented for backend") + (defun vc-mode (&optional _arg) ;; Dummy function for C-h m "Version Control minor mode. @@ -268,10 +256,10 @@ It is usually called via the `vc-call' macro." (setq f (vc-find-backend-function backend function-name)) (push (cons function-name f) (get backend 'vc-functions))) (cond - ((null f) - (error "Sorry, %s is not implemented for %s" function-name backend)) - ((consp f) (apply (car f) (cdr f) args)) - (t (apply f args))))) + ((null f) + (signal 'vc-not-supported (list function-name backend))) + ((consp f) (apply (car f) (cdr f) args)) + (t (apply f args))))) (defmacro vc-call (fun file &rest args) "A convenience macro for calling VC backend functions. @@ -386,19 +374,6 @@ If the argument is a list, the files must all have the same back end." "Return where the repository for the current directory is kept." (symbol-name (vc-backend file))) -(defun vc-name (file) - "Return the master name of FILE. -If the file is not registered, or the master name is not known, return nil." - ;; TODO: This should ultimately become obsolete, at least up here - ;; in vc-hooks. - (or (vc-file-getprop file 'vc-name) - ;; force computation of the property by calling - ;; vc-BACKEND-registered explicitly - (let ((backend (vc-backend file))) - (if (and backend - (vc-call-backend backend 'registered file)) - (vc-file-getprop file 'vc-name))))) - (defun vc-checkout-model (backend files) "Indicate how FILES are checked out. @@ -509,51 +484,12 @@ status of this file. Otherwise, the value returned is one of: "Quickly recompute the `state' of FILE." (vc-file-setprop file 'vc-state - (vc-call-backend backend 'state-heuristic file))) + (vc-call-backend backend 'state file))) (defsubst vc-up-to-date-p (file) "Convenience function that checks whether `vc-state' of FILE is `up-to-date'." (eq (vc-state file) 'up-to-date)) -(defun vc-default-state-heuristic (backend file) - "Default implementation of vc-BACKEND-state-heuristic. -It simply calls the real state computation function `vc-BACKEND-state' -and does not employ any heuristic at all." - (vc-call-backend backend 'state file)) - -(defun vc-workfile-unchanged-p (file) - "Return non-nil if FILE has not changed since the last checkout." - (let ((checkout-time (vc-file-getprop file 'vc-checkout-time)) - (lastmod (nth 5 (file-attributes file)))) - ;; This is a shortcut for determining when the workfile is - ;; unchanged. It can fail under some circumstances; see the - ;; discussion in bug#694. - (if (and checkout-time - ;; Tramp and Ange-FTP return this when they don't know the time. - (not (equal lastmod '(0 0)))) - (equal checkout-time lastmod) - (let ((unchanged (vc-call workfile-unchanged-p file))) - (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0)) - unchanged)))) - -(defun vc-default-workfile-unchanged-p (backend file) - "Check if FILE is unchanged by diffing against the repository version. -Return non-nil if FILE is unchanged." - (zerop (condition-case err - ;; If the implementation supports it, let the output - ;; go to *vc*, not *vc-diff*, since this is an internal call. - (vc-call-backend backend 'diff (list file) nil nil "*vc*") - (wrong-number-of-arguments - ;; If this error came from the above call to vc-BACKEND-diff, - ;; try again without the optional buffer argument (for - ;; backward compatibility). Otherwise, resignal. - (if (or (not (eq (cadr err) - (indirect-function - (vc-find-backend-function backend 'diff)))) - (not (eq (cl-caddr err) 4))) - (signal (car err) (cdr err)) - (vc-call-backend backend 'diff (list file))))))) - (defun vc-working-revision (file &optional backend) "Return the repository version from which FILE was checked out. If FILE is not registered, this function always returns nil." @@ -579,9 +515,10 @@ If FILE is not registered, this function always returns nil." (put backend 'vc-templates-grabbed t)) (let ((result (vc-check-master-templates file (symbol-value sym)))) (if (stringp result) - (vc-file-setprop file 'vc-name result) + (vc-file-setprop file 'vc-master-name result) nil)))) ; Not registered +;;;###autoload (defun vc-possible-master (s dirname basename) (cond ((stringp s) (format s dirname basename)) @@ -795,33 +732,42 @@ This function assumes that the file is registered." (let* ((backend-name (symbol-name backend)) (state (vc-state file backend)) (state-echo nil) + (face nil) (rev (vc-working-revision file backend))) (propertize (cond ((or (eq state 'up-to-date) (eq state 'needs-update)) (setq state-echo "Up to date file") + (setq face 'vc-up-to-date-state) (concat backend-name "-" rev)) ((stringp state) (setq state-echo (concat "File locked by" state)) + (setq face 'vc-locked-state) (concat backend-name ":" state ":" rev)) ((eq state 'added) (setq state-echo "Locally added file") + (setq face 'vc-locally-added-state) (concat backend-name "@" rev)) ((eq state 'conflict) (setq state-echo "File contains conflicts after the last merge") + (setq face 'vc-conflict-state) (concat backend-name "!" rev)) ((eq state 'removed) (setq state-echo "File removed from the VC system") + (setq face 'vc-removed-state) (concat backend-name "!" rev)) ((eq state 'missing) (setq state-echo "File tracked by the VC system, but missing from the file system") + (setq face 'vc-missing-state) (concat backend-name "?" rev)) (t ;; Not just for the 'edited state, but also a fallback ;; for all other states. Think about different symbols ;; for 'needs-update and 'needs-merge. (setq state-echo "Locally modified file") + (setq face 'vc-edited-state) (concat backend-name ":" rev))) + 'face face 'help-echo (concat state-echo " under the " backend-name " version control system")))) @@ -922,7 +868,6 @@ current, and kill the buffer that visits the link." (let ((map (make-sparse-keymap))) (define-key map "a" 'vc-update-change-log) (define-key map "b" 'vc-switch-backend) - (define-key map "c" 'vc-rollback) (define-key map "d" 'vc-dir) (define-key map "g" 'vc-annotate) (define-key map "G" 'vc-ignore) @@ -941,6 +886,7 @@ current, and kill the buffer that visits the link." (define-key map "=" 'vc-diff) (define-key map "D" 'vc-root-diff) (define-key map "~" 'vc-revision-other-window) + (define-key map "x" 'vc-delete-file) map)) (fset 'vc-prefix-map vc-prefix-map) (define-key ctl-x-map "v" 'vc-prefix-map) @@ -991,13 +937,6 @@ current, and kill the buffer that visits the link." '(menu-item "Insert Header" vc-insert-headers :help "Insert headers into a file for use with a version control system. ")) - (bindings--define-key map [undo] - '(menu-item "Undo Last Check-In" vc-rollback - :enable (let ((backend (if buffer-file-name - (vc-backend buffer-file-name)))) - (or (not backend) - (vc-find-backend-function backend 'rollback))) - :help "Remove the most recent changeset committed to the repository")) (bindings--define-key map [vc-revert] '(menu-item "Revert to Base Version" vc-revert :help "Revert working copies of the selected file set to their repository contents")) diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el index aafd580a82e..d783572678c 100644 --- a/lisp/vc/vc-mtn.el +++ b/lisp/vc/vc-mtn.el @@ -79,7 +79,8 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (defun vc-mtn-checkout-model (_files) 'implicit) (defun vc-mtn-root (file) - (setq file (if (file-directory-p file) + (setq file (expand-file-name file) + file (if (file-directory-p file) (file-name-as-directory file) (file-name-directory file))) (or (vc-file-getprop file 'vc-mtn-root) @@ -126,10 +127,11 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." ((match-end 2) (push (list (match-string 3) 'added) result)))) (funcall update-function result))) -;; -dir-status called from vc-dir, which loads vc, which loads vc-dispatcher. +;; dir-status-files called from vc-dir, which loads vc, +;; which loads vc-dispatcher. (declare-function vc-exec-after "vc-dispatcher" (code)) -(defun vc-mtn-dir-status (dir update-function) +(defun vc-mtn-dir-status-files (dir _files update-function) (vc-mtn-command (current-buffer) 'async dir "status") (vc-run-delayed (vc-mtn-after-dir-status update-function))) @@ -154,9 +156,6 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (re-search-forward "\\(?:Current b\\|B\\)ranch: *\\(.*\\)\n?\nChanges against parent \\(.*\\)") (match-string 1)))) -(defun vc-mtn-workfile-unchanged-p (file) - (not (eq (vc-mtn-state file) 'edited))) - ;; Mode-line rewrite code copied from vc-arch.el. (defcustom vc-mtn-mode-line-rewrite @@ -179,15 +178,14 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (_ ?:)) branch))) -(defun vc-mtn-register (files &optional _rev _comment) +(defun vc-mtn-register (files &optional _comment) (vc-mtn-command nil 0 files "add")) (defun vc-mtn-responsible-p (file) (vc-mtn-root file)) -(defun vc-mtn-could-register (file) (vc-mtn-root file)) (declare-function log-edit-extract-headers "log-edit" (headers string)) -(defun vc-mtn-checkin (files _rev comment) +(defun vc-mtn-checkin (files comment) (apply 'vc-mtn-command nil 0 files (nconc (list "commit" "-m") (log-edit-extract-headers '(("Author" . "--author") @@ -197,16 +195,13 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (defun vc-mtn-find-revision (file rev buffer) (vc-mtn-command buffer 0 file "cat" "-r" rev)) -;; (defun vc-mtn-checkout (file &optional editable rev) +;; (defun vc-mtn-checkout (file &optional rev) ;; ) (defun vc-mtn-revert (file &optional contents-done) (unless contents-done (vc-mtn-command nil 0 file "revert"))) -;; (defun vc-mtn-rollback (files) -;; ) - (defun vc-mtn-print-log (files buffer &optional _shortlog start-revision limit) "Print commit logs associated with FILES into specified BUFFER. _SHORTLOG is ignored. @@ -241,9 +236,11 @@ If LIMIT is non-nil, show no more than this many entries." (autoload 'vc-switches "vc") -(defun vc-mtn-diff (files &optional rev1 rev2 buffer) +(defun vc-mtn-diff (files &optional rev1 rev2 buffer async) "Get a difference report using monotone between two revisions of FILES." - (apply 'vc-mtn-command (or buffer "*vc-diff*") 1 files "diff" + (apply 'vc-mtn-command (or buffer "*vc-diff*") + (if async 'async 1) + files "diff" (append (vc-switches 'mtn 'diff) (if rev1 (list "-r" rev1)) (if rev2 (list "-r" rev2))))) diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index 9bcd178cb28..d575530c98b 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -149,70 +149,18 @@ For a description of possible values, see `vc-check-master-templates'." 'vc-working-revision)))) (if (not (eq state 'up-to-date)) state - (if (vc-workfile-unchanged-p file) + (if (vc-rcs-workfile-unchanged-p file) 'up-to-date (if (eq (vc-rcs-checkout-model (list file)) 'locking) 'unlocked-changes 'edited)))))) -(defun vc-rcs-state-heuristic (file) - "State heuristic for RCS." - (let (vc-rcs-headers-result) - (if (and vc-consult-headers - (setq vc-rcs-headers-result - (vc-rcs-consult-headers file)) - (eq vc-rcs-headers-result 'rev-and-lock)) - (let ((state (vc-file-getprop file 'vc-state))) - ;; If the headers say that the file is not locked, the - ;; permissions can tell us whether locking is used for - ;; the file or not. - (if (and (eq state 'up-to-date) - (not (vc-mistrust-permissions file)) - (file-exists-p file)) - (cond - ((string-match ".rw..-..-." (nth 8 (file-attributes file))) - (vc-file-setprop file 'vc-checkout-model 'implicit) - (setq state - (if (vc-rcs-workfile-is-newer file) - 'edited - 'up-to-date))) - ((string-match ".r-..-..-." (nth 8 (file-attributes file))) - (vc-file-setprop file 'vc-checkout-model 'locking)))) - state) - (if (not (vc-mistrust-permissions file)) - (let* ((attributes (file-attributes file 'string)) - (owner-name (nth 2 attributes)) - (permissions (nth 8 attributes))) - (cond ((and permissions (string-match ".r-..-..-." permissions)) - (vc-file-setprop file 'vc-checkout-model 'locking) - 'up-to-date) - ((and permissions (string-match ".rw..-..-." permissions)) - (if (eq (vc-rcs-checkout-model file) 'locking) - (if (file-ownership-preserved-p file) - 'edited - owner-name) - (if (vc-rcs-workfile-is-newer file) - 'edited - 'up-to-date))) - (t - ;; Strange permissions. Fall through to - ;; expensive state computation. - (vc-rcs-state file)))) - (vc-rcs-state file))))) - (autoload 'vc-expand-dirs "vc") -(defun vc-rcs-dir-status (dir update-function) - ;; FIXME: this function should be rewritten or `vc-expand-dirs' - ;; should be changed to take a backend parameter. Using - ;; `vc-expand-dirs' is not TRTD because it returns files from - ;; multiple backends. It should also return 'unregistered files. - - ;; Doing individual vc-state calls is painful but there - ;; is no better way in RCS-land. - (let ((flist (vc-expand-dirs (list dir))) - (result nil)) - (dolist (file flist) +(defun vc-rcs-dir-status-files (dir files update-function) + (if (not files) (setq files (vc-expand-dirs (list dir) 'RCS))) + (let ((result nil)) + (dolist (file files) (let ((state (vc-state file)) (frel (file-relative-name file))) (when (and (eq (vc-backend file) 'RCS) @@ -229,6 +177,8 @@ For a description of possible values, see `vc-check-master-templates'." (vc-rcs-fetch-master-state file) (vc-file-getprop file 'vc-working-revision)))) +(autoload 'vc-master-name "vc-filewise") + (defun vc-rcs-latest-on-branch-p (file &optional version) "Return non-nil if workfile version of FILE is the latest on its branch. When VERSION is given, perform check for that version." @@ -238,15 +188,15 @@ When VERSION is given, perform check for that version." (if (vc-rcs-trunk-p version) (progn ;; Compare VERSION to the head version number. - (vc-insert-file (vc-name file) "^[0-9]") + (vc-insert-file (vc-master-name file) "^[0-9]") (vc-parse-buffer "^head[ \t\n]+\\([^;]+\\);" 1)) ;; If we are not on the trunk, we need to examine the ;; whole current branch. - (vc-insert-file (vc-name file) "^desc") + (vc-insert-file (vc-master-name file) "^desc") (vc-rcs-find-most-recent-rev (vc-branch-part version)))))) (defun vc-rcs-workfile-unchanged-p (file) - "RCS-specific implementation of `vc-workfile-unchanged-p'." + "Has FILE remained unchanged since last checkout?" ;; Try to use rcsdiff --brief. If rcsdiff does not understand that, ;; do a double take and remember the fact for the future (let* ((version (concat "-r" (vc-working-revision file))) @@ -274,18 +224,13 @@ When VERSION is given, perform check for that version." (autoload 'vc-switches "vc") -(defun vc-rcs-register (files &optional rev comment) +(defun vc-rcs-register (files &optional comment) "Register FILES into the RCS version-control system. -REV is the optional revision number for the files. COMMENT can be used -to provide an initial description for each FILES. +Automatically retrieve a read-only version of the file with keywords expanded. +COMMENT can be used to provide an initial description for each FILES. Passes either `vc-rcs-register-switches' or `vc-register-switches' -to the RCS command. - -Automatically retrieve a read-only version of the file with keywords -expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile." +to the RCS command." (let (subdir name) - ;; When REV is specified, we need to force using "-t-". - (when rev (unless comment (setq comment ""))) (dolist (file files) (and (not (file-exists-p (setq subdir (expand-file-name "RCS" @@ -297,7 +242,7 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile." (apply #'vc-do-command "*vc*" 0 "ci" file ;; if available, use the secure registering option (and (vc-rcs-release-p "5.6.4") "-i") - (concat (if vc-keep-workfiles "-u" "-r") rev) + "-u" (and comment (concat "-t-" comment)) (vc-switches 'RCS 'register)) ;; parse output to find master file name and workfile version @@ -309,9 +254,9 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile." (match-string 1)))) ;; if we couldn't find the master name, ;; run vc-rcs-registered to get it - ;; (will be stored into the vc-name property) + ;; (will be stored into the vc-master-name property) (vc-rcs-registered file) - (vc-file-setprop file 'vc-name + (vc-file-setprop file 'vc-master-name (if (file-name-absolute-p name) name (expand-file-name @@ -334,7 +279,7 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile." (defun vc-rcs-receive-file (file rev) "Implementation of receive-file for RCS." (let ((checkout-model (vc-rcs-checkout-model (list file)))) - (vc-rcs-register file rev "") + (vc-rcs-register file "") (when (eq checkout-model 'implicit) (vc-rcs-set-non-strict-locking file)) (vc-rcs-set-default-branch file (concat rev ".1")))) @@ -343,7 +288,7 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile." "Unregister FILE from RCS. If this leaves the RCS subdirectory empty, ask the user whether to remove it." - (let* ((master (vc-name file)) + (let* ((master (vc-master-name file)) (dir (file-name-directory master)) (backup-info (find-backup-file-name master))) (if (not backup-info) @@ -358,27 +303,31 @@ whether to remove it." (yes-or-no-p (format "Directory %s is empty; remove it? " dir)) (delete-directory dir)))) -(defun vc-rcs-checkin (files rev comment) +;; It used to be possible to pass in a value for the variable rev, but +;; nothing in the rest of VC used this capability. Removing it makes the +;; backend interface simpler for all modes. +;; +(defun vc-rcs-checkin (files comment) "RCS-specific version of `vc-backend-checkin'." - (let ((switches (vc-switches 'RCS 'checkin))) + (let (rev (switches (vc-switches 'RCS 'checkin))) ;; Now operate on the files - (dolist (file (vc-expand-dirs files)) + (dolist (file (vc-expand-dirs files 'RCS)) (let ((old-version (vc-working-revision file)) new-version (default-branch (vc-file-getprop file 'vc-rcs-default-branch))) ;; Force branch creation if an appropriate ;; default branch has been set. - (and (not rev) - default-branch + (and default-branch (string-match (concat "^" (regexp-quote old-version) "\\.") default-branch) (setq rev default-branch) (setq switches (cons "-f" switches))) - (if (and (not rev) old-version) - (setq rev (vc-branch-part old-version))) - (apply #'vc-do-command "*vc*" 0 "ci" (vc-name file) + (if old-version + (setq rev (vc-branch-part old-version)) + (error "can't find current branch")) + (apply #'vc-do-command "*vc*" 0 "ci" (vc-master-name file) ;; if available, use the secure check-in option (and (vc-rcs-release-p "5.6.4") "-j") - (concat (if vc-keep-workfiles "-u" "-r") rev) + (concat "-u" rev) (concat "-m" comment) switches) (vc-file-setprop file 'vc-working-revision nil) @@ -407,21 +356,21 @@ whether to remove it." (if (not (vc-rcs-release-p "5.6.2")) ;; exit status of 1 is also accepted. ;; It means that the lock was removed before. - (vc-do-command "*vc*" 1 "rcs" (vc-name file) + (vc-do-command "*vc*" 1 "rcs" (vc-master-name file) (concat "-u" old-version))))))))) (defun vc-rcs-find-revision (file rev buffer) (apply #'vc-do-command - (or buffer "*vc*") 0 "co" (vc-name file) + (or buffer "*vc*") 0 "co" (vc-master-name file) "-q" ;; suppress diagnostic output (concat "-p" rev) (vc-switches 'RCS 'checkout))) -(defun vc-rcs-checkout (file &optional editable rev) +(defun vc-rcs-checkout (file &optional rev) "Retrieve a copy of a saved version of FILE. If FILE is a directory, attempt the checkout for all registered files beneath it." (if (file-directory-p file) - (mapc 'vc-rcs-checkout (vc-expand-dirs (list file))) + (mapc 'vc-rcs-checkout (vc-expand-dirs (list file) 'RCS)) (let ((file-buffer (get-file-buffer file)) switches) (message "Checking out %s..." file) @@ -444,11 +393,11 @@ attempt the checkout for all registered files beneath it." (vc-rcs-set-default-branch file nil)) ;; now do the checkout (apply #'vc-do-command - "*vc*" 0 "co" (vc-name file) + "*vc*" 0 "co" (vc-master-name file) ;; If locking is not strict, force to overwrite ;; the writable workfile. (if (eq (vc-rcs-checkout-model (list file)) 'implicit) "-f") - (if editable "-l") + "-l" (if (stringp rev) ;; a literal revision was specified (concat "-r" rev) @@ -483,56 +432,44 @@ attempt the checkout for all registered files beneath it." new-version))))) (message "Checking out %s...done" file)))))) -(defun vc-rcs-rollback (files) - "Roll back, undoing the most recent checkins of FILES. Directories are -expanded to all registered subfiles in them." - (if (not files) - (error "RCS backend doesn't support directory-level rollback")) - (dolist (file (vc-expand-dirs files)) - (let* ((discard (vc-working-revision file)) - (previous (if (vc-rcs-trunk-p discard) "" (vc-branch-part discard))) - (config (current-window-configuration)) - (done nil)) - (if (null (yes-or-no-p (format "Remove version %s from %s history? " - discard file))) - (error "Aborted")) - (message "Removing revision %s from %s." discard file) - (vc-do-command "*vc*" 0 "rcs" (vc-name file) (concat "-o" discard)) - ;; Check out the most recent remaining version. If it - ;; fails, because the whole branch got deleted, do a - ;; double-take and check out the version where the branch - ;; started. - (while (not done) - (condition-case err - (progn - (vc-do-command "*vc*" 0 "co" (vc-name file) "-f" - (concat "-u" previous)) - (setq done t)) - (error (set-buffer "*vc*") - (goto-char (point-min)) - (if (search-forward "no side branches present for" nil t) - (progn (setq previous (vc-branch-part previous)) - (vc-rcs-set-default-branch file previous) - ;; vc-do-command popped up a window with - ;; the error message. Get rid of it, by - ;; restoring the old window configuration. - (set-window-configuration config)) - ;; No, it was some other error: re-signal it. - (signal (car err) (cdr err))))))))) - (defun vc-rcs-revert (file &optional _contents-done) "Revert FILE to the version it was based on. If FILE is a directory, revert all registered files beneath it." (if (file-directory-p file) - (mapc 'vc-rcs-revert (vc-expand-dirs (list file))) - (vc-do-command "*vc*" 0 "co" (vc-name file) "-f" + (mapc 'vc-rcs-revert (vc-expand-dirs (list file) 'RCS)) + (vc-do-command "*vc*" 0 "co" (vc-master-name file) "-f" (concat (if (eq (vc-state file) 'edited) "-u" "-r") (vc-working-revision file))))) +(defun vc-rcs-merge-file (file) + "Accept a file merge request, prompting for revisions." + (let* ((first-revision + (vc-read-revision + (concat "Merge " file " from branch or revision: ") + (list file) + 'RCS)) + second-revision) + (cond + ((string= first-revision "") + (error "A starting RCS revision is required")) + (t + (if (not (vc-branch-p first-revision)) + (setq second-revision + (vc-read-revision + "Second RCS revision: " + (list file) 'RCS nil + (concat (vc-branch-part first-revision) "."))) + ;; We want to merge an entire branch. Set revisions + ;; accordingly, so that vc-rcs-merge understands us. + (setq second-revision first-revision) + ;; first-revision must be the starting point of the branch + (setq first-revision (vc-branch-part first-revision))))) + (vc-rcs-merge file first-revision second-revision))) + (defun vc-rcs-merge (file first-version &optional second-version) "Merge changes into current working copy of FILE. The changes are between FIRST-VERSION and SECOND-VERSION." - (vc-do-command "*vc*" 1 "rcsmerge" (vc-name file) + (vc-do-command "*vc*" 1 "rcsmerge" (vc-master-name file) "-kk" ; ignore keyword conflicts (concat "-r" first-version) (if second-version (concat "-r" second-version)))) @@ -542,17 +479,32 @@ The changes are between FIRST-VERSION and SECOND-VERSION." If FILE is a directory, steal the lock on all registered files beneath it. Needs RCS 5.6.2 or later for -M." (if (file-directory-p file) - (mapc 'vc-rcs-steal-lock (vc-expand-dirs (list file))) - (vc-do-command "*vc*" 0 "rcs" (vc-name file) "-M" (concat "-u" rev)) + (mapc 'vc-rcs-steal-lock (vc-expand-dirs (list file) 'RCS)) + (vc-do-command "*vc*" 0 "rcs" (vc-master-name file) "-M" (concat "-u" rev)) ;; Do a real checkout after stealing the lock, so that we see ;; expanded headers. - (vc-do-command "*vc*" 0 "co" (vc-name file) "-f" (concat "-l" rev)))) + (vc-do-command "*vc*" 0 "co" (vc-master-name file) "-f" (concat "-l" rev)) + ;; Must clear any headers here because they wouldn't + ;; show that the file is locked now. + (let* ((filename (or file buffer-file-name)) + (visited (find-buffer-visiting filename))) + (if visited + (let ((context (vc-buffer-context))) + ;; save-excursion may be able to relocate point and mark + ;; properly. If it fails, vc-restore-buffer-context + ;; will give it a second try. + (save-excursion + (vc-rcs-clear-headers)) + (vc-restore-buffer-context context)) + (set-buffer (find-file-noselect filename)) + (vc-rcs-clear-headers) + (kill-buffer filename))))) (defun vc-rcs-modify-change-comment (files rev comment) "Modify the change comments change on FILES on a specified REV. If FILE is a directory the operation is applied to all registered files beneath it." - (dolist (file (vc-expand-dirs files)) - (vc-do-command "*vc*" 0 "rcs" (vc-name file) + (dolist (file (vc-expand-dirs files 'RCS)) + (vc-do-command "*vc*" 0 "rcs" (vc-master-name file) (concat "-m" rev ":" comment)))) @@ -578,16 +530,16 @@ Remaining arguments are ignored. If FILE is a directory the operation is applied to all registered files beneath it." (vc-do-command (or buffer "*vc*") 0 "rlog" - (mapcar 'vc-name (vc-expand-dirs files))) + (mapcar 'vc-master-name (vc-expand-dirs files 'RCS))) (with-current-buffer (or buffer "*vc*") (vc-rcs-print-log-cleanup)) (when limit 'limit-unsupported)) -(defun vc-rcs-diff (files &optional oldvers newvers buffer) +(defun vc-rcs-diff (files &optional oldvers newvers buffer async) "Get a difference report using RCS between two sets of files." (apply #'vc-do-command (or buffer "*vc-diff*") - 1 ;; Always go synchronous, the repo is local - "rcsdiff" (vc-expand-dirs files) + (if async 'async 1) + "rcsdiff" (vc-expand-dirs files 'RCS) (append (list "-q" (and oldvers (concat "-r" oldvers)) (and newvers (concat "-r" newvers))) @@ -811,7 +763,7 @@ Optional arg REVISION is a revision to annotate from." "Return the current time, based at midnight of the current day, and encoded as fractional days." (vc-annotate-convert-time - (apply #'encode-time 0 0 0 (nthcdr 3 (decode-time (current-time)))))) + (apply #'encode-time 0 0 0 (nthcdr 3 (decode-time))))) (defun vc-rcs-annotate-time () "Return the time of the next annotation (as fraction of days) @@ -841,7 +793,7 @@ systime, or nil if there is none. Also, reposition point." (vc-file-tree-walk dir (lambda (f) - (vc-do-command "*vc*" 0 "rcs" (vc-name f) (concat "-n" name ":"))))))) + (vc-do-command "*vc*" 0 "rcs" (vc-master-name f) (concat "-n" name ":"))))))) ;;; @@ -961,7 +913,7 @@ Uses `rcs2log' which only works for RCS and CVS." \\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t))) (defun vc-rcs-clear-headers () - "Implementation of vc-clear-headers for RCS." + "Clear RCS header value parts." (let ((case-fold-search nil)) (goto-char (point-min)) (while (re-search-forward @@ -970,11 +922,11 @@ Uses `rcs2log' which only works for RCS and CVS." nil t) (replace-match "$\\1$")))) -(autoload 'vc-rename-master "vc") +(autoload 'vc-rename-master "vc-filewise") (defun vc-rcs-rename-file (old new) ;; Just move the master file (using vc-rcs-master-templates). - (vc-rename-master (vc-name old) new vc-rcs-master-templates)) + (vc-rename-master (vc-master-name old) new vc-rcs-master-templates)) (defun vc-rcs-find-file-hook () ;; If the file is locked by some other user, make @@ -993,7 +945,7 @@ Uses `rcs2log' which only works for RCS and CVS." This likely means that FILE has been changed with respect to its master version." (let ((file-time (nth 5 (file-attributes file))) - (master-time (nth 5 (file-attributes (vc-name file))))) + (master-time (nth 5 (file-attributes (vc-master-name file))))) (or (> (nth 0 file-time) (nth 0 master-time)) (and (= (nth 0 file-time) (nth 0 master-time)) (> (nth 1 file-time) (nth 1 master-time)))))) @@ -1020,10 +972,10 @@ This function sets the properties `vc-working-revision' and `vc-checkout-model' to their correct values, based on the master file." (with-temp-buffer - (if (or (not (vc-insert-file (vc-name file) "^[0-9]")) + (if (or (not (vc-insert-file (vc-master-name file) "^[0-9]")) (progn (goto-char (point-min)) (not (looking-at "^head[ \t\n]+[^;]+;$")))) - (error "File %s is not an RCS master file" (vc-name file))) + (error "File %s is not an RCS master file" (vc-master-name file))) (let ((workfile-is-latest nil) (default-branch (vc-parse-buffer "^branch[ \t\n]+\\([^;]*\\);" 1))) (vc-file-setprop file 'vc-rcs-default-branch default-branch) @@ -1043,7 +995,7 @@ file." default-branch) (setq working-revision default-branch)) ;; else, search for the head of the default branch - (t (vc-insert-file (vc-name file) "^desc") + (t (vc-insert-file (vc-master-name file) "^desc") (setq working-revision (vc-rcs-find-most-recent-rev default-branch)) (setq workfile-is-latest t))) @@ -1096,7 +1048,7 @@ Returns: nil if no headers were found 'rev-and-lock if revision and lock info was found" (cond ((not (get-file-buffer file)) nil) - ((let (status version locking-user) + ((let (status version) (with-current-buffer (get-file-buffer file) (save-excursion (goto-char (point-min)) @@ -1122,11 +1074,11 @@ Returns: nil if no headers were found (cond ;; unlocked revision ((looking-at "\\$") - (setq locking-user 'none) + ;;(setq locking-user 'none) (setq status 'rev-and-lock)) ;; revision is locked by some user ((looking-at "\\([^ ]+\\) \\$") - (setq locking-user (match-string-no-properties 1)) + ;;(setq locking-user (match-string-no-properties 1)) (setq status 'rev-and-lock)) ;; everything else: false (nil))) @@ -1144,39 +1096,19 @@ Returns: nil if no headers were found (goto-char (point-min)) (if (re-search-forward (concat "\\$" "Locker:") nil t) (cond ((looking-at " \\([^ ]+\\) \\$") - (setq locking-user (match-string-no-properties 1)) + ;;(setq locking-user (match-string-no-properties 1)) (setq status 'rev-and-lock)) ((looking-at " *\\$") - (setq locking-user 'none) + ;;(setq locking-user 'none) (setq status 'rev-and-lock)) (t - (setq locking-user 'none) + ;;(setq locking-user 'none) (setq status 'rev-and-lock))) (setq status 'rev))) ;; else: nothing found ;; ------------------- (t nil)))) (if status (vc-file-setprop file 'vc-working-revision version)) - (and (eq status 'rev-and-lock) - (vc-file-setprop file 'vc-state - (cond - ((eq locking-user 'none) 'up-to-date) - ((string= locking-user (vc-user-login-name file)) - 'edited) - (t locking-user))) - ;; If the file has headers, we don't want to query the - ;; master file, because that would eliminate all the - ;; performance gain the headers brought us. We therefore - ;; use a heuristic now to find out whether locking is used - ;; for this file. If we trust the file permissions, and the - ;; file is not locked, then if the file is read-only we - ;; assume that locking is used for the file, otherwise - ;; locking is not used. - (not (vc-mistrust-permissions file)) - (vc-up-to-date-p file) - (if (string-match ".r-..-..-." (nth 8 (file-attributes file))) - (vc-file-setprop file 'vc-checkout-model 'locking) - (vc-file-setprop file 'vc-checkout-model 'implicit))) status)))) (defun vc-release-greater-or-equal (r1 r2) @@ -1234,7 +1166,7 @@ variable `vc-rcs-release' is set to the returned value." (set-file-modes file (logior (file-modes file) 128))) (defun vc-rcs-set-default-branch (file branch) - (vc-do-command "*vc*" 0 "rcs" (vc-name file) (concat "-b" branch)) + (vc-do-command "*vc*" 0 "rcs" (vc-master-name file) (concat "-b" branch)) (vc-file-setprop file 'vc-rcs-default-branch branch)) (defun vc-rcs-parse (&optional buffer) diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el index 60fa9c1c29f..1b959e22e23 100644 --- a/lisp/vc/vc-sccs.el +++ b/lisp/vc/vc-sccs.el @@ -124,7 +124,7 @@ For a description of possible values, see `vc-check-master-templates'." (working-revision (vc-working-revision file)) (locking-user (cdr (assoc working-revision locks)))) (if (not locking-user) - (if (vc-workfile-unchanged-p file) + (if (vc-sccs-workfile-unchanged-p file) 'up-to-date 'unlocked-changes) (if (string= locking-user (vc-user-login-name file)) @@ -132,41 +132,12 @@ For a description of possible values, see `vc-check-master-templates'." locking-user))) 'up-to-date)))) -(defun vc-sccs-state-heuristic (file) - "SCCS-specific state heuristic." - (if (not (vc-mistrust-permissions file)) - ;; This implementation assumes that any file which is under version - ;; control and has -rw-r--r-- is locked by its owner. This is true - ;; for both RCS and SCCS, which keep unlocked files at -r--r--r--. - ;; We have to be careful not to exclude files with execute bits on; - ;; scripts can be under version control too. Also, we must ignore the - ;; group-read and other-read bits, since paranoid users turn them off. - (let* ((attributes (file-attributes file 'string)) - (owner-name (nth 2 attributes)) - (permissions (nth 8 attributes))) - (if (string-match ".r-..-..-." permissions) - 'up-to-date - (if (string-match ".rw..-..-." permissions) - (if (file-ownership-preserved-p file) - 'edited - owner-name) - ;; Strange permissions. - ;; Fall through to real state computation. - (vc-sccs-state file)))) - (vc-sccs-state file))) - (autoload 'vc-expand-dirs "vc") -(defun vc-sccs-dir-status (dir update-function) - ;; FIXME: this function should be rewritten, using `vc-expand-dirs' - ;; is not TRTD because it returns files from multiple backends. - ;; It should also return 'unregistered files. - - ;; Doing lots of individual VC-state calls is painful, but - ;; there is no better option in SCCS-land. - (let ((flist (vc-expand-dirs (list dir))) - (result nil)) - (dolist (file flist) +(defun vc-sccs-dir-status-files (dir files update-function) + (if (not files) (setq files (vc-expand-dirs (list dir) 'RCS))) + (let ((result nil)) + (dolist (file files) (let ((state (vc-state file)) (frel (file-relative-name file))) (when (and (eq (vc-backend file) 'SCCS) @@ -174,6 +145,8 @@ For a description of possible values, see `vc-check-master-templates'." (push (list frel state) result)))) (funcall update-function result))) +(autoload 'vc-master-name "vc-filewise") + (defun vc-sccs-working-revision (file) "SCCS-specific version of `vc-working-revision'." (with-temp-buffer @@ -181,7 +154,7 @@ For a description of possible values, see `vc-check-master-templates'." ;; To find this number, search the entire delta table, ;; rather than just the first entry, because the ;; first entry might be a deleted ("R") revision. - (vc-insert-file (vc-name file) "^\001e\n\001[^s]") + (vc-insert-file (vc-master-name file) "^\001e\n\001[^s]") (vc-parse-buffer "^\001d D \\([^ ]+\\)" 1))) ;; Cf vc-sccs-find-revision. @@ -189,13 +162,13 @@ For a description of possible values, see `vc-check-master-templates'." "Write the SCCS version of input file FILE to output file OUTFILE. Optional string REV is a revision." (with-temp-buffer - (apply 'vc-sccs-do-command t 0 "get" (vc-name file) + (apply 'vc-sccs-do-command t 0 "get" (vc-master-name file) (append '("-s" "-p" "-k") ; -k: no keyword expansion (if rev (list (concat "-r" rev))))) (write-region nil nil outfile nil 'silent))) (defun vc-sccs-workfile-unchanged-p (file) - "SCCS-specific implementation of `vc-workfile-unchanged-p'." + "Has FILE remained unchanged since last checkout?" (let ((tempfile (make-temp-file "vc-sccs"))) (unwind-protect (progn @@ -220,31 +193,26 @@ Optional string REV is a revision." (autoload 'vc-switches "vc") -(defun vc-sccs-register (files &optional rev comment) +(defun vc-sccs-register (files &optional comment) "Register FILES into the SCCS version-control system. -REV is the optional revision number for the file. COMMENT can be used -to provide an initial description of FILES. +Automatically retrieve a read-only version of the files with keywords expanded. +COMMENT can be used to provide an initial description of FILES. Passes either `vc-sccs-register-switches' or `vc-register-switches' -to the SCCS command. - -Automatically retrieve a read-only version of the files with keywords -expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile." +to the SCCS command." (dolist (file files) (let* ((dirname (or (file-name-directory file) "")) (basename (file-name-nondirectory file)) (project-file (vc-sccs-search-project-dir dirname basename))) - (let ((vc-name + (let ((vc-master-name (or project-file (format (car vc-sccs-master-templates) dirname basename)))) - (apply 'vc-sccs-do-command nil 0 "admin" vc-name - (and rev (not (string= rev "")) (concat "-r" rev)) + (apply 'vc-sccs-do-command nil 0 "admin" vc-master-name "-fb" (concat "-i" (file-relative-name file)) (and comment (concat "-y" comment)) (vc-switches 'SCCS 'register))) (delete-file file) - (if vc-keep-workfiles - (vc-sccs-do-command nil 0 "get" (vc-name file)))))) + (vc-sccs-do-command nil 0 "get" (vc-master-name file))))) (defun vc-sccs-responsible-p (file) "Return non-nil if SCCS thinks it would be responsible for registering FILE." @@ -253,19 +221,17 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile." (stringp (vc-sccs-search-project-dir (or (file-name-directory file) "") (file-name-nondirectory file))))) -(defun vc-sccs-checkin (files rev comment) +(defun vc-sccs-checkin (files comment) "SCCS-specific version of `vc-backend-checkin'." - (dolist (file (vc-expand-dirs files)) - (apply 'vc-sccs-do-command nil 0 "delta" (vc-name file) - (if rev (concat "-r" rev)) + (dolist (file (vc-expand-dirs files 'SCCS)) + (apply 'vc-sccs-do-command nil 0 "delta" (vc-master-name file) (concat "-y" comment) (vc-switches 'SCCS 'checkin)) - (if vc-keep-workfiles - (vc-sccs-do-command nil 0 "get" (vc-name file))))) + (vc-sccs-do-command nil 0 "get" (vc-master-name file)))) (defun vc-sccs-find-revision (file rev buffer) (apply 'vc-sccs-do-command - buffer 0 "get" (vc-name file) + buffer 0 "get" (vc-master-name file) "-s" ;; suppress diagnostic output "-p" (and rev @@ -273,13 +239,13 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile." (vc-sccs-lookup-triple file rev))) (vc-switches 'SCCS 'checkout))) -(defun vc-sccs-checkout (file &optional editable rev) +(defun vc-sccs-checkout (file &optional rev) "Retrieve a copy of a saved revision of SCCS controlled FILE. If FILE is a directory, all version-controlled files beneath are checked out. EDITABLE non-nil means that the file should be writable and locked. REV is the revision to check out." (if (file-directory-p file) - (mapc 'vc-sccs-checkout (vc-expand-dirs (list file))) + (mapc 'vc-sccs-checkout (vc-expand-dirs (list file) 'SCCS)) (let ((file-buffer (get-file-buffer file)) switches) (message "Checking out %s..." file) @@ -299,35 +265,19 @@ locked. REV is the revision to check out." (and rev (or (string= rev "") (not (stringp rev))) (setq rev nil)) - (apply 'vc-sccs-do-command nil 0 "get" (vc-name file) - (if editable "-e") + (apply 'vc-sccs-do-command nil 0 "get" (vc-master-name file) + "-e" (and rev (concat "-r" (vc-sccs-lookup-triple file rev))) switches)))) (message "Checking out %s...done" file)))) -(defun vc-sccs-rollback (files) - "Roll back, undoing the most recent checkins of FILES. Directories -are expanded to all version-controlled subfiles." - (setq files (vc-expand-dirs files)) - (if (not files) - (error "SCCS backend doesn't support directory-level rollback")) - (dolist (file files) - (let ((discard (vc-working-revision file))) - (if (null (yes-or-no-p (format "Remove version %s from %s history? " - discard file))) - (error "Aborted")) - (message "Removing revision %s from %s..." discard file) - (vc-sccs-do-command nil 0 "rmdel" - (vc-name file) (concat "-r" discard)) - (vc-sccs-do-command nil 0 "get" (vc-name file) nil)))) - (defun vc-sccs-revert (file &optional _contents-done) "Revert FILE to the version it was based on. If FILE is a directory, revert all subfiles." (if (file-directory-p file) - (mapc 'vc-sccs-revert (vc-expand-dirs (list file))) - (vc-sccs-do-command nil 0 "unget" (vc-name file)) - (vc-sccs-do-command nil 0 "get" (vc-name file)) + (mapc 'vc-sccs-revert (vc-expand-dirs (list file) 'SCCS)) + (vc-sccs-do-command nil 0 "unget" (vc-master-name file)) + (vc-sccs-do-command nil 0 "get" (vc-master-name file)) ;; Checking out explicit revisions is not supported under SCCS, yet. ;; We always "revert" to the latest revision; therefore ;; vc-working-revision is cleared here so that it gets recomputed. @@ -336,16 +286,16 @@ revert all subfiles." (defun vc-sccs-steal-lock (file &optional rev) "Steal the lock on the current workfile for FILE and revision REV." (if (file-directory-p file) - (mapc 'vc-sccs-steal-lock (vc-expand-dirs (list file))) + (mapc 'vc-sccs-steal-lock (vc-expand-dirs (list file) 'SCCS)) (vc-sccs-do-command nil 0 "unget" - (vc-name file) "-n" (if rev (concat "-r" rev))) + (vc-master-name file) "-n" (if rev (concat "-r" rev))) (vc-sccs-do-command nil 0 "get" - (vc-name file) "-g" (if rev (concat "-r" rev))))) + (vc-master-name file) "-g" (if rev (concat "-r" rev))))) (defun vc-sccs-modify-change-comment (files rev comment) "Modify (actually, append to) the change comments for FILES on a specified REV." - (dolist (file (vc-expand-dirs files)) - (vc-sccs-do-command nil 0 "cdc" (vc-name file) + (dolist (file (vc-expand-dirs files 'SCCS)) + (vc-sccs-do-command nil 0 "cdc" (vc-master-name file) (concat "-y" comment) (concat "-r" rev)))) @@ -356,8 +306,8 @@ revert all subfiles." (defun vc-sccs-print-log (files buffer &optional _shortlog _start-revision-ignored limit) "Print commit log associated with FILES into specified BUFFER. Remaining arguments are ignored." - (setq files (vc-expand-dirs files)) - (vc-sccs-do-command buffer 0 "prs" (mapcar 'vc-name files)) + (setq files (vc-expand-dirs files 'SCCS)) + (vc-sccs-do-command buffer 0 "prs" (mapcar 'vc-master-name files)) (when limit 'limit-unsupported)) (autoload 'vc-setup-buffer "vc-dispatcher") @@ -366,9 +316,9 @@ Remaining arguments are ignored." (defvar w32-quote-process-args) ;; FIXME use sccsdiff if present? -(defun vc-sccs-diff (files &optional oldvers newvers buffer) +(defun vc-sccs-diff (files &optional oldvers newvers buffer _async) "Get a difference report using SCCS between two filesets." - (setq files (vc-expand-dirs files)) + (setq files (vc-expand-dirs files 'SCCS)) (setq oldvers (vc-sccs-lookup-triple (car files) oldvers)) (setq newvers (vc-sccs-lookup-triple (car files) newvers)) (or buffer (setq buffer "*vc-diff*")) @@ -472,16 +422,16 @@ Remaining arguments are ignored." (goto-char (point-min)) (re-search-forward "%[A-Z]%" nil t))) -(autoload 'vc-rename-master "vc") +(autoload 'vc-rename-master "vc-filewise") (defun vc-sccs-rename-file (old new) ;; Move the master file (using vc-rcs-master-templates). - (vc-rename-master (vc-name old) new vc-sccs-master-templates) + (vc-rename-master (vc-master-name old) new vc-sccs-master-templates) ;; Update the tag file. (with-current-buffer (find-file-noselect (expand-file-name vc-sccs-name-assoc-file - (file-name-directory (vc-name old)))) + (file-name-directory (vc-master-name old)))) (goto-char (point-min)) ;; (replace-regexp (concat ":" (regexp-quote old) "$") (concat ":" new)) (while (re-search-forward (concat ":" (regexp-quote old) "$") nil t) @@ -525,7 +475,7 @@ find any project directory." (defun vc-sccs-lock-file (file) "Generate lock file name corresponding to FILE." - (let ((master (vc-name file))) + (let ((master (vc-master-name file))) (and master (string-match "\\(.*/\\)\\(s\\.\\)\\(.*\\)" master) @@ -547,7 +497,7 @@ The result is a list of the form ((REVISION . USER) (REVISION . USER) ...)." (with-current-buffer (find-file-noselect (expand-file-name vc-sccs-name-assoc-file - (file-name-directory (vc-name file)))) + (file-name-directory (vc-master-name file)))) (goto-char (point-max)) (insert name "\t:\t" file "\t" rev "\n") (basic-save-buffer) @@ -563,7 +513,7 @@ If NAME is nil or a revision number string it's just passed through." (with-temp-buffer (vc-insert-file (expand-file-name vc-sccs-name-assoc-file - (file-name-directory (vc-name file)))) + (file-name-directory (vc-master-name file)))) (vc-parse-buffer (concat name "\t:\t" file "\t\\(.+\\)") 1)))) (provide 'vc-sccs) diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el new file mode 100644 index 00000000000..f497f951005 --- /dev/null +++ b/lisp/vc/vc-src.el @@ -0,0 +1,313 @@ +;;; vc-src.el --- support for SRC version-control -*- lexical-binding:t -*- + +;; Copyright (C) 1992-2015 Free Software Foundation, Inc. + +;; Author: FSF (see vc.el for full credits) +;; Maintainer: Eric S. Raymond <esr@thyrsus.com> +;; Package: vc + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; See vc.el. SRC requires an underlying RCS version of 4.0 or greater. + +;; FUNCTION NAME STATUS +;; BACKEND PROPERTIES +;; * revision-granularity OK +;; STATE-QUERYING FUNCTIONS +;; * registered (file) OK +;; * state (file) OK +;; - dir-status-files (dir files uf) OK +;; - dir-extra-headers (dir) NOT NEEDED +;; - dir-printer (fileinfo) ?? +;; * working-revision (file) OK +;; * checkout-model (files) OK +;; - mode-line-string (file) NOT NEEDED +;; STATE-CHANGING FUNCTIONS +;; * register (files &optional rev comment) OK +;; * create-repo () OK +;; * responsible-p (file) OK +;; - receive-file (file rev) NOT NEEDED +;; - unregister (file) NOT NEEDED +;; * checkin (files comment) OK +;; * find-revision (file rev buffer) OK +;; * checkout (file &optional rev) OK +;; * revert (file &optional contents-done) OK +;; - merge (file rev1 rev2) NOT NEEDED +;; - merge-news (file) NOT NEEDED +;; - steal-lock (file &optional revision) NOT NEEDED +;; HISTORY FUNCTIONS +;; * print-log (files buffer &optional shortlog start-revision limit) OK +;; - log-view-mode () ?? +;; - show-log-entry (revision) NOT NEEDED +;; - comment-history (file) NOT NEEDED +;; - update-changelog (files) NOT NEEDED +;; * diff (files &optional rev1 rev2 buffer) OK +;; - revision-completion-table (files) ?? +;; - annotate-command (file buf &optional rev) ?? +;; - annotate-time () ?? +;; - annotate-current-time () NOT NEEDED +;; - annotate-extract-revision-at-line () ?? +;; TAG SYSTEM +;; - create-tag (dir name branchp) ?? +;; - retrieve-tag (dir name update) ?? +;; MISCELLANEOUS +;; - make-version-backups-p (file) ?? +;; - previous-revision (file rev) ?? +;; - next-revision (file rev) ?? +;; - check-headers () ?? +;; - delete-file (file) ?? +;; * rename-file (old new) OK +;; - find-file-hook () NOT NEEDED + + +;;; Code: + +;;; +;;; Customization options +;;; + +(eval-when-compile + (require 'cl-lib) + (require 'vc)) + +(defgroup vc-src nil + "VC SRC backend." + :version "25.1" + :group 'vc) + +(defcustom vc-src-release nil + "The release number of your SRC installation, as a string. +If nil, VC itself computes this value when it is first needed." + :type '(choice (const :tag "Auto" nil) + (string :tag "Specified") + (const :tag "Unknown" unknown)) + :group 'vc-src) + +(defcustom vc-src-program "src" + "Name of the SRC executable (excluding any arguments)." + :type 'string + :group 'vc-src) + +(defcustom vc-src-diff-switches nil + "String or list of strings specifying switches for SRC diff under VC. +If nil, use the value of `vc-diff-switches'. If t, use no switches." + :type '(choice (const :tag "Unspecified" nil) + (const :tag "None" t) + (string :tag "Argument String") + (repeat :tag "Argument List" :value ("") string)) + :group 'vc-src) + +;; This needs to be autoloaded because vc-src-registered uses it (via +;; vc-default-registered), and vc-hooks needs to be able to check +;; for a registered backend without loading every backend. +;;;###autoload +(defcustom vc-src-master-templates + (purecopy '("%s.src/%s,v")) + "Where to look for SRC master files. +For a description of possible values, see `vc-check-master-templates'." + :type '(choice (const :tag "Use standard SRC file names" + '("%s.src/%s,v")) + (repeat :tag "User-specified" + (choice string + function))) + :group 'vc-src) + + +;;; Properties of the backend + +(defun vc-src-revision-granularity () 'file) +(defun vc-src-checkout-model (_files) 'implicit) + +;;; +;;; State-querying functions +;;; + +;; The autoload cookie below places vc-src-registered directly into +;; loaddefs.el, so that vc-src.el does not need to be loaded for +;; every file that is visited. +;;;###autoload +(progn +(defun vc-src-registered (f) (vc-default-registered 'src f))) + +(defun vc-src-state (file) + "SRC-specific version of `vc-state'." + (let* + ((status nil) + (default-directory (file-name-directory file)) + (out + (with-output-to-string + (with-current-buffer + standard-output + (setq status + ;; Ignore all errors. + (condition-case nil + (process-file + vc-src-program nil t nil + "status" "-a" (file-relative-name file)) + (error nil))))))) + (when (eq 0 status) + (when (null (string-match "does not exist or is unreadable" out)) + (let ((state (aref out 0))) + (cond + ;; FIXME: What to do about A and L codes? + ((eq state ?.) 'up-to-date) + ((eq state ?A) 'added) + ((eq state ?M) 'edited) + ((eq state ?I) 'ignored) + ((eq state ?R) 'removed) + ((eq state ?!) 'missing) + ((eq state ??) 'unregistered) + (t 'up-to-date))))))) + +(autoload 'vc-expand-dirs "vc") + +(defun vc-src-dir-status-files (dir files update-function) + ;; FIXME: Use one src status -a call for this + (if (not files) (setq files (vc-expand-dirs (list dir) 'RCS))) + (let ((result nil)) + (dolist (file files) + (let ((state (vc-state file)) + (frel (file-relative-name file))) + (when (and (eq (vc-backend file) 'SRC) + (not (eq state 'up-to-date))) + (push (list frel state) result)))) + (funcall update-function result))) + +(defun vc-src-command (buffer file-or-list &rest flags) + "A wrapper around `vc-do-command' for use in vc-src.el. +This function differs from vc-do-command in that it invokes `vc-src-program'." + (let (file-list) + (cond ((stringp file-or-list) + (setq file-list (list "--" file-or-list))) + (file-or-list + (setq file-list (cons "--" file-or-list)))) + (apply 'vc-do-command (or buffer "*vc*") 0 vc-src-program file-list flags))) + +(defun vc-src-working-revision (file) + "SRC-specific version of `vc-working-revision'." + (or (ignore-errors + (with-output-to-string + (vc-src-command standard-output file "list" "-f{1}" "@"))) + "0")) + +;;; +;;; State-changing functions +;;; + +(defun vc-src-create-repo () + "Create a new SRC repository." + ;; SRC is totally file-oriented, so all we have to do is make the directory. + (make-directory ".src")) + +(autoload 'vc-switches "vc") + +(defun vc-src-register (files &optional _comment) + "Register FILES under src. COMMENT is ignored." + (vc-src-command nil files "add")) + +(defun vc-src-responsible-p (file) + "Return non-nil if SRC thinks it would be responsible for registering FILE." + (file-directory-p (expand-file-name ".src" + (if (file-directory-p file) + file + (file-name-directory file))))) + +(defun vc-src-checkin (files comment) + "SRC-specific version of `vc-backend-checkin'. +REV is ignored." + (vc-src-command nil files "commit" "-m" comment)) + +(defun vc-src-find-revision (file rev buffer) + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary)) + (if rev + (vc-src-command buffer file "cat" rev) + (vc-src-command buffer file "cat")))) + +(defun vc-src-checkout (file &optional rev) + "Retrieve a revision of FILE. +REV is the revision to check out into WORKFILE." + (if rev + (vc-src-command nil file "co" rev) + (vc-src-command nil file "co"))) + +(defun vc-src-revert (file &optional _contents-done) + "Revert FILE to the version it was based on. If FILE is a directory, +revert all registered files beneath it." + (if (file-directory-p file) + (mapc 'vc-src-revert (vc-expand-dirs (list file) 'SRC)) + (vc-src-command nil file "co"))) + +(defun vc-src-modify-change-comment (files rev comment) + "Modify the change comments change on FILES on a specified REV. If FILE is a +directory the operation is applied to all registered files beneath it." + (dolist (file (vc-expand-dirs files 'SRC)) + (vc-src-command nil file "amend" "-m" comment rev))) + +;; History functions + +(defcustom vc-src-log-switches nil + "String or list of strings specifying switches for src log under VC." + :type '(choice (const :tag "None" nil) + (string :tag "Argument String") + (repeat :tag "Argument List" :value ("") string)) + :group 'vc-src) + +(defun vc-src-print-log (files buffer &optional shortlog _start-revision limit) + "Print commit log associated with FILES into specified BUFFER. +If SHORTLOG is non-nil, use the list method. +If START-REVISION is non-nil, it is the newest revision to show. +If LIMIT is non-nil, show no more than this many entries." + ;; FIXME: Implement the range restrictions. + ;; `vc-do-command' creates the buffer, but we need it before running + ;; the command. + (vc-setup-buffer buffer) + ;; If the buffer exists from a previous invocation it might be + ;; read-only. + (let ((inhibit-read-only t)) + (with-current-buffer + buffer + (apply 'vc-src-command buffer files (if shortlog "list" "log") + (nconc + ;;(when start-revision (list (format "%s-1" start-revision))) + (when limit (list "-l" (format "%s" limit))) + vc-src-log-switches))))) + +(defun vc-src-diff (files &optional oldvers newvers buffer _async) + "Get a difference report using src between two revisions of FILES." + (let* ((firstfile (car files)) + (working (and firstfile (vc-working-revision firstfile)))) + (when (and (equal oldvers working) (not newvers)) + (setq oldvers nil)) + (when (and (not oldvers) newvers) + (setq oldvers working)) + (apply #'vc-src-command (or buffer "*vc-diff*") files "diff" + (when oldvers + (if newvers + (list (concat oldvers "-" newvers)) + (list oldvers)))))) + +;; Miscellaneous + +(defun vc-src-rename-file (old new) + "Rename file from OLD to NEW using `src mv'." + (vc-src-command nil 0 new "mv" old)) + +(provide 'vc-src) + +;;; vc-src.el ends here diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index bed2727ab6c..d74daf9c36f 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -135,6 +135,7 @@ If you want to force an empty list of arguments, use t." (defun vc-svn-registered (file) "Check if FILE is SVN registered." + (setq file (expand-file-name file)) (when (vc-svn-root file) (with-temp-buffer (cd (file-name-directory file)) @@ -153,36 +154,17 @@ If you want to force an empty list of arguments, use t." (let ((parsed (vc-svn-parse-status file))) (and parsed (not (memq parsed '(ignored unregistered)))))))))) -(defun vc-svn-state (file &optional localp) +(defun vc-svn-state (file) "SVN-specific version of `vc-state'." (let (process-file-side-effects) - (setq localp (or localp (vc-stay-local-p file 'SVN))) (with-temp-buffer (cd (file-name-directory file)) - (vc-svn-command t 0 file "status" (if localp "-v" "-u")) + (vc-svn-command t 0 file "status" "-v") (vc-svn-parse-status file)))) -;; NB this does not handle svn properties, which can be changed -;; without changing the file timestamp. -;; Note that unlike vc-cvs-state-heuristic, this is not called from -;; vc-svn-state. AFAICS, it is only called from vc-state-refresh via -;; vc-after-save (bug#7850). Therefore the fact that it ignores -;; properties is irrelevant. If you want to make vc-svn-state call -;; this, it should be extended to handle svn properties. -(defun vc-svn-state-heuristic (file) - "SVN-specific state heuristic." - ;; If the file has not changed since checkout, consider it `up-to-date'. - ;; Otherwise consider it `edited'. Copied from vc-cvs-state-heuristic. - (let ((checkout-time (vc-file-getprop file 'vc-checkout-time)) - (lastmod (nth 5 (file-attributes file)))) - (cond - ((equal checkout-time lastmod) 'up-to-date) - ((string= (vc-working-revision file) "0") 'added) - ((null checkout-time) 'unregistered) - (t 'edited)))) - ;; FIXME it would be better not to have the "remote" argument, ;; but to distinguish the two output formats based on content. +;; FIXME: the local format isn't used by the (sole) caller anymore. (defun vc-svn-after-dir-status (callback &optional remote) (let ((state-map '((?A . added) (?C . conflict) @@ -215,29 +197,19 @@ If you want to force an empty list of arguments, use t." (setq result (cons (list filename state) result))))) (funcall callback result))) -;; -dir-status called from vc-dir, which loads vc, which loads vc-dispatcher. +;; dir-status-files called from vc-dir, which loads vc, +;; which loads vc-dispatcher. (declare-function vc-exec-after "vc-dispatcher" (code)) -(defun vc-svn-dir-status (dir callback) +(autoload 'vc-expand-dirs "vc") + +(defun vc-svn-dir-status-files (_dir files callback) "Run 'svn status' for DIR and update BUFFER via CALLBACK. CALLBACK is called as (CALLBACK RESULT BUFFER), where RESULT is a list of conses (FILE . STATE) for directory DIR." - ;; FIXME should this rather be all the files in dir? - ;; FIXME: the vc-stay-local-p logic below is disabled, it ends up - ;; calling synchronously (vc-svn-registered DIR) => calling svn status -v DIR - ;; which is VERY SLOW for big trees and it makes emacs - ;; completely unresponsive during that time. - (let* ((local (and nil (vc-stay-local-p dir 'SVN))) - (remote (or t (not local) (eq local 'only-file)))) - (vc-svn-command (current-buffer) 'async nil "status" - (if remote "-u")) - (vc-run-delayed - (vc-svn-after-dir-status callback remote)))) - -(defun vc-svn-dir-status-files (_dir files _default-state callback) - (apply 'vc-svn-command (current-buffer) 'async nil "status" files) - (vc-run-delayed - (vc-svn-after-dir-status callback))) + ;; FIXME shouldn't this rather default to all the files in dir? + (apply #'vc-svn-command (current-buffer) 'async nil "status" "-u" files) + (vc-run-delayed (vc-svn-after-dir-status callback t))) (defun vc-svn-dir-extra-headers (_dir) "Generate extra status headers for a Subversion working copy." @@ -300,7 +272,7 @@ RESULT is a list of conses (FILE . STATE) for directory DIR." (autoload 'vc-switches "vc") -(defun vc-svn-register (files &optional _rev _comment) +(defun vc-svn-register (files &optional _comment) "Register FILES into the SVN version-control system. The COMMENT argument is ignored This does an add but not a commit. Passes either `vc-svn-register-switches' or `vc-register-switches' @@ -312,13 +284,8 @@ to the SVN command." (defalias 'vc-svn-responsible-p 'vc-svn-root) -(defalias 'vc-svn-could-register 'vc-svn-root - "Return non-nil if FILE could be registered in SVN. -This is only possible if SVN is responsible for FILE's directory.") - -(defun vc-svn-checkin (files rev comment &optional _extra-args-ignored) +(defun vc-svn-checkin (files comment &optional _extra-args-ignored) "SVN-specific version of `vc-backend-checkin'." - (if rev (error "Committing to a specific revision is unsupported in SVN")) (let ((status (apply 'vc-svn-command nil 1 files "ci" (nconc (list "-m" comment) (vc-switches 'SVN 'checkin))))) @@ -376,14 +343,14 @@ FILE is a file wildcard, relative to the root directory of DIRECTORY." "Return the administrative directory of FILE." (expand-file-name vc-svn-admin-directory (vc-svn-root file))) -(defun vc-svn-checkout (file &optional editable rev) +(defun vc-svn-checkout (file &optional rev) (message "Checking out %s..." file) (with-current-buffer (or (get-file-buffer file) (current-buffer)) - (vc-svn-update file editable rev (vc-switches 'SVN 'checkout))) + (vc-svn-update file rev (vc-switches 'SVN 'checkout))) (vc-mode-line file 'SVN) (message "Checking out %s...done" file)) -(defun vc-svn-update (file _editable rev switches) +(defun vc-svn-update (file rev switches) (if (and (file-exists-p file) (not rev)) ;; If no revision was specified, there's nothing to do. nil @@ -408,6 +375,29 @@ FILE is a file wildcard, relative to the root directory of DIRECTORY." (unless contents-done (vc-svn-command nil 0 file "revert"))) +(defun vc-svn-merge-file (file) + "Accept a file merge request, prompting for revisions." + (let* ((first-revision + (vc-read-revision + (concat "Merge " file + " from SVN revision " + "(default news on current branch): ") + (list file) + 'SVN)) + second-revision + status) + (cond + ((string= first-revision "") + (setq status (vc-svn-merge-news file))) + (t + (setq second-revision + (vc-read-revision + "Second SVN revision: " + (list file) 'SVN nil + first-revision)) + (setq status (vc-svn-merge file first-revision second-revision)))) + status)) + (defun vc-svn-merge (file first-version &optional second-version) "Merge changes into current working copy of FILE. The changes are between FIRST-VERSION and SECOND-VERSION." @@ -540,7 +530,6 @@ If LIMIT is non-nil, show no more than this many entries." 'vc-svn-command buffer 'async - ;; (if (and (= (length files) 1) (vc-stay-local-p file 'SVN)) 'async 0) (list file) "log" (append @@ -560,7 +549,7 @@ If LIMIT is non-nil, show no more than this many entries." (if start-revision (format "-r%s" start-revision) "-rHEAD:0")) (when limit (list "--limit" (format "%s" limit))))))))) -(defun vc-svn-diff (files &optional oldvers newvers buffer) +(defun vc-svn-diff (files &optional oldvers newvers buffer async) "Get a difference report using SVN between two revisions of fileset FILES." (and oldvers (not newvers) @@ -575,14 +564,12 @@ If LIMIT is non-nil, show no more than this many entries." ;; has a different revision, we fetch the lot, which is ;; obviously sub-optimal. (setq oldvers nil)) + (setq async (and async (or oldvers newvers))) ; Svn diffs those locally. (let* ((switches (if vc-svn-diff-switches (vc-switches 'SVN 'diff) (list (concat "--diff-cmd=" diff-command) "-x" - (mapconcat 'identity (vc-switches nil 'diff) " ")))) - (async (and (not vc-disable-async-diff) - (vc-stay-local-p files 'SVN) - (or oldvers newvers)))) ; Svn diffs those locally. + (mapconcat 'identity (vc-switches nil 'diff) " "))))) (apply 'vc-svn-command buffer (if async 'async 0) files "diff" @@ -624,7 +611,7 @@ NAME is assumed to be a URL." ;; Subversion makes backups for us, so don't bother. ;; (defun vc-svn-make-version-backups-p (file) ;; "Return non-nil if version backups should be made for FILE." -;; (vc-stay-local-p file 'SVN)) +;; nil) (defun vc-svn-check-headers () "Check if the current file has any headers in it." @@ -647,17 +634,6 @@ and that it passes `vc-svn-global-switches' to it before FLAGS." (cons vc-svn-global-switches flags) (append vc-svn-global-switches flags)))) -(defun vc-svn-repository-hostname (dirname) - (with-temp-buffer - (let (process-file-side-effects) - (vc-svn-command t t dirname "info" "--xml")) - (goto-char (point-min)) - (when (re-search-forward "<url>\\(.*\\)</url>" nil t) - ;; This is not a hostname but a URL. This may actually be considered - ;; as a feature since it allows vc-svn-stay-local to specify different - ;; behavior for different modules on the same server. - (match-string 1)))) - (defun vc-svn-resolve-when-done () "Call \"svn resolved\" if the conflict markers have been removed." (save-excursion diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index c8b23092749..54b221428a5 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1,4 +1,4 @@ -;;; vc.el --- drive a version-control system from within Emacs -*- lexical-binding: t -*- +;;; vc.el --- drive a version-control system from within Emacs -*- lexical-binding:t -*- ;; Copyright (C) 1992-1998, 2000-2015 Free Software Foundation, Inc. @@ -46,15 +46,15 @@ ;; If you maintain a client of the mode or customize it in your .emacs, ;; note that some backend functions which formerly took single file arguments ;; now take a list of files. These include: register, checkin, print-log, -;; rollback, and diff. +;; and diff. ;;; Commentary: ;; This mode is fully documented in the Emacs user's manual. ;; -;; Supported version-control systems presently include CVS, RCS, GNU -;; Arch, Subversion, Bzr, Git, Mercurial, Monotone and SCCS -;; (or its free replacement, CSSC). +;; Supported version-control systems presently include CVS, RCS, SRC, +;; GNU Subversion, Bzr, Git, Mercurial, Monotone and SCCS (or its free +;; replacement, CSSC). ;; ;; If your site uses the ChangeLog convention supported by Emacs, the ;; function `log-edit-comment-to-change-log' could prove a useful checkin hook, @@ -72,7 +72,10 @@ ;; When using Subversion or a later system, anything you do outside VC ;; *through the VCS tools* should safely interlock with VC ;; operations. Under these VC does little state caching, because local -;; operations are assumed to be fast. The dividing line is +;; operations are assumed to be fast. +;; +;; The 'assumed to be fast' category includes SRC, even though it's +;; a wrapper around RCS. ;; ;; ADDING SUPPORT FOR OTHER BACKENDS ;; @@ -125,42 +128,33 @@ ;; Return the current version control state of FILE. For a list of ;; possible values, see `vc-state'. This function should do a full and ;; reliable state computation; it is usually called immediately after -;; C-x v v. If you want to use a faster heuristic when visiting a -;; file, put that into `state-heuristic' below. Note that under most -;; VCSes this won't be called at all, dir-status is used instead. +;; C-x v v. ;; -;; - state-heuristic (file) +;; - dir-status-files (dir files update-function) ;; -;; If provided, this function is used to estimate the version control -;; state of FILE at visiting time. It should be considerably faster -;; than the implementation of `state'. For a list of possible values, -;; see the doc string of `vc-state'. +;; Produce RESULT: a list of lists of the form (FILE VC-STATE EXTRA) +;; for FILES in DIR. If FILES is nil, report on all files in DIR. +;; (It is OK, though possibly inefficient, to ignore the FILES argument +;; and always report on all files in DIR.) ;; -;; - dir-status (dir update-function) +;; If FILES is non-nil, this function should report on all requested +;; files, including up-to-date or ignored files. ;; -;; Produce RESULT: a list of lists of the form (FILE VC-STATE EXTRA) -;; for the files in DIR. ;; EXTRA can be used for backend specific information about FILE. ;; If a command needs to be run to compute this list, it should be ;; run asynchronously using (current-buffer) as the buffer for the -;; command. When RESULT is computed, it should be passed back by -;; doing: (funcall UPDATE-FUNCTION RESULT nil). -;; If the backend uses a process filter, hence it produces partial results, -;; they can be passed back by doing: -;; (funcall UPDATE-FUNCTION RESULT t) -;; and then do a (funcall UPDATE-FUNCTION RESULT nil) -;; when all the results have been computed. -;; To provide more backend specific functionality for `vc-dir' -;; the following functions might be needed: `dir-extra-headers', -;; `dir-printer', `extra-dir-menu' and `dir-status-files'. +;; command. ;; -;; - dir-status-files (dir files default-state update-function) +;; When RESULT is computed, it should be passed back by doing: +;; (funcall UPDATE-FUNCTION RESULT nil). If the backend uses a +;; process filter, hence it produces partial results, they can be +;; passed back by doing: (funcall UPDATE-FUNCTION RESULT t) and then +;; do a (funcall UPDATE-FUNCTION RESULT nil) when all the results +;; have been computed. ;; -;; This function is identical to dir-status except that it should -;; only report status for the specified FILES. Also it needs to -;; report on all requested files, including up-to-date or ignored -;; files. If not provided, the default is to consider that the files -;; are in DEFAULT-STATE. +;; To provide more backend specific functionality for `vc-dir' +;; the following functions might be needed: `dir-extra-headers', +;; `dir-printer', and `extra-dir-menu'. ;; ;; - dir-extra-headers (dir) ;; @@ -185,29 +179,11 @@ ;; head or tip revision. Should return "0" for a file added but not yet ;; committed. ;; -;; - latest-on-branch-p (file) -;; -;; Return non-nil if the working revision of FILE is the latest revision -;; on its branch (many VCSes call this the 'tip' or 'head' revision). -;; The default implementation always returns t, which means that -;; working with non-current revisions is not supported by default. -;; ;; * checkout-model (files) ;; ;; Indicate whether FILES need to be "checked out" before they can be ;; edited. See `vc-checkout-model' for a list of possible values. ;; -;; - workfile-unchanged-p (file) -;; -;; Return non-nil if FILE is unchanged from the working revision. -;; This function should do a brief comparison of FILE's contents -;; with those of the repository copy of the working revision. If -;; the backend does not have such a brief-comparison feature, the -;; default implementation of this function can be used, which -;; delegates to a full vc-BACKEND-diff. (Note that vc-BACKEND-diff -;; must not run asynchronously in this case, see variable -;; `vc-disable-async-diff'.) -;; ;; - mode-line-string (file) ;; ;; If provided, this function should return the VC-specific mode @@ -225,21 +201,16 @@ ;; it so VC mode can add files to it. For file-oriented systems, this ;; need do no more than create a subdirectory with the right name. ;; -;; * register (files &optional rev comment) +;; * register (files &optional comment) ;; -;; Register FILES in this backend. Optionally, an initial revision REV -;; and an initial description of the file, COMMENT, may be specified, -;; but it is not guaranteed that the backend will do anything with this. -;; The implementation should pass the value of vc-register-switches -;; to the backend command. (Note: in older versions of VC, this -;; command took a single file argument and not a list.) -;; The REV argument is a historical leftover and is never used. -;; -;; - init-revision (file) -;; -;; The initial revision to use when registering FILE if one is not -;; specified by the user. If not provided, the variable -;; vc-default-init-revision is used instead. +;; Register FILES in this backend. Optionally, an initial +;; description of the file, COMMENT, may be specified, but it is not +;; guaranteed that the backend will do anything with this. The +;; implementation should pass the value of vc-register-switches to +;; the backend command. (Note: in older versions of VC, this +;; command had an optional revision first argument that was +;; not used; in still older ones it took a single file argument and +;; not a list.) ;; ;; - responsible-p (file) ;; @@ -249,11 +220,6 @@ ;; like change log generation. The default implementation always ;; returns nil. ;; -;; - could-register (file) -;; -;; Return non-nil if FILE could be registered under this backend. The -;; default implementation always returns t. -;; ;; - receive-file (file rev) ;; ;; Let this backend "receive" a file that is already registered under @@ -267,12 +233,12 @@ ;; Unregister FILE from this backend. This is only needed if this ;; backend may be used as a "more local" backend for temporary editing. ;; -;; * checkin (files rev comment) +;; * checkin (files comment) ;; -;; Commit changes in FILES to this backend. REV is a historical artifact -;; and should be ignored. COMMENT is used as a check-in comment. -;; The implementation should pass the value of vc-checkin-switches to -;; the backend command. +;; Commit changes in FILES to this backend. COMMENT is used as a +;; check-in comment. The implementation should pass the value of +;; vc-checkin-switches to the backend command. The revision argument +;; of some older VC versions is no longer supported. ;; ;; * find-revision (file rev buffer) ;; @@ -281,16 +247,17 @@ ;; The implementation should pass the value of vc-checkout-switches ;; to the backend command. ;; -;; * checkout (file &optional editable rev) +;; * checkout (file &optional rev) ;; -;; Check out revision REV of FILE into the working area. If EDITABLE -;; is non-nil, FILE should be writable by the user and if locking is -;; used for FILE, a lock should also be set. If REV is non-nil, that -;; is the revision to check out (default is the working revision). -;; If REV is t, that means to check out the head of the current branch; -;; if it is the empty string, check out the head of the trunk. -;; The implementation should pass the value of vc-checkout-switches -;; to the backend command. +;; Check out revision REV of FILE into the working area. FILE +;; should be writable by the user and if locking is used for FILE, a +;; lock should also be set. If REV is non-nil, that is the revision +;; to check out (default is the working revision). If REV is t, +;; that means to check out the head of the current branch; if it is +;; the empty string, check out the head of the trunk. The +;; implementation should pass the value of vc-checkout-switches to +;; the backend command. The 'editable' argument of older VC versions +;; is gone; all files are checked out editable. ;; ;; * revert (file &optional contents-done) ;; @@ -301,19 +268,11 @@ ;; If FILE is in the `added' state it should be returned to the ;; `unregistered' state. ;; -;; - rollback (files) +;; - merge-file (file rev1 rev2) ;; -;; Remove the tip revision of each of FILES from the repository. If -;; this function is not provided, trying to cancel a revision is -;; caught as an error. (Most backends don't provide it.) (Also -;; note that older versions of this backend command were called -;; 'cancel-version' and took a single file arg, not a list of -;; files.) -;; -;; - merge (file rev1 rev2) -;; -;; Merge the changes between REV1 and REV2 into the current working file -;; (for non-distributed VCS). +;; Merge the changes between REV1 and REV2 into the current working +;; file (for non-distributed VCS). It is expected that with an +;; empty first revision this will behave like the merge-news method. ;; ;; - merge-branch () ;; @@ -402,13 +361,14 @@ ;; default implementation runs rcs2log, which handles RCS- and ;; CVS-style logs. ;; -;; * diff (files &optional rev1 rev2 buffer) +;; * diff (files &optional rev1 rev2 buffer async) ;; ;; Insert the diff for FILE into BUFFER, or the *vc-diff* buffer if -;; BUFFER is nil. If REV1 and REV2 are non-nil, report differences -;; from REV1 to REV2. If REV1 is nil, use the working revision (as -;; found in the repository) as the older revision; if REV2 is nil, -;; use the current working-copy contents as the newer revision. This +;; BUFFER is nil. If ASYNC is non-nil, run asynchronously. If REV1 +;; and REV2 are non-nil, report differences from REV1 to REV2. If +;; REV1 is nil, use the working revision (as found in the +;; repository) as the older revision; if REV2 is nil, use the +;; current working-copy contents as the newer revision. This ;; function should pass the value of (vc-switches BACKEND 'diff) to ;; the backend command. It should return a status of either 0 (no ;; differences found), or 1 (either non-empty diff or the diff is @@ -458,6 +418,15 @@ ;; If the backend supports annotating through copies and renames, ;; and displays a file name and a revision, then return a cons ;; (REVISION . FILENAME). +;; +;; - region-history (FILE BUFFER LFROM LTO) +;; +;; Insert into BUFFER the history (log comments and diffs) of the content of +;; FILE between lines LFROM and LTO. This is typically done asynchronously. +;; +;; - region-history-mode () +;; +;; Major mode to use for the output of `region-history'. ;; TAG SYSTEM ;; @@ -493,14 +462,6 @@ ;; ;; Return the root of the VC controlled hierarchy for file. ;; -;; - repository-hostname (dirname) -;; -;; Return the hostname that the backend will have to contact -;; in order to operate on a file in DIRNAME. If the return value -;; is nil, it means that the repository is local. -;; This function is used in `vc-stay-local-p' which backends can use -;; for their convenience. -;; ;; - ignore (file &optional directory) ;; ;; Ignore FILE under the VCS of DIRECTORY (default is `default-directory'). @@ -536,15 +497,6 @@ ;; ;; Return non-nil if the current buffer contains any version headers. ;; -;; - clear-headers () -;; -;; In the current buffer, reset all version headers to their unexpanded -;; form. This function should be provided if the state-querying code -;; for this backend uses the version headers to determine the state of -;; a file. This function will then be called whenever VC changes the -;; version control state in such a way that the headers would give -;; wrong information. -;; ;; - delete-file (file) ;; ;; Delete FILE and mark it as deleted in the repository. If this @@ -586,19 +538,82 @@ ;; the project that contains DIR. ;; FIXME: what should it do with non-text conflicts? -;;; Todo: +;;; Changes from the pre-25.1 API: +;; +;; - INCOMPATIBLE CHANGE: The 'editable' optional argument of +;; vc-checkout is gone. The upper level assumes that all files are +;; checked out editable. This moves closer to emulating modern +;; non-locking behavior even on very old VCSes. +;; +;; - INCOMPATIBLE CHANGE: The vc-register function and its backend +;; implementations no longer take a first optional revision +;; argument, since on no system since RCS has setting the initial +;; revision been even possible, let alone sane. +;; +;; INCOMPATIBLE CHANGE: In older versions of the API, vc-diff did +;; not take an async-mode flag as a fourth optional argument. (This +;; change eliminated a particularly ugly global.) +;; +;; - INCOMPATIBLE CHANGE: The backend operation for non-distributed +;; VCSes formerly called "merge" is now "merge-file" (to contrast +;; with merge-branch), and does its own prompting for revisions. +;; (This fixes a layer violation that produced bad behavior under +;; SVN.) +;; +;; - INCOMPATIBLE CHANGE: The old fourth 'default-state' argument of +;; vc-dir-status-files is gone; none of the back ends actually used it. +;; +;; - vc-dir-status is no longer a public method; it has been replaced +;; by vc-dir-status-files. +;; +;; - vc-state-heuristic is no longer a public method (the CVS backend +;; retains it as a private one). +;; +;; - the vc-mistrust-permissions configuration variable is gone; the +;; code no longer relies on permissions except in one corner case where +;; CVS leaves no alternative (which was not gated by this variable). The +;; only affected back ends were SCCS and RCS. +;; +;; - vc-stay-local-p and repository-hostname are no longer part +;; of the public API. The vc-stay-local configuration variable +;; remains but only affects the CVS back end. +;; +;; - The init-revision function and the default-initial-revision +;; variable are gone. These have't made sense on anything shipped +;; since RCS, and using them was a dumb stunt even on RCS. +;; +;; - workfile-unchanged-p is no longer a public back-end method. It +;; was redundant with vc-state and usually implemented with a trivial +;; call to it. A few older back ends retain versions for internal use in +;; their vc-state functions. +;; +;; - could-register is no longer a public method. Only vc-cvs ever used it +;; +;; The vc-keep-workfiles configuration variable is gone. Used only by +;; the RCS and SCCS backends, it was an invitation to shoot self in foot +;; when set to the (non-default) value nil. The original justification +;; for it (saving disk space) is long obsolete. +;; +;; - The rollback method (implemented by RCS and SCCS only) is gone. See +;; the to-do note on uncommit. +;; +;; - latest-on-branch-p is no longer a public method. It was to be used +;; for implementing rollback. RCS keeps its implementation (the only one) +;; for internal use. -;; - Get rid of the "master file" terminology. -;; - Add key-binding for vc-delete-file. +;;; Todo: ;;;; New Primitives: ;; -;; - deal with push/pull operations. +;; - uncommit: undo last checkin, leave changes in place in the workfile, +;; stash the commit comment for re-use. +;; +;; - deal with push operations. ;; ;;;; Primitives that need changing: ;; -;; - vc-update/vc-merge should deal with VC systems that don't +;; - vc-update/vc-merge should deal with VC systems that don't do ;; update/merge on a file basis, but on a whole repository basis. ;; vc-update and vc-merge assume the arguments are always files, ;; they don't deal with directories. Make sure the *vc-dir* buffer @@ -607,27 +622,44 @@ ;; ;;;; Improved branch and tag handling: ;; +;; - Make sure the *vc-dir* buffer is updated after merge-branch operations. +;; ;; - add a generic mechanism for remembering the current branch names, ;; display the branch name in the mode-line. Replace ;; vc-cvs-sticky-tag with that. ;; -;;;; Internal cleanups: +;; - Add a primitives for switching to a branch (creating it if required. +;; +;; - Add the ability to list tags and branches. +;; +;;;; Unify two different versions of the amend capability ;; -;; - backends that care about vc-stay-local should try to take it into -;; account for vc-dir. Is this likely to be useful??? YES! +;; - Some back ends (SCCS/RCS/SVN/SRC), have an amend capability that can +;; be invoked from log-view. ;; -;; - vc-expand-dirs should take a backend parameter and only look for -;; files managed by that backend. +;; - The git backend supports amending, but in a different +;; way (press `C-c C-e' in log-edit buffer, when making a new commit). ;; -;; - Another important thing: merge all the status-like backend operations. -;; We should remove dir-status, state, and dir-status-files, and -;; replace them with just `status' which takes a fileset and a continuation -;; (like dir-status) and returns a buffer in which the process(es) are run -;; (or nil if it worked synchronously). Hopefully we can define the old -;; 4 operations in term of this one. +;; - Second, `log-view-modify-change-comment' doesn't seem to support +;; modern backends at all because `log-view-extract-comment' +;; unconditionally calls `log-view-current-file'. This should be easy to +;; fix. +;; +;; - Third, doing message editing in log-view might be a natural way to go +;; about it, but editing any but the last commit (and even it, if it's +;; been pushed) is a dangerous operation in Git, which we shouldn't make +;; too easy for users to perform. +;; +;; There should be a check that the given comment is not reachable +;; from any of the "remote" refs? ;; ;;;; Other ;; +;; - asynchronous checkin and commit, so you can keep working in other +;; buffers while the repo operation happens. +;; +;; - Direct support for stash/shelve. +;; ;; - when a file is in `conflict' state, turn on smerge-mode. ;; ;; - figure out what to do with conflicts that are not caused by the @@ -673,6 +705,7 @@ (require 'vc-hooks) (require 'vc-dispatcher) +(require 'cl-lib) (declare-function diff-setup-whitespace "diff-mode" ()) @@ -701,14 +734,6 @@ (make-obsolete-variable 'vc-initial-comment "it has no effect." "23.2") -(defcustom vc-default-init-revision "1.1" - "A string used as the default revision number when a new file is registered. -This can be overridden by giving a prefix argument to \\[vc-register]. This -can also be overridden by a particular VC backend." - :type 'string - :group 'vc - :version "20.3") - (defcustom vc-checkin-switches nil "A string or list of strings specifying extra switches for checkin. These are passed to the checkin program by \\[vc-checkin]." @@ -826,13 +851,6 @@ is sensitive to blank lines." :group 'vc) -;; Variables users don't need to see - -(defvar vc-disable-async-diff nil - "VC sets this to t locally to disable some async diff operations. -Backends that offer asynchronous diffs should respect this variable -in their implementation of vc-BACKEND-diff.") - ;; File property caching (defun vc-clear-context () @@ -928,14 +946,14 @@ responsible for FILE is returned." (throw 'found backend)))) (error "No VC backend is responsible for %s" file))) -(defun vc-expand-dirs (file-or-dir-list) +(defun vc-expand-dirs (file-or-dir-list backend) "Expands directories in a file list specification. Within directories, only files already under version control are noticed." (let ((flattened '())) (dolist (node file-or-dir-list) (when (file-directory-p node) (vc-file-tree-walk - node (lambda (f) (when (vc-backend f) (push f flattened))))) + node (lambda (f) (when (eq (vc-backend f) backend) (push f flattened))))) (unless (file-directory-p node) (push node flattened))) (nreverse flattened))) @@ -973,8 +991,8 @@ Otherwise, throw an error. STATE-MODEL-ONLY-FILES if non-nil, means that the caller needs the FILESET-ONLY-FILES STATE and MODEL info. Otherwise, that part may be skipped. -BEWARE: this function may change the -current buffer." + +BEWARE: this function may change the current buffer." ;; FIXME: OBSERVER is unused. The name is not intuitive and is not ;; documented. It's set to t when called from diff and print-log. (let (backend) @@ -985,6 +1003,9 @@ current buffer." (if observer (vc-dired-deduce-fileset) (error "State changing VC operations not supported in `dired-mode'"))) + ((and (derived-mode-p 'log-view-mode) + (setq backend (vc-responsible-backend default-directory))) + (list backend default-directory)) ((setq backend (vc-backend buffer-file-name)) (if state-model-only-files (list backend (list buffer-file-name) @@ -1079,8 +1100,7 @@ For old-style locking-based version control systems, like RCS: If every file is registered and unlocked, check out (lock) the file(s) for editing. If every file is locked by you and has changes, pop up a - *vc-log* buffer to check in the changes. If the variable - `vc-keep-workfiles' is non-nil (the default), leave a + *vc-log* buffer to check in the changes. Leave a read-only copy of each changed file after checking in. If every file is locked by you and unchanged, unlock them. If every file is locked by someone else, offer to steal the lock." @@ -1111,7 +1131,7 @@ For old-style locking-based version control systems, like RCS: ((eq state 'ignored) (error "Fileset files are ignored by the version-control system")) ((or (null state) (eq state 'unregistered)) - (vc-register nil vc-fileset)) + (vc-register vc-fileset)) ;; Files are up-to-date, or need a merge and user specified a revision ((or (eq state 'up-to-date) (and verbose (eq state 'needs-update))) (cond @@ -1128,10 +1148,10 @@ For old-style locking-based version control systems, like RCS: (let ((vsym (intern-soft revision-downcase))) (dolist (file files) (vc-transfer-file file vsym))) (dolist (file files) - (vc-checkout file (eq model 'implicit) revision))))) + (vc-checkout file revision))))) ((not (eq model 'implicit)) ;; check the files out - (dolist (file files) (vc-checkout file t))) + (dolist (file files) (vc-checkout file))) (t ;; do nothing (message "Fileset is up-to-date")))) @@ -1148,7 +1168,7 @@ For old-style locking-based version control systems, like RCS: ;; state of each individual file in the fileset, it seems ;; simplest to just check if the file exists. Bug#9781. (when (and (file-exists-p file) (not (file-writable-p file))) - ;; Make the file+buffer read-write. + ;; Make the file-buffer read-write. (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue? " file)) (error "Aborted")) ;; Maybe we somehow lost permissions on the directory. @@ -1166,7 +1186,7 @@ For old-style locking-based version control systems, like RCS: ;; For files with locking, if the file does not contain ;; any changes, just let go of the lock, i.e. revert. (when (and (not (eq model 'implicit)) - (vc-workfile-unchanged-p file) + (eq state 'up-to-date) ;; If buffer is modified, that means the user just ;; said no to saving it; in that case, don't revert, ;; because the user might intend to save after @@ -1217,10 +1237,10 @@ For old-style locking-based version control systems, like RCS: (if (yes-or-no-p (format "%s is not up-to-date. Get latest revision? " (file-name-nondirectory file))) - (vc-checkout file (eq model 'implicit) t) + (vc-checkout file t) (when (and (not (eq model 'implicit)) (yes-or-no-p "Lock this revision? ")) - (vc-checkout file t))))) + (vc-checkout file))))) ;; needs-merge ((eq state 'needs-merge) (dolist (file files) @@ -1248,16 +1268,13 @@ For old-style locking-based version control systems, like RCS: "Claim lock retaining changes? "))) (progn (vc-call-backend backend 'steal-lock file) (clear-visited-file-modtime) - ;; Must clear any headers here because they wouldn't - ;; show that the file is locked now. - (vc-clear-headers file) (write-file buffer-file-name) (vc-mode-line file backend)) (if (not (yes-or-no-p "Revert to checked-in revision, instead? ")) (error "Checkout aborted") (vc-revert-buffer-internal t t) - (vc-checkout file t))))) + (vc-checkout file))))) ;; Unknown fileset state (t (error "Fileset is in an unknown state %s" state))))) @@ -1277,12 +1294,11 @@ For old-style locking-based version control systems, like RCS: (declare-function vc-dir-move-to-goal-column "vc-dir" ()) ;;;###autoload -(defun vc-register (&optional set-revision vc-fileset comment) +(defun vc-register (&optional vc-fileset comment) "Register into a version control system. If VC-FILESET is given, register the files in that fileset. Otherwise register the current file. -With prefix argument SET-REVISION, allow user to specify initial revision -level. If COMMENT is present, use that as an initial comment. +If COMMENT is present, use that as an initial comment. The version control system to use is found by cycling through the list `vc-handled-backends'. The first backend in that list which declares @@ -1314,11 +1330,7 @@ first backend that could register the file is used." (vc-buffer-sync))))) (message "Registering %s... " files) (mapc 'vc-file-clearprops files) - (vc-call-backend backend 'register files - (if set-revision - (read-string (format "Initial revision level for %s: " files)) - (vc-call-backend backend 'init-revision)) - comment) + (vc-call-backend backend 'register files comment) (mapc (lambda (file) (vc-file-setprop file 'vc-backend backend) @@ -1329,7 +1341,7 @@ first backend that could register the file is used." ;; (make-local-variable 'backup-inhibited) ;; (setq backup-inhibited t)) - (vc-resynch-buffer file vc-keep-workfiles t)) + (vc-resynch-buffer file t t)) files) (when (derived-mode-p 'vc-dir-mode) (vc-dir-move-to-goal-column)) @@ -1416,32 +1428,28 @@ Argument BACKEND is the backend you are using." (replace-match "")) (write-region (point-min) (point-max) file))) -(defun vc-checkout (file &optional writable rev) +(defun vc-checkout (file &optional rev) "Retrieve a copy of the revision REV of FILE. -If WRITABLE is non-nil, make sure the retrieved file is writable. REV defaults to the latest revision. After check-out, runs the normal hook `vc-checkout-hook'." - (and writable - (not rev) + (and (not rev) (vc-call make-version-backups-p file) (vc-up-to-date-p file) (vc-make-version-backup file)) (let ((backend (vc-backend file))) (with-vc-properties (list file) (condition-case err - (vc-call-backend backend 'checkout file writable rev) + (vc-call-backend backend 'checkout file rev) (file-error ;; Maybe the backend is not installed ;-( - (when writable + (when t (let ((buf (get-file-buffer file))) (when buf (with-current-buffer buf (read-only-mode -1))))) (signal (car err) (cdr err)))) `((vc-state . ,(if (or (eq (vc-checkout-model backend (list file)) 'implicit) - (not writable)) - (if (vc-call-backend backend 'latest-on-branch-p file) - 'up-to-date - 'needs-update) + nil) + 'up-to-date 'edited)) (vc-checkout-time . ,(nth 5 (file-attributes file)))))) (vc-resynch-buffer file t t) @@ -1488,16 +1496,11 @@ Type \\[vc-next-action] to check in changes.") ".\n") (message "Please explain why you stole the lock. Type C-c C-c when done."))) -(defun vc-checkin (files backend &optional rev comment initial-contents) - "Check in FILES. -The optional argument REV may be a string specifying the new revision -level (strongly deprecated). COMMENT is a comment -string; if omitted, a buffer is popped up to accept a comment. If -INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial contents -of the log entry buffer. - -If `vc-keep-workfiles' is nil, FILE is deleted afterwards, provided -that the version control system supports this mode of operation. +(defun vc-checkin (files backend &optional comment initial-contents) + "Check in FILES. COMMENT is a comment string; if omitted, a +buffer is popped up to accept a comment. If INITIAL-CONTENTS is +non-nil, then COMMENT is used as the initial contents of the log +entry buffer. Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (when vc-before-checkin-hook @@ -1520,7 +1523,7 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." ;; vc-checkin-switches, but 'the' local buffer is ;; not a well-defined concept for filesets. (progn - (vc-call-backend backend 'checkin files rev comment) + (vc-call-backend backend 'checkin files comment) (mapc 'vc-delete-automatic-version-backups files)) `((vc-state . up-to-date) (vc-checkout-time . ,(nth 5 (file-attributes file))) @@ -1684,11 +1687,10 @@ Return t if the buffer had changes, nil otherwise." ;; We regard this as "changed". ;; Diff it against /dev/null. (apply 'vc-do-command buffer - 1 "diff" file + (if async 'async 1) "diff" file (append (vc-switches nil 'diff) '("/dev/null")))))) (setq files (nreverse filtered)))) - (let ((vc-disable-async-diff (not async))) - (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 buffer)) + (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 buffer async) (set-buffer buffer) (diff-mode) (set (make-local-variable 'diff-vc-backend) (car vc-fileset)) @@ -1879,6 +1881,19 @@ saving the buffer." (called-interactively-p 'interactive)))))) ;;;###autoload +(defun vc-root-dir () + "Return the root directory for the current VC tree. +Return nil if the root directory cannot be identified." + (let ((backend (vc-deduce-backend))) + (if backend + (condition-case err + (vc-call-backend backend 'root default-directory) + (vc-not-supported + (unless (eq (cadr err) 'root) + (signal (car err) (cdr err))) + nil))))) + +;;;###autoload (defun vc-revision-other-window (rev) "Visit revision REV of the current file in another window. If the current file is named `F', the revision is named `F.~REV~'. @@ -1959,25 +1974,6 @@ the variable `vc-BACKEND-header'." (when (string-match (car f) buffer-file-name) (insert (format (cdr f) (car hdstrings))))))))))) -(defun vc-clear-headers (&optional file) - "Clear all version headers in the current buffer (or FILE). -The headers are reset to their non-expanded form." - (let* ((filename (or file buffer-file-name)) - (visited (find-buffer-visiting filename)) - (backend (vc-backend filename))) - (when (vc-find-backend-function backend 'clear-headers) - (if visited - (let ((context (vc-buffer-context))) - ;; save-excursion may be able to relocate point and mark - ;; properly. If it fails, vc-restore-buffer-context - ;; will give it a second try. - (save-excursion - (vc-call-backend backend 'clear-headers)) - (vc-restore-buffer-context context)) - (set-buffer (find-file-noselect filename)) - (vc-call-backend backend 'clear-headers) - (kill-buffer filename))))) - (defun vc-modify-change-comment (files rev oldcomment) "Edit the comment associated with the given files and revision." ;; Less of a kluge than it looks like; log-view mode only passes @@ -2020,42 +2016,17 @@ changes from the current branch." (vc-buffer-sync) (dolist (file files) (let* ((state (vc-state file)) - first-revision second-revision status) + status) (cond ((stringp state) ;; Locking VCses only (error "File %s is locked by %s" file state)) ((not (vc-editable-p file)) (vc-checkout file t))) - (setq first-revision - (vc-read-revision - (concat "Merge " file - " from branch or revision " - "(default news on current branch): ") - (list file) - backend)) - (cond - ((string= first-revision "") - (setq status (vc-call-backend backend 'merge-news file))) - (t - (if (not (vc-branch-p first-revision)) - (setq second-revision - (vc-read-revision - "Second revision: " - (list file) backend nil - ;; FIXME: This is CVS/RCS/SCCS specific. - (concat (vc-branch-part first-revision) "."))) - ;; We want to merge an entire branch. Set revisions - ;; accordingly, so that vc-BACKEND-merge understands us. - (setq second-revision first-revision) - ;; first-revision must be the starting point of the branch - (setq first-revision (vc-branch-part first-revision))) - (setq status (vc-call-backend backend 'merge file - first-revision second-revision)))) + (setq status (vc-call-backend backend 'merge-file file)) (vc-maybe-resolve-conflicts file status "WORKFILE" "MERGE SOURCE")))) (t (error "Sorry, merging is not implemented for %s" backend))))) - (defun vc-maybe-resolve-conflicts (file status &optional _name-A _name-B) (vc-resynch-buffer file t (not (buffer-modified-p))) (if (zerop status) (message "Merge successful") @@ -2080,8 +2051,9 @@ changes from the current branch." (let* ((backend (or (if buffer-file-name (vc-backend buffer-file-name)) (vc-responsible-backend default-directory) (error "No VC backend"))) + (root (vc-root-dir)) (files (vc-call-backend backend - 'conflicted-files default-directory))) + 'conflicted-files (or root default-directory)))) ;; Don't try and visit the current file. (if (equal (car files) buffer-file-name) (pop files)) (if (null files) @@ -2218,19 +2190,11 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)." ;; Don't switch to the output buffer before running the command, ;; so that any buffer-local settings in the vc-controlled ;; buffer can be accessed by the command. - (let ((dir-present nil) - (vc-short-log nil) + (let* ((dir-present (cl-some #'file-directory-p files)) + (shortlog (not (null (memq (if dir-present 'directory 'file) + vc-log-short-style)))) (buffer-name "*vc-change-log*") - type) - (dolist (file files) - (when (file-directory-p file) - (setq dir-present t))) - (setq vc-short-log - (not (null (if dir-present - (memq 'directory vc-log-short-style) - (memq 'file vc-log-short-style))))) - (setq type (if vc-short-log 'short 'long)) - (let ((shortlog vc-short-log)) + (type (if shortlog 'short 'long))) (vc-log-internal-common backend buffer-name files type (lambda (bk buf _type-arg files-arg) @@ -2243,7 +2207,7 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)." (vc-call-backend bk 'show-log-entry working-revision)) (lambda (_ignore-auto _noconfirm) (vc-print-log-internal backend files working-revision - is-start-revision limit)))))) + is-start-revision limit))))) (defvar vc-log-view-type nil "Set this to differentiate the different types of logs.") @@ -2262,15 +2226,18 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)." (with-current-buffer (get-buffer-create buffer-name) (set (make-local-variable 'vc-log-view-type) type)) (setq retval (funcall backend-func backend buffer-name type files)) + (with-current-buffer (get-buffer buffer-name) + (let ((inhibit-read-only t)) + ;; log-view-mode used to be called with inhibit-read-only bound + ;; to t, so let's keep doing it, just in case. + (vc-call-backend backend 'log-view-mode) + (set (make-local-variable 'log-view-vc-backend) backend) + (set (make-local-variable 'log-view-vc-fileset) files) + (set (make-local-variable 'revert-buffer-function) + rev-buff-func))) + ;; Display after setting up major-mode, so display-buffer-alist can know + ;; the major-mode. (pop-to-buffer buffer-name) - (let ((inhibit-read-only t)) - ;; log-view-mode used to be called with inhibit-read-only bound - ;; to t, so let's keep doing it, just in case. - (vc-call-backend backend 'log-view-mode) - (set (make-local-variable 'log-view-vc-backend) backend) - (set (make-local-variable 'log-view-vc-fileset) files) - (set (make-local-variable 'revert-buffer-function) - rev-buff-func)) (vc-run-delayed (let ((inhibit-read-only t)) (funcall setup-buttons-func backend files retval) @@ -2378,6 +2345,29 @@ When called interactively with a prefix argument, prompt for REMOTE-LOCATION." 'log-outgoing))) ;;;###autoload +(defun vc-region-history (from to) + "Show the history of the region FROM..TO." + (interactive "r") + (let* ((lfrom (line-number-at-pos from)) + (lto (line-number-at-pos to)) + (file buffer-file-name) + (backend (vc-backend file)) + (buf (get-buffer-create "*VC-history*"))) + (with-current-buffer buf + (setq-local vc-log-view-type 'long)) + (vc-call region-history file buf lfrom lto) + (with-current-buffer buf + (vc-call-backend backend 'region-history-mode) + (set (make-local-variable 'log-view-vc-backend) backend) + (set (make-local-variable 'log-view-vc-fileset) file) + (set (make-local-variable 'revert-buffer-function) + (lambda (_ignore-auto _noconfirm) + (with-current-buffer buf + (let ((inhibit-read-only t)) (erase-buffer))) + (vc-call region-history file buf lfrom lto)))) + (display-buffer buf))) + +;;;###autoload (defun vc-revert () "Revert working copies of the selected fileset to their repository contents. This asks for confirmation if the buffer contents are not identical @@ -2425,58 +2415,6 @@ to the working revision (except for keyword expansion)." (message "Reverting %s...done" (vc-delistify files))))) ;;;###autoload -(defun vc-rollback () - "Roll back (remove) the most recent changeset committed to the repository. -This may be either a file-level or a repository-level operation, -depending on the underlying version-control system." - (interactive) - (let* ((vc-fileset (vc-deduce-fileset)) - (backend (car vc-fileset)) - (files (cadr vc-fileset)) - (granularity (vc-call-backend backend 'revision-granularity))) - (unless (vc-find-backend-function backend 'rollback) - (error "Rollback is not supported in %s" backend)) - (when (and (not (eq granularity 'repository)) (/= (length files) 1)) - (error "Rollback requires a singleton fileset or repository versioning")) - ;; FIXME: latest-on-branch-p should take the fileset. - (when (not (vc-call-backend backend 'latest-on-branch-p (car files))) - (error "Rollback is only possible at the tip revision")) - ;; If any of the files is visited by the current buffer, make - ;; sure buffer is saved. If the user says `no', abort since - ;; we cannot show the changes and ask for confirmation to - ;; discard them. - (when (or (not files) (memq (buffer-file-name) files)) - (vc-buffer-sync nil)) - (dolist (file files) - (when (buffer-modified-p (get-file-buffer file)) - (error "Please kill or save all modified buffers before rollback")) - (when (not (vc-up-to-date-p file)) - (error "Please revert all modified workfiles before rollback"))) - ;; Accumulate changes associated with the fileset - (vc-setup-buffer "*vc-diff*") - (not-modified) - (message "Finding changes...") - (let* ((tip (vc-working-revision (car files))) - ;; FIXME: `previous-revision' should take the fileset. - (previous (vc-call-backend backend 'previous-revision - (car files) tip))) - (vc-diff-internal nil vc-fileset previous tip)) - ;; Display changes - (unless (yes-or-no-p "Discard these revisions? ") - (error "Rollback canceled")) - (quit-windows-on "*vc-diff*") - ;; Do the actual reversions - (message "Rolling back %s..." (vc-delistify files)) - (with-vc-properties - files - (vc-call-backend backend 'rollback files) - `((vc-state . ,'up-to-date) - (vc-checkout-time . , (nth 5 (file-attributes file))) - (vc-working-revision . nil))) - (dolist (f files) (vc-resynch-buffer f t t)) - (message "Rolling back %s...done" (vc-delistify files)))) - -;;;###autoload (define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1") ;;;###autoload @@ -2509,14 +2447,14 @@ tip revision are merged into the working file." (and file (member file files)))))) (dolist (file files) (if (vc-up-to-date-p file) - (vc-checkout file nil t) + (vc-checkout file t) (vc-maybe-resolve-conflicts file (vc-call-backend backend 'merge-news file))))) ;; For a locking VCS, check out each file. ((eq (vc-checkout-model backend files) 'locking) (dolist (file files) (if (vc-up-to-date-p file) - (vc-checkout file nil t)))) + (vc-checkout file t)))) (t (error "VC update is unsupported for `%s'" backend))))) @@ -2638,7 +2576,7 @@ backend to NEW-BACKEND, and unregister FILE from the current backend. (when modified-file (vc-switch-backend file new-backend) (unless (eq (vc-checkout-model new-backend (list file)) 'implicit) - (vc-checkout file t nil)) + (vc-checkout file)) (rename-file modified-file file 'ok-if-already-exists) (vc-file-setprop file 'vc-checkout-time nil))))) (when move @@ -2649,34 +2587,7 @@ backend to NEW-BACKEND, and unregister FILE from the current backend. (when (or move edited) (vc-file-setprop file 'vc-state 'edited) (vc-mode-line file new-backend) - (vc-checkin file new-backend nil comment (stringp comment))))) - -(defun vc-rename-master (oldmaster newfile templates) - "Rename OLDMASTER to be the master file for NEWFILE based on TEMPLATES." - (let* ((dir (file-name-directory (expand-file-name oldmaster))) - (newdir (or (file-name-directory newfile) "")) - (newbase (file-name-nondirectory newfile)) - (masters - ;; List of potential master files for `newfile' - (mapcar - (lambda (s) (vc-possible-master s newdir newbase)) - templates))) - (when (or (file-symlink-p oldmaster) - (file-symlink-p (file-name-directory oldmaster))) - (error "This is unsafe in the presence of symbolic links")) - (rename-file - oldmaster - (catch 'found - ;; If possible, keep the master file in the same directory. - (dolist (f masters) - (when (and f (string= (file-name-directory (expand-file-name f)) dir)) - (throw 'found f))) - ;; If not, just use the first possible place. - (dolist (f masters) - (and f (or (not (setq dir (file-name-directory f))) - (file-directory-p dir)) - (throw 'found f))) - (error "New file lacks a version control directory"))))) + (vc-checkin file new-backend comment (stringp comment))))) ;;;###autoload (defun vc-delete-file (file) @@ -2811,19 +2722,6 @@ log entries should be gathered." The default is to return nil always." nil) -(defun vc-default-could-register (_backend _file) - "Return non-nil if BACKEND could be used to register FILE. -The default implementation returns t for all files." - t) - -(defun vc-default-latest-on-branch-p (_backend _file) - "Return non-nil if FILE is the latest on its branch. -This default implementation always returns non-nil, which means that -editing non-current revisions is not supported by default." - t) - -(defun vc-default-init-revision (_backend) vc-default-init-revision) - (defun vc-default-find-revision (backend file rev buffer) "Provide the new `find-revision' op based on the old `checkout' op. This is only for compatibility with old backends. They should be updated @@ -2918,9 +2816,9 @@ to provide the `find-revision' operation instead." (defalias 'vc-default-revision-completion-table 'ignore) (defalias 'vc-default-mark-resolved 'ignore) -(defun vc-default-dir-status-files (_backend _dir files default-state update-function) +(defun vc-default-dir-status-files (_backend _dir files update-function) (funcall update-function - (mapcar (lambda (file) (list file default-state)) files))) + (mapcar (lambda (file) (list file 'up-to-date)) files))) (defun vc-check-headers () "Check if the current file has any headers in it." diff --git a/lisp/version.el b/lisp/version.el index 75763b3f682..1837cbf0a85 100644 --- a/lisp/version.el +++ b/lisp/version.el @@ -93,41 +93,6 @@ or if we could not determine the revision.") (define-obsolete-variable-alias 'emacs-bzr-version 'emacs-repository-version "24.4") -(defun emacs-bzr-version-dirstate (dir) - "Try to return as a string the bzr revision ID of directory DIR. -This uses the dirstate file's parent revision entry. -Returns nil if unable to find this information." - (let ((file (expand-file-name ".bzr/checkout/dirstate" dir))) - (when (file-readable-p file) - (with-temp-buffer - (insert-file-contents file) - (and (looking-at "#bazaar dirstate flat format 3") - (forward-line 3) - (looking-at "[0-9]+\0\\([^\0\n]+\\)\0") - (match-string 1)))))) - -(defun emacs-bzr-version-bzr (dir) - "Ask bzr itself for the version information for directory DIR." - ;; Comments on `bzr version-info': - ;; i) Unknown files also cause clean != 1. - ;; ii) It can be slow, contacting the upstream repo to get the - ;; branch nick if one is not set locally, even with a custom - ;; template that is not asking for the nick (as used here). You'd - ;; think the latter part would be trivial to fix: - ;; https://bugs.launchpad.net/bzr/+bug/882541/comments/3 - ;; https://bugs.launchpad.net/bzr/+bug/629150 - ;; You can set the nick locally with `bzr nick ...', which speeds - ;; things up enormously. `bzr revno' does not have this issue, but - ;; has no way to print the revision_id AFAICS. - (message "Waiting for bzr...") - (with-temp-buffer - (if (zerop - (call-process "bzr" nil '(t nil) nil "version-info" - "--custom" - "--template={revno} {revision_id} (clean = {clean})" - dir)) - (buffer-string)))) - (define-obsolete-function-alias 'emacs-bzr-get-version 'emacs-repository-get-version "24.4") @@ -140,48 +105,10 @@ this reports on the current state of the sources, which may not correspond to the running Emacs. Optional argument DIR is a directory to use instead of -`source-directory'. Optional argument EXTERNAL non-nil means to -maybe ask the VCS itself, if the sources appear to be under -version control. If `force', always ask. the VCS. Otherwise -only ask the VCS if we cannot find any information ourselves." +`source-directory'. Optional argument EXTERNAL is ignored and is +retained for compatibility." (or dir (setq dir source-directory)) - (cond ((file-directory-p (expand-file-name ".bzr/branch" dir)) - (if (eq external 'force) - (emacs-bzr-version-bzr dir) - (let (file loc rev) - (cond ((file-readable-p - (setq file (expand-file-name - ".bzr/branch/last-revision" dir))) - (with-temp-buffer - (insert-file-contents file) - (goto-char (point-max)) - (if (looking-back "\n") - (delete-char -1)) - (buffer-string))) - ;; OK, no last-revision. Is it a lightweight checkout? - ((file-readable-p - (setq file (expand-file-name ".bzr/branch/location" dir))) - (setq rev (emacs-bzr-version-dirstate dir)) - ;; If parent branch is local, try looking there for the rev. - ;; Note: there is no guarantee that the parent branch's rev - ;; corresponds to this branch. This branch could have - ;; been made with a specific -r revno argument, or the - ;; parent could have been updated since this branch was - ;; created. - ;; To try and detect this, we check the dirstate revids - ;; to see if they match. - (if (and (setq loc (with-temp-buffer - (insert-file-contents file) - (if (looking-at "file://\\(.*\\)") - (match-string 1)))) - (equal rev (emacs-bzr-version-dirstate loc))) - (emacs-repository-get-version loc) - ;; If parent does not match, the best we can do without - ;; calling external commands is to use the dirstate rev. - rev)) - (external - (emacs-bzr-version-bzr dir)))))) - ((file-directory-p (expand-file-name ".git" dir)) + (cond ((file-directory-p (expand-file-name ".git" dir)) (message "Waiting for git...") (with-temp-buffer (let ((default-directory (file-name-as-directory dir))) diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index dc4702ffe0b..876df875b1b 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -26,7 +26,6 @@ ;;; Code: (require 'w32-vars) -(require 'w32-common-fns) (defvar explicit-shell-file-name) diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 6d4ac4d0be2..b4cd67ff6b9 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -266,6 +266,8 @@ ;; `whitespace-indentation' Face used to visualize 8 or more ;; SPACEs at beginning of line. ;; +;; `whitespace-big-indent' Face used to visualize big indentation. +;; ;; `whitespace-empty' Face used to visualize empty lines at ;; beginning and/or end of buffer. ;; @@ -286,6 +288,9 @@ ;; `whitespace-indentation-regexp' Specify regexp for 8 or more ;; SPACEs at beginning of line. ;; +;; `whitespace-big-indent-regexp' Specify big indentation at beginning of line +;; regexp. +;; ;; `whitespace-empty-at-bob-regexp' Specify regexp for empty lines ;; at beginning of buffer. ;; @@ -452,6 +457,10 @@ It's a list containing some or all of the following values: It has effect only if `face' (see above) is present in `whitespace-style'. + big-indent Big indentations are visualized via faces. + It has effect only if `face' (see above) + is present in `whitespace-style'. + space-after-tab::tab 8 or more SPACEs after a TAB are visualized via faces. It has effect only if `face' (see above) @@ -544,6 +553,8 @@ See also `whitespace-display-mappings' for documentation." (const :tag "(Face) NEWLINEs" newline) (const :tag "(Face) Indentation SPACEs" indentation) + (const :tag "(Face) Too much line indentation" + big-indent) (const :tag "(Face) Empty Lines At BOB And/Or EOB" empty) (const :tag "(Face) SPACEs after TAB" @@ -673,6 +684,12 @@ Used when `whitespace-style' includes the value `indentation'.") "Face used to visualize 8 or more SPACEs at beginning of line." :group 'whitespace) +(defface whitespace-big-indent + '((((class mono)) :inverse-video t :weight bold :underline t) + (t :background "red" :foreground "firebrick")) + "Face used to visualize big indentation." + :group 'whitespace) + (defvar whitespace-empty 'whitespace-empty "Symbol face used to visualize empty lines at beginning and/or end of buffer. @@ -838,6 +855,21 @@ Used when `whitespace-style' includes `space-after-tab', string) :group 'whitespace) +(defcustom whitespace-big-indent-regexp + "^\\(\\(?:\t\\{4,\\}\\| \\{32,\\}\\)[\t ]*\\)" + "Specify big indentation regexp. + +If you're using `mule' package, there may be other characters +besides \"\\t\" that should be considered TAB. + +NOTE: Enclose always by \\\\( and \\\\) the elements to highlight. + Use exactly one pair of enclosing \\\\( and \\\\). + +Used when `whitespace-style' includes `big-indent'." + :version "25.1" + :type '(regexp :tag "Detect too much indentation at the beginning of a line") + :group 'whitespace) + (defcustom whitespace-line-column 80 "Specify column beyond which the line is highlighted. @@ -1141,6 +1173,7 @@ See also `whitespace-newline' and `whitespace-display-mappings'." indentation indentation::tab indentation::space + big-indent space-after-tab space-after-tab::tab space-after-tab::space @@ -1167,6 +1200,7 @@ See also `whitespace-newline' and `whitespace-display-mappings'." (?\C-i . indentation) (?I . indentation::tab) (?i . indentation::space) + (?\C-t . big-indent) (?\C-a . space-after-tab) (?A . space-after-tab::tab) (?a . space-after-tab::space) @@ -1204,6 +1238,8 @@ SYMBOL is a valid symbol associated with CHAR. (defvar whitespace-point (point) "Used to save locally current point value. Used by function `whitespace-trailing-regexp' (which see).") +(defvar-local whitespace-point--used nil + "Region whose highlighting depends on `whitespace-point'.") (defvar whitespace-font-lock-refontify nil "Used to save locally the font-lock refontify state. @@ -1248,6 +1284,7 @@ Interactively, it reads one of the following chars: C-i toggle indentation SPACEs visualization (via `indent-tabs-mode') I toggle indentation SPACEs visualization i toggle indentation TABs visualization + C-t toggle big indentation visualization C-a toggle SPACEs after TAB visualization (via `indent-tabs-mode') A toggle SPACEs after TAB: SPACEs visualization a toggle SPACEs after TAB: TABs visualization @@ -1277,6 +1314,7 @@ The valid symbols are: indentation toggle indentation SPACEs visualization indentation::tab toggle indentation SPACEs visualization indentation::space toggle indentation TABs visualization + big-indent toggle big indentation visualization space-after-tab toggle SPACEs after TAB visualization space-after-tab::tab toggle SPACEs after TAB: SPACEs visualization space-after-tab::space toggle SPACEs after TAB: TABs visualization @@ -1327,6 +1365,7 @@ Interactively, it accepts one of the following chars: C-i toggle indentation SPACEs visualization (via `indent-tabs-mode') I toggle indentation SPACEs visualization i toggle indentation TABs visualization + C-t toggle big indentation visualization C-a toggle SPACEs after TAB visualization (via `indent-tabs-mode') A toggle SPACEs after TAB: SPACEs visualization a toggle SPACEs after TAB: TABs visualization @@ -1356,6 +1395,7 @@ The valid symbols are: indentation toggle indentation SPACEs visualization indentation::tab toggle indentation SPACEs visualization indentation::space toggle indentation TABs visualization + big-indent toggle big indentation visualization space-after-tab toggle SPACEs after TAB visualization space-after-tab::tab toggle SPACEs after TAB: SPACEs visualization space-after-tab::space toggle SPACEs after TAB: TABs visualization @@ -1717,43 +1757,7 @@ It is a cons of strings, where the car part is used when (defun whitespace-report (&optional force report-if-bogus) "Report some whitespace problems in buffer. -Return nil if there is no whitespace problem; otherwise, return -non-nil. - -If FORCE is non-nil or \\[universal-argument] was pressed just -before calling `whitespace-report' interactively, it forces -`whitespace-style' to have: - - empty - trailing - indentation - space-before-tab - space-after-tab - -If REPORT-IF-BOGUS is non-nil, it reports only when there are any -whitespace problems in buffer. - -Report if some of the following whitespace problems exist: - -* If `indent-tabs-mode' is non-nil: - empty 1. empty lines at beginning of buffer. - empty 2. empty lines at end of buffer. - trailing 3. SPACEs or TABs at end of line. - indentation 4. 8 or more SPACEs at beginning of line. - space-before-tab 5. SPACEs before TAB. - space-after-tab 6. 8 or more SPACEs after TAB. - -* If `indent-tabs-mode' is nil: - empty 1. empty lines at beginning of buffer. - empty 2. empty lines at end of buffer. - trailing 3. SPACEs or TABs at end of line. - indentation 4. TABS at beginning of line. - space-before-tab 5. SPACEs before TAB. - space-after-tab 6. 8 or more SPACEs after TAB. - -See `whitespace-style' for documentation. -See also `whitespace-cleanup' and `whitespace-cleanup-region' for -cleaning up these problems." +Perform `whitespace-report-region' on the current buffer." (interactive (list current-prefix-arg)) (whitespace-report-region (point-min) (point-max) force report-if-bogus)) @@ -1771,13 +1775,14 @@ before calling `whitespace-report-region' interactively, it forces `whitespace-style' to have: empty + trailing indentation space-before-tab - trailing space-after-tab -If REPORT-IF-BOGUS is non-nil, it reports only when there are any -whitespace problems in buffer. +If REPORT-IF-BOGUS is t, it reports only when there are any +whitespace problems in buffer; if it is `never', it does not +report problems. Report if some of the following whitespace problems exist: @@ -1832,7 +1837,7 @@ cleaning up these problems." (and (re-search-forward regexp rend t) (setq has-bogus t)))) whitespace-report-list))) - (when (if report-if-bogus has-bogus t) + (when (pcase report-if-bogus (`nil t) (`never nil) (_ has-bogus)) (whitespace-kill-buffer whitespace-report-buffer-name) ;; `whitespace-indent-tabs-mode' is local to current buffer ;; `whitespace-tab-width' is local to current buffer @@ -1889,6 +1894,7 @@ cleaning up these problems." [] C-i - toggle indentation SPACEs visualization (via `indent-tabs-mode') [] I - toggle indentation SPACEs visualization [] i - toggle indentation TABs visualization + [] C-t - toggle big indentation visualization [] C-a - toggle SPACEs after TAB visualization (via `indent-tabs-mode') [] A - toggle SPACEs after TAB: SPACEs visualization [] a - toggle SPACEs after TAB: TABs visualization @@ -2142,6 +2148,7 @@ resultant list will be returned." (memq 'indentation whitespace-active-style) (memq 'indentation::tab whitespace-active-style) (memq 'indentation::space whitespace-active-style) + (memq 'big-indent whitespace-active-style) (memq 'space-after-tab whitespace-active-style) (memq 'space-after-tab::tab whitespace-active-style) (memq 'space-after-tab::space whitespace-active-style) @@ -2155,7 +2162,10 @@ resultant list will be returned." (when (whitespace-style-face-p) ;; save current point and refontify when necessary (set (make-local-variable 'whitespace-point) - (point)) + (point)) + (setq whitespace-point--used + (let ((ol (make-overlay (point) (point) nil nil t))) + (delete-overlay ol) ol)) (set (make-local-variable 'whitespace-font-lock-refontify) 0) (set (make-local-variable 'whitespace-bob-marker) @@ -2170,6 +2180,7 @@ resultant list will be returned." (setq whitespace-font-lock-keywords `( + (whitespace-point--flush-used) ,@(when (memq 'spaces whitespace-active-style) ;; Show SPACEs. `((,whitespace-space-regexp 1 whitespace-space t) @@ -2225,6 +2236,9 @@ resultant list will be returned." ;; Show indentation SPACEs (TABs). (whitespace-indentation-regexp 'space))) 1 whitespace-indentation t))) + ,@(when (memq 'big-indent whitespace-active-style) + ;; Show big indentation. + `((,whitespace-big-indent-regexp 1 'whitespace-big-indent t))) ,@(when (memq 'empty whitespace-active-style) ;; Show empty lines at beginning of buffer. `((,#'whitespace-empty-at-bob-regexp @@ -2247,26 +2261,47 @@ resultant list will be returned." (whitespace-space-after-tab-regexp 'space))) 1 whitespace-space-after-tab t))))) (font-lock-add-keywords nil whitespace-font-lock-keywords t) - (when font-lock-mode - (font-lock-fontify-buffer)))) + (font-lock-flush))) (defun whitespace-color-off () "Turn off color visualization." ;; turn off font lock + (kill-local-variable 'whitespace-point--used) (when (whitespace-style-face-p) (remove-hook 'post-command-hook #'whitespace-post-command-hook t) (remove-hook 'before-change-functions #'whitespace-buffer-changed t) (font-lock-remove-keywords nil whitespace-font-lock-keywords) - (when font-lock-mode - (font-lock-fontify-buffer)))) - + (font-lock-flush))) + +(defun whitespace-point--used (start end) + (let ((ostart (overlay-start whitespace-point--used))) + (if ostart + (move-overlay whitespace-point--used + (min start ostart) + (max end (overlay-end whitespace-point--used))) + (move-overlay whitespace-point--used start end)))) + +(defun whitespace-point--flush-used (limit) + (let ((ostart (overlay-start whitespace-point--used))) + ;; Strip parts of whitespace-point--used we're about to refresh. + (when ostart + (let ((oend (overlay-end whitespace-point--used))) + (if (<= (point) ostart) + (if (<= oend limit) + (delete-overlay whitespace-point--used) + (move-overlay whitespace-point--used limit oend))) + (if (<= oend limit) + (move-overlay whitespace-point--used ostart (point)))))) + nil) (defun whitespace-trailing-regexp (limit) "Match trailing spaces which do not contain the point at end of line." (let ((status t)) (while (if (re-search-forward whitespace-trailing-regexp limit t) - (= whitespace-point (match-end 1)) ;; loop if point at eol + (when (= whitespace-point (match-end 1)) ; Loop if point at eol. + (whitespace-point--used (match-beginning 0) (match-end 0)) + t) (setq status nil))) ;; end of buffer status)) @@ -2279,8 +2314,11 @@ beginning of buffer." (cond ;; at bob ((= b 1) - (setq r (and (/= whitespace-point 1) - (looking-at whitespace-empty-at-bob-regexp))) + (setq r (and (looking-at whitespace-empty-at-bob-regexp) + (or (/= whitespace-point 1) + (progn (whitespace-point--used (match-beginning 0) + (match-end 0)) + nil)))) (set-marker whitespace-bob-marker (if r (match-end 1) b))) ;; inside bob empty region ((<= limit whitespace-bob-marker) @@ -2318,9 +2356,11 @@ buffer." (cond ;; at eob ((= limit e) - (when (/= whitespace-point e) - (goto-char limit) - (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))) + (goto-char limit) + (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b)) + (when (and r (= whitespace-point e)) + (setq r nil) + (whitespace-point--used (match-beginning 0) (match-end 0))) (if r (set-marker whitespace-eob-marker (match-beginning 1)) (set-marker whitespace-eob-marker limit) @@ -2356,43 +2396,57 @@ buffer." (defun whitespace-post-command-hook () "Save current point into `whitespace-point' variable. Also refontify when necessary." - (setq whitespace-point (point)) ; current point position - (let ((refontify - (or - ;; it is at end of line ... - (and (eolp) - ;; ... with trailing SPACE or TAB - (or (= (preceding-char) ?\ ) - (= (preceding-char) ?\t))) - ;; it is at beginning of buffer (bob) - (= whitespace-point 1) - ;; the buffer was modified and ... - (and whitespace-buffer-changed - (or - ;; ... or inside bob whitespace region - (<= whitespace-point whitespace-bob-marker) - ;; ... or at bob whitespace region border - (and (= whitespace-point (1+ whitespace-bob-marker)) - (= (preceding-char) ?\n)))) - ;; it is at end of buffer (eob) - (= whitespace-point (1+ (buffer-size))) - ;; the buffer was modified and ... - (and whitespace-buffer-changed - (or - ;; ... or inside eob whitespace region - (>= whitespace-point whitespace-eob-marker) - ;; ... or at eob whitespace region border - (and (= whitespace-point (1- whitespace-eob-marker)) - (= (following-char) ?\n))))))) - (when (or refontify (> whitespace-font-lock-refontify 0)) - (setq whitespace-buffer-changed nil) - ;; adjust refontify counter - (setq whitespace-font-lock-refontify - (if refontify - 1 - (1- whitespace-font-lock-refontify))) - ;; refontify - (jit-lock-refontify)))) + (unless (and (eq whitespace-point (point)) + (not whitespace-buffer-changed)) + (setq whitespace-point (point)) ; current point position + (let ((refontify + (cond + ;; It is at end of buffer (eob). + ((= whitespace-point (1+ (buffer-size))) + (when (whitespace-looking-back whitespace-empty-at-eob-regexp + nil) + (match-beginning 0))) + ;; It is at end of line ... + ((and (eolp) + ;; ... with trailing SPACE or TAB + (or (memq (preceding-char) '(?\s ?\t)))) + (line-beginning-position)) + ;; It is at beginning of buffer (bob). + ((and (= whitespace-point 1) + (looking-at whitespace-empty-at-bob-regexp)) + (match-end 0)))) + (ostart (overlay-start whitespace-point--used))) + (cond + ((not refontify) + ;; New point does not affect highlighting: just refresh the + ;; highlighting of old point, if needed. + (when ostart + (font-lock-flush ostart + (overlay-end whitespace-point--used)) + (delete-overlay whitespace-point--used))) + ((not ostart) + ;; Old point did not affect highlighting, but new one does: refresh the + ;; highlighting of new point. + (font-lock-flush (min refontify (point)) (max refontify (point)))) + ((save-excursion + (goto-char ostart) + (setq ostart (line-beginning-position)) + (and (<= ostart (max refontify (point))) + (progn + (goto-char (overlay-end whitespace-point--used)) + (let ((oend (line-beginning-position 2))) + (<= (min refontify (point)) oend))))) + ;; The old point highlighting and the new point highlighting + ;; cover a contiguous region: do a single refresh. + (font-lock-flush (min refontify (point) ostart) + (max refontify (point) + (overlay-end whitespace-point--used))) + (delete-overlay whitespace-point--used)) + (t + (font-lock-flush (min refontify (point)) + (max refontify (point))) + (font-lock-flush ostart (overlay-end whitespace-point--used)) + (delete-overlay whitespace-point--used)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 06a24d1b9c8..04a900f23c0 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -232,23 +232,20 @@ minibuffer." (t ;; Construct a menu of the choices ;; and then use it for prompting for a single character. - (let* ((overriding-terminal-local-map (make-sparse-keymap)) - (next-digit ?0) - map choice some-choice-enabled value) - ;; Define SPC as a prefix char to get to this menu. - (define-key overriding-terminal-local-map " " - (setq map (make-sparse-keymap title))) + (let* ((next-digit ?0) + (map (make-sparse-keymap)) + choice some-choice-enabled value) (with-current-buffer (get-buffer-create " widget-choose") (erase-buffer) (insert "Available choices:\n\n") (while items - (setq choice (car items) items (cdr items)) - (if (consp choice) - (let* ((name (car choice)) - (function (cdr choice))) - (insert (format "%c = %s\n" next-digit name)) - (define-key map (vector next-digit) function) - (setq some-choice-enabled t))) + (setq choice (pop items)) + (when (consp choice) + (let* ((name (car choice)) + (function (cdr choice))) + (insert (format "%c = %s\n" next-digit name)) + (define-key map (vector next-digit) function) + (setq some-choice-enabled t))) ;; Allocate digits to disabled alternatives ;; so that the digit of a given alternative never varies. (setq next-digit (1+ next-digit))) @@ -257,43 +254,29 @@ minibuffer." (forward-line)) (or some-choice-enabled (error "None of the choices is currently meaningful")) - (define-key map [?\C-g] 'keyboard-quit) - (define-key map [t] 'keyboard-quit) (define-key map [?\M-\C-v] 'scroll-other-window) (define-key map [?\M--] 'negative-argument) - (setcdr map (nreverse (cdr map))) - ;; Read a char with the menu, and return the result - ;; that corresponds to it. (save-window-excursion (let ((buf (get-buffer " widget-choose"))) (fit-window-to-buffer (display-buffer buf)) (let ((cursor-in-echo-area t) - keys - (char 0) (arg 1)) - (while (not (or (and (integerp char) - (>= char ?0) (< char next-digit)) - (eq value 'keyboard-quit))) - ;; Unread a SPC to lead to our new menu. - (setq unread-command-events (cons ?\s unread-command-events)) - (setq keys (read-key-sequence title)) - (setq value - (lookup-key overriding-terminal-local-map keys t) - char (aref keys 1)) - (cond ((eq value 'scroll-other-window) - (let ((minibuffer-scroll-window - (get-buffer-window buf))) - (if (> 0 arg) - (scroll-other-window-down - (window-height minibuffer-scroll-window)) - (scroll-other-window)) - (setq arg 1))) - ((eq value 'negative-argument) - (setq arg -1)) - (t - (setq arg 1))))))) - (when (eq value 'keyboard-quit) - (error "Canceled")) + (while (not value) + (setq value (lookup-key map (read-key-sequence (format "%s: " title)))) + (unless value + (user-error "Canceled")) + (when + (cond ((eq value 'scroll-other-window) + (let ((minibuffer-scroll-window + (get-buffer-window buf))) + (if (> 0 arg) + (scroll-other-window-down + (window-height minibuffer-scroll-window)) + (scroll-other-window)) + (setq arg 1))) + ((eq value 'negative-argument) + (setq arg -1))) + (setq value nil)))))) value)))) ;;; Widget text specifications. @@ -2626,7 +2609,7 @@ Return an alist of (TYPE MATCH)." (let* ((value (widget-get widget :value)) (type (nth 0 (widget-get widget :args))) children) - (widget-put widget :value-pos (copy-marker (point))) + (widget-put widget :value-pos (point-marker)) (set-marker-insertion-type (widget-get widget :value-pos) t) (while value (let ((answer (widget-match-inline type value))) diff --git a/lisp/window.el b/lisp/window.el index 95a5f8fbbc9..abc60063ab9 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -108,7 +108,7 @@ Return the buffer." ;; Return the buffer. buffer))) -(defun temp-buffer-window-show (&optional buffer action) +(defun temp-buffer-window-show (buffer &optional action) "Show temporary buffer BUFFER in a window. Return the window showing BUFFER. Pass ACTION as action argument to `display-buffer'." @@ -185,16 +185,19 @@ argument replaces this)." (let ((buffer (make-symbol "buffer")) (window (make-symbol "window")) (value (make-symbol "value"))) - `(let* ((,buffer (temp-buffer-window-setup ,buffer-or-name)) - (standard-output ,buffer) - ,window ,value) - (setq ,value (progn ,@body)) - (with-current-buffer ,buffer - (setq ,window (temp-buffer-window-show ,buffer ,action))) + (macroexp-let2* nil ((vbuffer-or-name buffer-or-name) + (vaction action) + (vquit-function quit-function)) + `(let* ((,buffer (temp-buffer-window-setup ,vbuffer-or-name)) + (standard-output ,buffer) + ,window ,value) + (setq ,value (progn ,@body)) + (with-current-buffer ,buffer + (setq ,window (temp-buffer-window-show ,buffer ,vaction))) - (if (functionp ,quit-function) - (funcall ,quit-function ,window ,value) - ,value)))) + (if (functionp ,vquit-function) + (funcall ,vquit-function ,window ,value) + ,value))))) (defmacro with-current-buffer-window (buffer-or-name action quit-function &rest body) "Evaluate BODY with a buffer BUFFER-OR-NAME current and show that buffer. @@ -205,16 +208,61 @@ BODY." (let ((buffer (make-symbol "buffer")) (window (make-symbol "window")) (value (make-symbol "value"))) - `(let* ((,buffer (temp-buffer-window-setup ,buffer-or-name)) - (standard-output ,buffer) - ,window ,value) - (with-current-buffer ,buffer - (setq ,value (progn ,@body)) - (setq ,window (temp-buffer-window-show ,buffer ,action))) + (macroexp-let2* nil ((vbuffer-or-name buffer-or-name) + (vaction action) + (vquit-function quit-function)) + `(let* ((,buffer (temp-buffer-window-setup ,vbuffer-or-name)) + (standard-output ,buffer) + ,window ,value) + (with-current-buffer ,buffer + (setq ,value (progn ,@body)) + (setq ,window (temp-buffer-window-show ,buffer ,vaction))) + + (if (functionp ,vquit-function) + (funcall ,vquit-function ,window ,value) + ,value))))) + +(defmacro with-displayed-buffer-window (buffer-or-name action quit-function &rest body) + "Show a buffer BUFFER-OR-NAME and evaluate BODY in that buffer. +This construct is like `with-current-buffer-window' but unlike that +displays the buffer specified by BUFFER-OR-NAME before running BODY." + (declare (debug t)) + (let ((buffer (make-symbol "buffer")) + (window (make-symbol "window")) + (value (make-symbol "value"))) + (macroexp-let2* nil ((vbuffer-or-name buffer-or-name) + (vaction action) + (vquit-function quit-function)) + `(let* ((,buffer (temp-buffer-window-setup ,vbuffer-or-name)) + (standard-output ,buffer) + ,window ,value) + (with-current-buffer ,buffer + (setq ,window (temp-buffer-window-show + ,buffer + ;; Remove window-height when it's handled below. + (if (functionp (cdr (assq 'window-height (cdr ,vaction)))) + (assq-delete-all 'window-height (copy-sequence ,vaction)) + ,vaction)))) + + (let ((inhibit-read-only t) + (inhibit-modification-hooks t)) + (setq ,value (progn ,@body))) + + (set-window-point ,window (point-min)) + + (when (functionp (cdr (assq 'window-height (cdr ,vaction)))) + (ignore-errors + (funcall (cdr (assq 'window-height (cdr ,vaction))) ,window))) + + (when (consp (cdr (assq 'preserve-size (cdr ,vaction)))) + (window-preserve-size + ,window t (cadr (assq 'preserve-size (cdr ,vaction)))) + (window-preserve-size + ,window nil (cddr (assq 'preserve-size (cdr ,vaction))))) - (if (functionp ,quit-function) - (funcall ,quit-function ,window ,value) - ,value)))) + (if (functionp ,vquit-function) + (funcall ,vquit-function ,window ,value) + ,value))))) ;; The following two functions are like `window-next-sibling' and ;; `window-prev-sibling' but the WINDOW argument is _not_ optional (so @@ -341,9 +389,9 @@ Anything less might crash Emacs.") (defcustom window-min-height 4 "The minimum total height, in lines, of any window. The value has to accommodate one text line, a mode and header -line, and a bottom divider, if present. A value less than -`window-safe-min-height' is ignored. The value of this variable -is honored when windows are resized or split. +line, a horizontal scroll bar and a bottom divider, if present. +A value less than `window-safe-min-height' is ignored. The value +of this variable is honored when windows are resized or split. Applications should never rebind this variable. To resize a window to a height less than the one specified here, an @@ -398,6 +446,14 @@ minimum pixel width of WINDOW." (window-safe-min-pixel-width window) (window-safe-min-pixel-height window))) +(defun window-min-pixel-size (&optional window horizontal) + "Return the minimum pixel height of WINDOW. +Optional argument HORIZONTAL non-nil means return the minimum +pixel width of WINDOW." + (if horizontal + (window-min-pixel-width window) + (window-min-pixel-height window))) + (defun window-combined-p (&optional window horizontal) "Return non-nil if WINDOW has siblings in a given direction. WINDOW must be a valid window and defaults to the selected one. @@ -706,6 +762,15 @@ number of slots on that side." (integer :tag "Number" :value 3 :size 5))) :group 'windows) +(defun window--side-window-p (window) + "Return non-nil if WINDOW is a side window or the parent of one." + (or (window-parameter window 'window-side) + (and (window-child window) + (or (window-parameter + (window-child window) 'window-side) + (window-parameter + (window-last-child window) 'window-side))))) + (defun window--major-non-side-window (&optional frame) "Return the major non-side window of frame FRAME. The optional argument FRAME must be a live frame and defaults to @@ -1100,11 +1165,12 @@ dumping to it." (format "frame text pixel: %s x %s cols/lines: %s x %s\n" (frame-text-width frame) (frame-text-height frame) (frame-text-cols frame) (frame-text-lines frame)) - (format "tool: %s scroll: %s fringe: %s border: %s right: %s bottom: %s\n\n" + (format "tool: %s scroll: %s/%s fringe: %s border: %s right: %s bottom: %s\n\n" (if (fboundp 'tool-bar-height) (tool-bar-height frame t) "0") (frame-scroll-bar-width frame) + (frame-scroll-bar-height frame) (frame-fringe-width frame) (frame-border-width frame) (frame-right-divider-width frame) @@ -1168,9 +1234,73 @@ unless it has no other choice (like when deleting a neighboring window).") (make-variable-buffer-local 'window-size-fixed) -(defun window--size-ignore-p (window ignore) - "Return non-nil if IGNORE says to ignore size restrictions for WINDOW." - (if (window-valid-p ignore) (eq window ignore) ignore)) +(defun window--preservable-size (window &optional horizontal) + "Return height of WINDOW as `window-preserve-size' would preserve it. +Optional argument HORIZONTAL non-nil means to return the width of +WINDOW as `window-preserve-size' would preserve it." + (if horizontal + (window-body-width window t) + (+ (window-body-height window t) + (window-header-line-height window) + (window-mode-line-height window)))) + +(defun window-preserve-size (&optional window horizontal preserve) + "Preserve height of window WINDOW. +WINDOW must be a live window and defaults to the selected one. +Optional argument HORIZONTAL non-nil means preserve the width of +WINDOW. + +PRESERVE t means to preserve the current height/width of WINDOW's +body in frame and window resizing operations whenever possible. +The height/width of WINDOW will change only if Emacs has no other +choice. Resizing a window whose height/width is preserved never +throws an error. + +PRESERVE nil means to stop preserving the height/width of WINDOW, +lifting the respective restraint induced by a previous call of +`window-preserve-size' for WINDOW. Calling `enlarge-window', +`shrink-window', `split-window' or `fit-window-to-buffer' with +WINDOW as argument also removes the respective restraint. + +Other values of PRESERVE are reserved for future use." + (setq window (window-normalize-window window t)) + (let* ((parameter (window-parameter window 'window-preserved-size)) + (width (nth 1 parameter)) + (height (nth 2 parameter))) + (if horizontal + (set-window-parameter + window 'window-preserved-size + (list + (window-buffer window) + (and preserve (window--preservable-size window t)) + height)) + (set-window-parameter + window 'window-preserved-size + (list + (window-buffer window) + width + (and preserve (window--preservable-size window))))))) + +(defun window-preserved-size (&optional window horizontal) + "Return preserved height of window WINDOW. +WINDOW must be a live window and defaults to the selected one. +Optional argument HORIZONTAL non-nil means to return preserved +width of WINDOW." + (setq window (window-normalize-window window t)) + (let* ((parameter (window-parameter window 'window-preserved-size)) + (buffer (nth 0 parameter)) + (width (nth 1 parameter)) + (height (nth 2 parameter))) + (when (eq buffer (window-buffer window)) + (if horizontal width height)))) + +(defun window--preserve-size (window horizontal) + "Return non-nil when the height of WINDOW shall be preserved. +Optional argument HORIZONTAL non-nil means to return non-nil when +the width of WINDOW shall be preserved." + (let ((size (window-preserved-size window horizontal))) + (and (numberp size) + (= size (window--preservable-size window horizontal))))) (defun window-safe-min-size (&optional window horizontal pixelwise) "Return safe minimum size of WINDOW. @@ -1197,19 +1327,20 @@ Optional argument HORIZONTAL non-nil means return the minimum number of columns of WINDOW; otherwise return the minimum number of WINDOW's lines. -Optional argument IGNORE, if non-nil, means ignore restrictions -imposed by fixed size windows, `window-min-height' or -`window-min-width' settings. If IGNORE equals `safe', live -windows may get as small as `window-safe-min-height' lines and -`window-safe-min-width' columns. If IGNORE is a window, ignore -restrictions for that window only. Any other non-nil value -means ignore all of the above restrictions for all windows. - -Optional argument PIXELWISE non-nil means return the minimum pixel-size -of WINDOW." +The optional argument IGNORE has the same meaning as for +`window-resizable'. Optional argument PIXELWISE non-nil means +return the minimum pixel-size of WINDOW." (window--min-size-1 (window-normalize-window window) horizontal ignore pixelwise)) +(defun window--min-size-ignore-p (window horizontal ignore) + "Return non-nil if IGNORE says to ignore height restrictions for WINDOW. +HORIZONTAL non-nil means to return non-nil if IGNORE says to +ignore width restrictions for WINDOW." + (if (window-valid-p ignore) + (eq window ignore) + (not (memq ignore '(nil preserved))))) + (defun window--min-size-1 (window horizontal ignore pixelwise) "Internal function of `window-min-size'." (let ((sub (window-child window))) @@ -1234,12 +1365,13 @@ of WINDOW." value) (with-current-buffer (window-buffer window) (cond - ((and (not (window--size-ignore-p window ignore)) - (window-size-fixed-p window horizontal)) + ((window-minibuffer-p window) + (if pixelwise (frame-char-height (window-frame window)) 1)) + ((window-size-fixed-p window horizontal ignore) ;; The minimum size of a fixed size window is its size. (window-size window horizontal pixelwise)) - ((or (eq ignore 'safe) (eq ignore window)) - ;; If IGNORE equals `safe' or WINDOW return the safe values. + ((eq ignore 'safe) + ;; If IGNORE equals `safe' return the safe value. (window-safe-min-size window horizontal pixelwise)) (horizontal ;; For the minimum width of a window take fringes and @@ -1250,8 +1382,11 @@ of WINDOW." ;; `window-min-width'. (let* ((char-size (frame-char-size window t)) (fringes (window-fringes window)) + (margins (window-margins window)) (pixel-width (+ (window-safe-min-size window t t) + (* (or (car margins) 0) char-size) + (* (or (cdr margins) 0) char-size) (car fringes) (cadr fringes) (window-scroll-bar-width window) (window-right-divider-width window)))) @@ -1261,18 +1396,19 @@ of WINDOW." pixel-width ;; Round up to next integral of columns. (* (ceiling pixel-width char-size) char-size)) - (if (window--size-ignore-p window ignore) + (if (window--min-size-ignore-p window horizontal ignore) 0 - (window-min-pixel-width))) + (window-min-pixel-width window))) (max (ceiling pixel-width char-size) - (if (window--size-ignore-p window ignore) + (if (window--min-size-ignore-p window horizontal ignore) 0 window-min-width))))) ((let ((char-size (frame-char-size window)) (pixel-height (+ (window-safe-min-size window nil t) (window-header-line-height window) + (window-scroll-bar-height window) (window-mode-line-height window) (window-bottom-divider-width window)))) (if pixelwise @@ -1281,11 +1417,11 @@ of WINDOW." pixel-height ;; Round up to next integral of lines. (* (ceiling pixel-height char-size) char-size)) - (if (window--size-ignore-p window ignore) + (if (window--min-size-ignore-p window horizontal ignore) 0 - (window-min-pixel-height))) + (window-min-pixel-height window))) (max (ceiling pixel-height char-size) - (if (window--size-ignore-p window ignore) + (if (window--min-size-ignore-p window horizontal ignore) 0 window-min-height)))))))))) @@ -1310,26 +1446,17 @@ columns. If WINDOW cannot be shrunk by -DELTA lines or columns, return the minimum value in the range DELTA..0 by which WINDOW can be shrunk. -Optional argument IGNORE non-nil means ignore restrictions -imposed by fixed size windows, `window-min-height' or -`window-min-width' settings. If IGNORE equals `safe', live -windows may get as small as `window-safe-min-height' lines and -`window-safe-min-width' columns. If IGNORE is a window, ignore -restrictions for that window only. Any other non-nil value means -ignore all of the above restrictions for all windows. - -Optional argument PIXELWISE non-nil means interpret DELTA as -pixels." +The optional argument IGNORE has the same meaning as for +`window-resizable'. Optional argument PIXELWISE non-nil means +interpret DELTA as pixels." (setq window (window-normalize-window window)) (cond ((< delta 0) (max (- (window-min-size window horizontal ignore pixelwise) (window-size window horizontal pixelwise)) delta)) - ((window--size-ignore-p window ignore) - delta) ((> delta 0) - (if (window-size-fixed-p window horizontal) + (if (window-size-fixed-p window horizontal ignore) 0 delta)) (t 0))) @@ -1346,7 +1473,7 @@ doc-string of `window-sizable'." (<= (window-sizable window delta horizontal ignore pixelwise) delta))) -(defun window--size-fixed-1 (window horizontal) +(defun window--size-fixed-1 (window horizontal ignore) "Internal function for `window-size-fixed-p'." (let ((sub (window-child window))) (catch 'fixed @@ -1357,7 +1484,7 @@ doc-string of `window-sizable'." ;; windows are fixed-size. (progn (while sub - (unless (window--size-fixed-1 sub horizontal) + (unless (window--size-fixed-1 sub horizontal ignore) ;; We found a non-fixed-size child window, so ;; WINDOW's size is not fixed. (throw 'fixed nil)) @@ -1368,28 +1495,33 @@ doc-string of `window-sizable'." ;; An ortho-combination is fixed-size if at least one of its ;; child windows is fixed-size. (while sub - (when (window--size-fixed-1 sub horizontal) + (when (window--size-fixed-1 sub horizontal ignore) ;; We found a fixed-size child window, so WINDOW's size ;; is fixed. (throw 'fixed t)) (setq sub (window-right sub)))) ;; WINDOW is a live window. - (with-current-buffer (window-buffer window) - (if horizontal - (memq window-size-fixed '(width t)) - (memq window-size-fixed '(height t)))))))) - -(defun window-size-fixed-p (&optional window horizontal) + (and (or (not (windowp ignore)) (not (eq window ignore))) + (or (and (not (eq ignore 'preserved)) + (window--preserve-size window horizontal)) + (with-current-buffer (window-buffer window) + (if horizontal + (memq window-size-fixed '(width t)) + (memq window-size-fixed '(height t)))))))))) + +(defun window-size-fixed-p (&optional window horizontal ignore) "Return non-nil if WINDOW's height is fixed. WINDOW must be a valid window and defaults to the selected one. Optional argument HORIZONTAL non-nil means return non-nil if -WINDOW's width is fixed. +WINDOW's width is fixed. The optional argument IGNORE has the +same meaning as for `window-resizable'. If this function returns nil, this does not necessarily mean that WINDOW can be resized in the desired direction. The function `window-resizable' can tell that." - (window--size-fixed-1 - (window-normalize-window window) horizontal)) + (when (or (windowp ignore) (memq ignore '(nil preserved))) + (window--size-fixed-1 + (window-normalize-window window) horizontal ignore))) (defun window--min-delta-1 (window delta &optional horizontal ignore trail noup pixelwise) "Internal function for `window-min-delta'." @@ -1410,8 +1542,7 @@ WINDOW can be resized in the desired direction. The function ((eq sub window) (setq skip (eq trail 'before))) (skip) - ((and (not (window--size-ignore-p window ignore)) - (window-size-fixed-p sub horizontal))) + ((window-size-fixed-p sub horizontal ignore)) (t ;; We found a non-fixed-size child window. (throw 'done delta))) @@ -1440,25 +1571,18 @@ Return zero if WINDOW cannot be shrunk. Optional argument HORIZONTAL non-nil means return number of columns by which WINDOW can be shrunk. -Optional argument IGNORE non-nil means ignore restrictions -imposed by fixed size windows, `window-min-height' or -`window-min-width' settings. If IGNORE is a window, ignore -restrictions for that window only. If IGNORE equals `safe', -live windows may get as small as `window-safe-min-height' lines -and `window-safe-min-width' columns. Any other non-nil value -means ignore all of the above restrictions for all windows. - -Optional argument TRAIL restricts the windows that can be enlarged. -If its value is `before', only windows to the left of or above WINDOW -can be enlarged. If it is `after', only windows to the right of or -below WINDOW can be enlarged. +The optional argument IGNORE has the same meaning as for +`window-resizable'. Optional argument TRAIL restricts the +windows that can be enlarged. If its value is `before', only +windows to the left of or above WINDOW can be enlarged. If it is +`after', only windows to the right of or below WINDOW can be +enlarged. Optional argument NOUP non-nil means don't go up in the window -tree, but try to enlarge windows within WINDOW's combination only. - -Optional argument NODOWN non-nil means don't check whether WINDOW -itself (and its child windows) can be shrunk; check only whether -at least one other window can be enlarged appropriately. +tree, but try to enlarge windows within WINDOW's combination +only. Optional argument NODOWN non-nil means don't check whether +WINDOW itself (and its child windows) can be shrunk; check only +whether at least one other window can be enlarged appropriately. Optional argument PIXELWISE non-nil means return number of pixels by which WINDOW can be shrunk." @@ -1480,6 +1604,20 @@ by which WINDOW can be shrunk." (window--min-delta-1 window (- size minimum) horizontal ignore trail noup pixelwise))))) +(defun frame-windows-min-size (&optional frame horizontal ignore pixelwise) + "Return minimum number of lines of FRAME's windows. +HORIZONTAL non-nil means return number of columns of FRAME's +windows. The optional argument IGNORE has the same meaning as +for `window-resizable'. PIXELWISE non-nil means return sizes in +pixels." + (setq frame (window-normalize-frame frame)) + (let* ((root (frame-root-window frame)) + (mini (window-next-sibling root))) + (+ (window-min-size root horizontal ignore pixelwise) + (if (and mini (not horizontal)) + (window-min-size mini horizontal nil pixelwise) + 0)))) + (defun window--max-delta-1 (window delta &optional horizontal ignore trail noup pixelwise) "Internal function of `window-max-delta'." (if (not (window-parent window)) @@ -1510,8 +1648,7 @@ by which WINDOW can be shrunk." ;; child window is fixed-size. (while sub (when (and (not (eq sub window)) - (not (window--size-ignore-p sub ignore)) - (window-size-fixed-p sub horizontal)) + (window-size-fixed-p sub horizontal ignore)) (throw 'fixed delta)) (setq sub (window-right sub)))) (if noup @@ -1530,32 +1667,24 @@ The return value is zero if WINDOW cannot be enlarged. Optional argument HORIZONTAL non-nil means return maximum number of columns by which WINDOW can be enlarged. -Optional argument IGNORE non-nil means ignore restrictions -imposed by fixed size windows, `window-min-height' or -`window-min-width' settings. If IGNORE is a window, ignore -restrictions for that window only. If IGNORE equals `safe', -live windows may get as small as `window-safe-min-height' lines -and `window-safe-min-width' columns. Any other non-nil value means -ignore all of the above restrictions for all windows. - -Optional argument TRAIL restricts the windows that can be enlarged. -If its value is `before', only windows to the left of or above WINDOW -can be enlarged. If it is `after', only windows to the right of or -below WINDOW can be enlarged. +The optional argument IGNORE has the same meaning as for +`window-resizable'. Optional argument TRAIL restricts the +windows that can be enlarged. If its value is `before', only +windows to the left of or above WINDOW can be enlarged. If it is +`after', only windows to the right of or below WINDOW can be +enlarged. Optional argument NOUP non-nil means don't go up in the window tree but try to obtain the entire space from windows within -WINDOW's combination. - -Optional argument NODOWN non-nil means do not check whether -WINDOW itself (and its child windows) can be enlarged; check -only whether other windows can be shrunk appropriately. +WINDOW's combination. Optional argument NODOWN non-nil means do +not check whether WINDOW itself (and its child windows) can be +enlarged; check only whether other windows can be shrunk +appropriately. Optional argument PIXELWISE non-nil means return number of pixels by which WINDOW can be enlarged." (setq window (window-normalize-window window)) - (if (and (not (window--size-ignore-p window ignore)) - (not nodown) (window-size-fixed-p window horizontal)) + (if (and (not nodown) (window-size-fixed-p window horizontal ignore)) ;; With IGNORE and NOWDON nil return zero if WINDOW has fixed ;; size. 0 @@ -1580,26 +1709,18 @@ columns. If WINDOW cannot be shrunk by -DELTA lines or columns, return the minimum value in the range DELTA..0 that can be used for shrinking WINDOW. -Optional argument IGNORE non-nil means ignore restrictions -imposed by fixed size windows, `window-min-height' or -`window-min-width' settings. If IGNORE is a window, ignore -restrictions for that window only. If IGNORE equals `safe', -live windows may get as small as `window-safe-min-height' lines -and `window-safe-min-width' columns. Any other non-nil value -means ignore all of the above restrictions for all windows. - -Optional argument TRAIL `before' means only windows to the left -of or below WINDOW can be shrunk. Optional argument TRAIL -`after' means only windows to the right of or above WINDOW can be -shrunk. +The optional argument IGNORE has the same meaning as for +`window-resizable'. Optional argument TRAIL `before' means only +windows to the left of or below WINDOW can be shrunk. Optional +argument TRAIL `after' means only windows to the right of or +above WINDOW can be shrunk. Optional argument NOUP non-nil means don't go up in the window tree but check only whether space can be obtained from (or given -to) WINDOW's siblings. - -Optional argument NODOWN non-nil means don't go down in the -window tree. This means do not check whether resizing would -violate size restrictions of WINDOW or its child windows. +to) WINDOW's siblings. Optional argument NODOWN non-nil means +don't go down in the window tree. This means do not check +whether resizing would violate size restrictions of WINDOW or its +child windows. Optional argument PIXELWISE non-nil means interpret DELTA as number of pixels." @@ -1649,13 +1770,14 @@ columns. If WINDOW cannot be shrunk by -DELTA lines or columns, return the minimum value in the range DELTA..0 that can be used for shrinking WINDOW. -Optional argument IGNORE non-nil means ignore restrictions -imposed by fixed size windows, `window-min-height' or -`window-min-width' settings. If IGNORE is a window, ignore -restrictions for that window only. If IGNORE equals `safe', -live windows may get as small as `window-safe-min-height' lines -and `window-safe-min-width' columns. Any other non-nil value -means ignore all of the above restrictions for all windows. +Optional argument IGNORE, if non-nil, means to ignore restraints +induced by fixed size windows or the values of the variables +`window-min-height' and `window-min-width'. The following values +have special meanings: `safe' means that in addition live windows +are allowed to get as small as `window-safe-min-height' lines and +`window-safe-min-width' columns. `preserved' means to ignore +only restrictions induced by `window-preserve-size'. If IGNORE +is a window, then ignore restrictions for that window only. Optional argument PIXELWISE non-nil means interpret DELTA as pixels." @@ -1680,9 +1802,6 @@ doc-string of `window-resizable'." (defalias 'window-height 'window-total-height) (defalias 'window-width 'window-body-width) -;; Eventually the following two should work pixelwise. - -;; See discussion in bug#4543. (defun window-full-height-p (&optional window) "Return t if WINDOW is as high as its containing frame. More precisely, return t if and only if the total height of @@ -1690,8 +1809,10 @@ WINDOW equals the total height of the root window of WINDOW's frame. WINDOW must be a valid window and defaults to the selected one." (setq window (window-normalize-window window)) - (= (window-pixel-height window) - (window-pixel-height (frame-root-window window)))) + (if (window-minibuffer-p window) + (eq window (frame-root-window (window-frame window))) + (= (window-pixel-height window) + (window-pixel-height (frame-root-window window))))) (defun window-full-width-p (&optional window) "Return t if WINDOW is as wide as its containing frame. @@ -1715,28 +1836,26 @@ optional argument PIXELWISE is passed to the functions." (window-body-height window pixelwise))) (defun window-current-scroll-bars (&optional window) - "Return the current scroll bar settings for WINDOW. + "Return the current scroll bar types for WINDOW. WINDOW must be a live window and defaults to the selected one. The return value is a cons cell (VERTICAL . HORIZONTAL) where VERTICAL specifies the current location of the vertical scroll -bars (`left', `right', or nil), and HORIZONTAL specifies the -current location of the horizontal scroll bars (`top', `bottom', -or nil). +bar (`left', `right' or nil), and HORIZONTAL specifies the +current location of the horizontal scroll bar (`bottom' or nil). Unlike `window-scroll-bars', this function reports the scroll bar type actually used, once frame defaults and `scroll-bar-mode' are taken into account." (setq window (window-normalize-window window t)) - (let ((vert (nth 2 (window-scroll-bars window))) - (hor nil)) - (when (or (eq vert t) (eq hor t)) - (let ((fcsb (frame-current-scroll-bars (window-frame window)))) - (if (eq vert t) - (setq vert (car fcsb))) - (if (eq hor t) - (setq hor (cdr fcsb))))) - (cons vert hor))) + (let ((vertical (nth 2 (window-scroll-bars window))) + (horizontal (nth 5 (window-scroll-bars window))) + (inherited (frame-current-scroll-bars (window-frame window)))) + (when (eq vertical t) + (setq vertical (car inherited))) + (when (eq horizontal t) + (setq horizontal (cdr inherited))) + (cons vertical (and horizontal 'bottom)))) (defun walk-windows (fun &optional minibuf all-frames) "Cycle through all live windows, calling FUN for each one. @@ -2357,13 +2476,14 @@ horizontally by DELTA columns. In this case a positive DELTA means enlarge WINDOW by DELTA columns. DELTA negative means WINDOW shall be shrunk by -DELTA columns. -Optional argument IGNORE non-nil means ignore restrictions -imposed by fixed size windows, `window-min-height' or -`window-min-width' settings. If IGNORE is a window, ignore -restrictions for that window only. If IGNORE equals `safe', -live windows may get as small as `window-safe-min-height' lines -and `window-safe-min-width' columns. Any other non-nil value -means ignore all of the above restrictions for all windows. +Optional argument IGNORE, if non-nil, means to ignore restraints +induced by fixed size windows or the values of the variables +`window-min-height' and `window-min-width'. The following values +have special meanings: `safe' means that in addition live windows +are allowed to get as small as `window-safe-min-height' lines and +`window-safe-min-width' columns. `preserved' means to ignore +only restrictions induced by `window-preserve-size'. If IGNORE +is a window, then ignore restrictions for that window only. Optional argument PIXELWISE non-nil means resize WINDOW by DELTA pixels. @@ -2394,8 +2514,12 @@ instead." ;; nil or the minibuffer window is active, resize the minibuffer ;; window. (window--resize-mini-window minibuffer-window (- delta))) - ((window--resizable-p - window delta horizontal ignore nil nil nil t) + ((or (window--resizable-p + window delta horizontal ignore nil nil nil t) + (and (not ignore) + (setq ignore 'preserved) + (window--resizable-p + window delta horizontal ignore nil nil nil t))) (window--resize-reset frame horizontal) (window--resize-this-window window delta horizontal ignore t) (if (and (not window-combination-resize) @@ -2553,13 +2677,8 @@ be a horizontally combined internal window. WINDOW, if specified, must denote a child window of PARENT that is resized by DELTA pixels. -Optional argument IGNORE non-nil means ignore restrictions -imposed by fixed size windows, `window-min-height' or -`window-min-width' settings. If IGNORE equals `safe', live -windows may get as small as `window-safe-min-height' lines and -`window-safe-min-width' columns. If IGNORE is a window, ignore -restrictions for that window only. Any other non-nil value means -ignore all of the above restrictions for all windows. +The optional argument IGNORE has the same meaning as for +`window-resizable'. Optional arguments TRAIL and EDGE, when non-nil, restrict the set of windows that shall be resized. If TRAIL equals `before', @@ -2630,7 +2749,7 @@ already set by this routine." ;; Ignore windows to skip and fixed-size child windows - ;; in the latter case make it a window to skip. (and (not ignore) - (window-size-fixed-p sub horizontal) + (window-size-fixed-p sub horizontal ignore) (set-window-new-normal sub 'ignore)))) ((< delta 0) ;; When shrinking store the number of lines/cols we can get @@ -2736,13 +2855,8 @@ Optional argument HORIZONTAL non-nil means resize other windows when WINDOW is resized horizontally by DELTA pixels. WINDOW itself is not resized by this function. -Optional argument IGNORE non-nil means ignore restrictions -imposed by fixed size windows, `window-min-height' or -`window-min-width' settings. If IGNORE equals `safe', live -windows may get as small as `window-safe-min-height' lines and -`window-safe-min-width' columns. If IGNORE is a window, ignore -restrictions for that window only. Any other non-nil value means -ignore all of the above restrictions for all windows. +The optional argument IGNORE has the same meaning as for +`window-resizable'. Optional arguments TRAIL and EDGE, when non-nil, refine the set of windows that shall be resized. If TRAIL equals `before', @@ -2769,8 +2883,7 @@ preferably only resize windows adjacent to EDGE." ;; Make sure this sibling is left alone when ;; resizing its siblings. (set-window-new-normal sub 'ignore)) - ((or (window--size-ignore-p sub ignore) - (not (window-size-fixed-p sub horizontal))) + ((not (window-size-fixed-p sub horizontal ignore)) ;; Set this-delta to t to signal that we found a sibling ;; of WINDOW whose size is not fixed. (setq this-delta t))) @@ -2840,16 +2953,9 @@ preferably only resize windows adjacent to EDGE." Optional argument HORIZONTAL non-nil means resize WINDOW horizontally by DELTA pixels. -Optional argument IGNORE non-nil means ignore restrictions -imposed by fixed size windows, `window-min-height' or -`window-min-width' settings. If IGNORE equals `safe', live -windows may get as small as `window-safe-min-height' lines and -`window-safe-min-width' columns. If IGNORE is a window, ignore -restrictions for that window only. Any other non-nil value -means ignore all of the above restrictions for all windows. - -Optional argument ADD non-nil means add DELTA to the new total -size of WINDOW. +The optional argument IGNORE has the same meaning as for +`window-resizable'. Optional argument ADD non-nil means add +DELTA to the new total size of WINDOW. Optional arguments TRAIL and EDGE, when non-nil, refine the set of windows that shall be resized. If TRAIL equals `before', @@ -2956,6 +3062,28 @@ routines." pixel-delta (/ pixel-delta (frame-char-height frame))))) +(defun window--sanitize-window-sizes (frame horizontal) + "Assert that all windows on FRAME are large enough. +If necessary and possible, make sure that every window on frame +FRAME has its minimum height. Optional argument HORIZONTAL +non-nil means to make sure that every window on frame FRAME has +its minimum width. The minimum height/width of a window is the +respective value returned by `window-min-size' for that window. + +Return t if all windows were resized appropriately. Return nil +if at least one window could not be resized as requested, which +may happen when the FRAME is not large enough to accommodate it." + (let ((value t)) + (walk-window-tree + (lambda (window) + (let ((delta (- (window-min-size window horizontal nil t) + (window-size window horizontal t)))) + (when (> delta 0) + (if (window-resizable-p window delta horizontal nil t) + (window-resize window delta horizontal nil t) + (setq value nil)))))) + value)) + (defun adjust-window-trailing-edge (window delta &optional horizontal pixelwise) "Move WINDOW's bottom edge by DELTA lines. Optional argument HORIZONTAL non-nil means move WINDOW's right @@ -2973,7 +3101,7 @@ move it as far as possible in the desired direction." (let* ((frame (window-frame window)) (minibuffer-window (minibuffer-window frame)) (right window) - left this-delta min-delta max-delta) + left this-delta min-delta max-delta ignore) (unless pixelwise (setq pixelwise t) @@ -2996,12 +3124,16 @@ move it as far as possible in the desired direction." (window--resize-mini-window minibuffer-window (- delta))) ((or (not (setq left right)) (not (setq right (window-right right)))) (if horizontal - (error "No window on the right of this one") - (error "No window below this one"))) + (user-error "No window on the right of this one") + (user-error "No window below this one"))) (t ;; Set LEFT to the first resizable window on the left. This step is ;; needed to handle fixed-size windows. - (while (and left (window-size-fixed-p left horizontal)) + (while (and left + (or (window-size-fixed-p left horizontal) + (and (< delta 0) + (<= (window-size left horizontal t) + (window-min-size left horizontal nil t))))) (setq left (or (window-left left) (progn @@ -3009,13 +3141,31 @@ move it as far as possible in the desired direction." (not (window-combined-p left horizontal)))) (window-left left))))) (unless left - (if horizontal - (error "No resizable window on the left of this one") - (error "No resizable window above this one"))) + (setq ignore 'preserved) + (setq left window) + (while (and left + (or (window-size-fixed-p left horizontal 'preserved) + (<= (window-size left horizontal t) + (window-min-size left horizontal 'preserved t)))) + (setq left + (or (window-left left) + (progn + (while (and (setq left (window-parent left)) + (not (window-combined-p left horizontal)))) + (window-left left))))) + + (unless left + (if horizontal + (user-error "No resizable window on the left of this one") + (user-error "No resizable window above this one")))) ;; Set RIGHT to the first resizable window on the right. This step ;; is needed to handle fixed-size windows. - (while (and right (window-size-fixed-p right horizontal)) + (while (and right + (or (window-size-fixed-p right horizontal) + (and (> delta 0) + (<= (window-size right horizontal t) + (window-min-size right horizontal 'preserved t))))) (setq right (or (window-right right) (progn @@ -3023,9 +3173,22 @@ move it as far as possible in the desired direction." (not (window-combined-p right horizontal)))) (window-right right))))) (unless right - (if horizontal - (error "No resizable window on the right of this one") - (error "No resizable window below this one"))) + (setq ignore 'preserved) + (setq right (window-right window)) + (while (and right + (or (window-size-fixed-p right horizontal 'preserved)) + (<= (window-size right horizontal t) + (window-min-size right horizontal nil t))) + (setq right + (or (window-right right) + (progn + (while (and (setq right (window-parent right)) + (not (window-combined-p right horizontal)))) + (window-right right))))) + (unless right + (if horizontal + (user-error "No resizable window on the right of this one") + (user-error "No resizable window below this one")))) ;; LEFT and RIGHT (which might be both internal windows) are now the ;; two windows we want to resize. @@ -3033,10 +3196,10 @@ move it as far as possible in the desired direction." ((> delta 0) (setq max-delta (window--max-delta-1 - left 0 horizontal nil 'after nil pixelwise)) + left 0 horizontal ignore 'after nil pixelwise)) (setq min-delta (window--min-delta-1 - right (- delta) horizontal nil 'before nil pixelwise)) + right (- delta) horizontal ignore 'before nil pixelwise)) (when (or (< max-delta delta) (> min-delta (- delta))) ;; We can't get the whole DELTA - move as far as possible. (setq delta (min max-delta (- min-delta)))) @@ -3045,26 +3208,26 @@ move it as far as possible in the desired direction." (window--resize-reset frame horizontal) ;; Try to enlarge LEFT first. (setq this-delta (window--resizable - left delta horizontal nil 'after nil nil pixelwise)) + left delta horizontal ignore 'after nil nil pixelwise)) (unless (zerop this-delta) (window--resize-this-window - left this-delta horizontal nil t 'before + left this-delta horizontal ignore t 'before (if horizontal (+ (window-pixel-left left) (window-pixel-width left)) (+ (window-pixel-top left) (window-pixel-height left))))) ;; Shrink windows on right of LEFT. (window--resize-siblings - left delta horizontal nil 'after + left delta horizontal ignore 'after (if horizontal (window-pixel-left right) (window-pixel-top right))))) ((< delta 0) (setq max-delta (window--max-delta-1 - right 0 horizontal nil 'before nil pixelwise)) + right 0 horizontal ignore 'before nil pixelwise)) (setq min-delta (window--min-delta-1 - left delta horizontal nil 'after nil pixelwise)) + left delta horizontal ignore 'after nil pixelwise)) (when (or (< max-delta (- delta)) (> min-delta delta)) ;; We can't get the whole DELTA - move as far as possible. (setq delta (max (- max-delta) min-delta))) @@ -3074,16 +3237,16 @@ move it as far as possible in the desired direction." ;; Try to enlarge RIGHT. (setq this-delta (window--resizable - right (- delta) horizontal nil 'before nil nil pixelwise)) + right (- delta) horizontal ignore 'before nil nil pixelwise)) (unless (zerop this-delta) (window--resize-this-window - right this-delta horizontal nil t 'after + right this-delta horizontal ignore t 'after (if horizontal (window-pixel-left right) (window-pixel-top right)))) ;; Shrink windows on left of RIGHT. (window--resize-siblings - right (- delta) horizontal nil 'before + right (- delta) horizontal ignore 'before (if horizontal (+ (window-pixel-left left) (window-pixel-width left)) (+ (window-pixel-top left) (window-pixel-height left))))))) @@ -3105,6 +3268,8 @@ make selected window wider by DELTA columns. If DELTA is negative, shrink selected window by -DELTA lines or columns." (interactive "p") (let ((minibuffer-window (minibuffer-window))) + (when (window-preserved-size nil horizontal) + (window-preserve-size nil horizontal)) (cond ((zerop delta)) ((window-size-fixed-p nil horizontal) @@ -3138,6 +3303,8 @@ negative, enlarge selected window by -DELTA lines or columns. Also see the `window-min-height' variable." (interactive "p") (let ((minibuffer-window (minibuffer-window))) + (when (window-preserved-size nil horizontal) + (window-preserve-size nil horizontal)) (cond ((zerop delta)) ((window-size-fixed-p nil horizontal) @@ -4213,20 +4380,6 @@ showing BUFFER-OR-NAME." ;; If a window doesn't show BUFFER, unrecord BUFFER in it. (unrecord-window-buffer window buffer))))) -;;; Splitting windows. -(defun window-split-min-size (&optional horizontal pixelwise) - "Return minimum height of any window when splitting windows. -Optional argument HORIZONTAL non-nil means return minimum width." - (cond - (pixelwise - (if horizontal - (window-min-pixel-width) - (window-min-pixel-height))) - (horizontal - (max window-min-width window-safe-min-width)) - (t - (max window-min-height window-safe-min-height)))) - (defun split-window (&optional window size side pixelwise) "Make a new window adjacent to WINDOW. WINDOW must be a valid window and defaults to the selected one. @@ -4290,7 +4443,10 @@ frame. The selected window is not changed by this function." (pixel-size (when (numberp size) (window--size-to-pixel window size horizontal pixelwise t))) - atom-root) + (divider-width (if horizontal + (frame-right-divider-width frame) + (frame-bottom-divider-width frame))) + atom-root ignore) (window--check frame) (catch 'done (cond @@ -4311,12 +4467,7 @@ frame. The selected window is not changed by this function." ;; side window, throw an error unless `window-combination-resize' ;; equals 'side. ((and (not (eq window-combination-resize 'side)) - (or (window-parameter window 'window-side) - (and (window-child window) - (or (window-parameter - (window-child window) 'window-side) - (window-parameter - (window-last-child window) 'window-side))))) + (window--side-window-p window)) (error "Cannot split side window or parent of side window")) ;; If `window-combination-resize' is 'side and window has a side ;; window sibling, bind `window-combination-limit' to t. @@ -4359,10 +4510,11 @@ frame. The selected window is not changed by this function." (if resize ;; When resizing try to give the new window the ;; average size of a window in its combination. - (min (- parent-pixel-size - (window-min-size parent horizontal nil t)) - (/ parent-pixel-size - (1+ (window-combinations parent horizontal)))) + (max (min (- parent-pixel-size + (window-min-size parent horizontal nil t)) + (/ parent-pixel-size + (1+ (window-combinations parent horizontal)))) + (window-min-pixel-size)) ;; Else try to give the new window half the size ;; of WINDOW (plus an eventual odd pixel). (/ old-pixel-size 2))) @@ -4391,19 +4543,22 @@ frame. The selected window is not changed by this function." (cond (resize ;; SIZE unspecified, resizing. - (when (and (not (window-sizable-p - parent (- new-pixel-size) horizontal nil t)) - ;; Try again with minimum split size. - (setq new-pixel-size - (max new-pixel-size - (window-split-min-size horizontal t))) - (not (window-sizable-p - parent (- new-pixel-size) horizontal nil t))) - (error "Window %s too small for splitting 1" parent))) - ((> (+ new-pixel-size (window-min-size window horizontal nil t)) - old-pixel-size) + (unless (or (window-sizable-p + parent (- (+ new-pixel-size divider-width)) horizontal + nil t) + (window-sizable-p + parent (- (+ new-pixel-size divider-width)) horizontal + (setq ignore 'preserved) t)) + (error "Window %s too small for splitting (1)" parent))) + ((and (> (+ new-pixel-size divider-width + (window-min-size window horizontal nil t)) + old-pixel-size) + (> (+ new-pixel-size divider-width + (window-min-size + window horizontal (setq ignore 'preserved) t)) + old-pixel-size)) ;; SIZE unspecified, no resizing. - (error "Window %s too small for splitting 2" window)))) + (error "Window %s too small for splitting (2)" window)))) ((and (>= pixel-size 0) (or (>= pixel-size old-pixel-size) (< new-pixel-size @@ -4411,19 +4566,23 @@ frame. The selected window is not changed by this function." ;; SIZE specified as new size of old window. If the new size ;; is larger than the old size or the size of the new window ;; would be less than the safe minimum, signal an error. - (error "Window %s too small for splitting 3" window)) + (error "Window %s too small for splitting (3)" window)) (resize ;; SIZE specified, resizing. - (unless (window-sizable-p - parent (- new-pixel-size) horizontal nil t) + (unless (or (window-sizable-p + parent (- (+ new-pixel-size divider-width)) horizontal + nil t) + (window-sizable-p + parent (- (+ new-pixel-size divider-width)) horizontal + (setq ignore 'preserved) t)) ;; If we cannot resize the parent give up. - (error "Window %s too small for splitting 4" parent))) + (error "Window %s too small for splitting (4)" parent))) ((or (< new-pixel-size (window-safe-min-pixel-size window horizontal)) (< (- old-pixel-size new-pixel-size) (window-safe-min-pixel-size window horizontal))) ;; SIZE specification violates minimum size restrictions. - (error "Window %s too small for splitting 5" window))) + (error "Window %s too small for splitting (5)" window))) (window--resize-reset frame horizontal) @@ -4449,7 +4608,7 @@ frame. The selected window is not changed by this function." ;; delete the one we create here. Hence we do not go up. (progn (window--resize-child-windows - parent (- new-pixel-size) horizontal) + parent (- new-pixel-size) horizontal nil ignore) (let* ((normal (- 1.0 new-normal)) (sub (window-child parent))) (while sub @@ -4459,10 +4618,8 @@ frame. The selected window is not changed by this function." ;; Get entire space from WINDOW. (set-window-new-pixel window (- old-pixel-size new-pixel-size)) -;; (set-window-new-pixel window (- old-pixel-size new-pixel-size)) -;; (set-window-new-total -;; window (- old-size new-size)) - (window--resize-this-window window (- new-pixel-size) horizontal) + (window--resize-this-window + window (- new-pixel-size) horizontal ignore) (set-window-new-normal window (- (if new-parent 1.0 (window-normal-size window horizontal)) new-normal))) @@ -4494,6 +4651,9 @@ frame. The selected window is not changed by this function." (set-window-parameter (window-parent new) 'window-atom t)) (set-window-parameter new 'window-atom t))) + ;; Sanitize sizes. + (window--sanitize-window-sizes frame horizontal) + (run-window-configuration-change-hook frame) (run-window-scroll-functions new) (window--check frame) @@ -4513,7 +4673,7 @@ the original point in both windows." (defun split-window-below (&optional size) "Split the selected window into two windows, one above the other. The selected window is above. The newly split-off window is -below, and displays the same buffer. Return the new window. +below and displays the same buffer. Return the new window. If optional argument SIZE is omitted or nil, both windows get the same height, or close to it. If SIZE is positive, the upper @@ -4567,7 +4727,7 @@ amount of redisplay; this is convenient on slow terminals." (defun split-window-right (&optional size) "Split the selected window into two side-by-side windows. The selected window is on the left. The newly split-off window -is on the right, and displays the same buffer. Return the new +is on the right and displays the same buffer. Return the new window. If optional argument SIZE is omitted or nil, both windows get the @@ -5065,7 +5225,7 @@ value can be also stored on disk and read back in a new session." (let ((scroll-bars (cdr (assq 'scroll-bars state)))) (set-window-scroll-bars window (car scroll-bars) (nth 2 scroll-bars) - (nth 3 scroll-bars))) + (nth 3 scroll-bars) (nth 5 scroll-bars))) (set-window-vscroll window (cdr (assq 'vscroll state))) ;; Adjust vertically. (if (memq window-size-fixed '(t height)) @@ -5733,7 +5893,7 @@ hold: wide as `split-width-threshold'. - When WINDOW is split evenly, the emanating windows are at least `window-min-width' or two (whichever is larger) columns wide." - (when (window-live-p window) + (when (and (window-live-p window) (not (window--side-window-p window))) (with-current-buffer (window-buffer window) (if horizontal ;; A window can be split horizontally when its width is not @@ -5901,7 +6061,8 @@ live." (let ((parameter (window-parameter window 'quit-restore)) (height (cdr (assq 'window-height alist))) (width (cdr (assq 'window-width alist))) - (size (cdr (assq 'window-size alist)))) + (size (cdr (assq 'window-size alist))) + (preserve-size (cdr (assq 'preserve-size alist)))) (cond ((or (eq type 'frame) (and (eq (car parameter) 'same) @@ -5956,7 +6117,11 @@ live." (window-combined-p window t)) (window-resize window delta t 'safe)))) ((functionp width) - (ignore-errors (funcall width window))))))) + (ignore-errors (funcall width window)))) + ;; Preserve window size if asked for. + (when (consp preserve-size) + (window-preserve-size window t (car preserve-size)) + (window-preserve-size window nil (cdr preserve-size)))))) window)) @@ -5989,6 +6154,8 @@ The actual non-nil value of this variable will be copied to the (const display-buffer-pop-up-window) (const display-buffer-same-window) (const display-buffer-pop-up-frame) + (const display-buffer-below-selected) + (const display-buffer-at-bottom) (const display-buffer-in-previous-window) (const display-buffer-use-some-window) (function :tag "Other function")) @@ -6173,6 +6340,10 @@ Recognized alist entries include: of not displaying the buffer and FUNCTION can safely return a non-window value to suppress displaying. + `preserve-size' -- Value should be either '(t . nil)' to + preserve the width of the window, '(nil . t)' to preserve its + height or '(t . t)' to preserve both. + The ACTION argument to `display-buffer' can also have a non-nil and non-list value. This means to display the buffer in a window other than the selected one, even if it is already displayed in @@ -6398,13 +6569,26 @@ the selected one." (defun display-buffer-at-bottom (buffer alist) "Try displaying BUFFER in a window at the bottom of the selected frame. -This either splits the window at the bottom of the frame or the -frame's root window, or reuses an existing window at the bottom -of the selected frame." - (let (bottom-window window) +This either reuses such a window provided it shows BUFFER +already, splits a window at the bottom of the frame or the +frame's root window, or reuses some window at the bottom of the +selected frame." + (let (bottom-window bottom-window-shows-buffer window) (walk-window-tree - (lambda (window) (setq bottom-window window)) nil nil 'nomini) - (or (and (not (frame-parameter nil 'unsplittable)) + (lambda (window) + (cond + ((window-in-direction 'below window)) + ((and (not bottom-window-shows-buffer) + (eq buffer (window-buffer window))) + (setq bottom-window-shows-buffer t) + (setq bottom-window window)) + ((not bottom-window) + (setq bottom-window window))) + nil nil 'nomini)) + (or (and bottom-window-shows-buffer + (window--display-buffer + buffer bottom-window 'reuse alist display-buffer-mark-dedicated)) + (and (not (frame-parameter nil 'unsplittable)) (let (split-width-threshold) (setq window (window--try-to-split-window bottom-window alist))) (window--display-buffer @@ -7089,7 +7273,10 @@ FRAME." (value (window-text-pixel-size nil t t workarea-width workarea-height t)) (width (+ (car value) (window-right-divider-width))) - (height (+ (cdr value) (window-bottom-divider-width)))) + (height + (+ (cdr value) + (window-bottom-divider-width) + (window-scroll-bar-height)))) ;; Don't change height or width when the window's size is fixed ;; in either direction or ONLY forbids it. (cond @@ -7158,7 +7345,7 @@ FRAME." (frame-text-height)) frame-resize-pixelwise))))) -(defun fit-window-to-buffer (&optional window max-height min-height max-width min-width) +(defun fit-window-to-buffer (&optional window max-height min-height max-width min-width preserve-size) "Adjust size of WINDOW to display its buffer's contents exactly. WINDOW must be a live window and defaults to the selected one. @@ -7182,6 +7369,9 @@ and defaults to `window-min-width'. Both MAX-WIDTH and MIN-WIDTH are specified in columns and include fringes, margins, a scrollbar and a vertical divider, if any. +If the optional argument `preserve-size' is non-nil, preserve the +size of WINDOW (see `window-preserve-size'). + Fit pixelwise if the option `window-resize-pixelwise' is non-nil. If WINDOW is its frame's root window and the option `fit-frame-to-buffer' is non-nil, call `fit-frame-to-buffer' to @@ -7223,44 +7413,48 @@ accessible position." (max (if pixelwise (* char-height window-min-height) window-min-height) - (window-min-size nil nil t pixelwise)))) + (window-min-size window nil window pixelwise)))) (max-height ;; Sanitize MAX-HEIGHT. (if (numberp max-height) (min (+ total-height (window-max-delta - window nil nil nil nil nil pixelwise)) + window nil window nil nil nil pixelwise)) (if pixelwise (* char-height max-height) max-height)) (+ total-height (window-max-delta - window nil nil nil nil nil pixelwise)))) + window nil window nil nil nil pixelwise)))) height) (cond ;; If WINDOW is vertically combined, try to resize it ;; vertically. ((and (not (eq fit-window-to-buffer-horizontally 'only)) - (not (window-size-fixed-p window)) + (not (window-size-fixed-p window 'preserved)) (window-combined-p)) ;; Vertically we always want to fit the entire buffer. ;; WINDOW'S height can't get larger than its frame's pixel ;; height. Its width remains fixed. (setq height (+ (cdr (window-text-pixel-size nil nil t nil (frame-pixel-height) t)) + (window-scroll-bar-height window) (window-bottom-divider-width))) ;; Round height. (unless pixelwise (setq height (/ (+ height char-height -1) char-height))) (unless (= height total-height) + (window-preserve-size window) (window-resize-no-error window (- (max min-height (min max-height height)) total-height) - nil window pixelwise))) + nil window pixelwise) + (when preserve-size + (window-preserve-size window nil t)))) ;; If WINDOW is horizontally combined, try to resize it ;; horizontally. ((and fit-window-to-buffer-horizontally - (not (window-size-fixed-p window t)) + (not (window-size-fixed-p window t 'preserved)) (window-combined-p nil t)) (let* ((total-width (window-size window t pixelwise)) (min-width @@ -7277,18 +7471,18 @@ accessible position." (max (if pixelwise (* char-width window-min-width) window-min-width) - (window-min-size nil nil t pixelwise)))) + (window-min-size nil nil window pixelwise)))) (max-width ;; Sanitize MAX-WIDTH. (if (numberp max-width) (min (+ total-width (window-max-delta - nil t nil nil nil nil pixelwise)) + window t window nil nil nil pixelwise)) (if pixelwise (* char-width max-width) max-width)) (+ total-width (window-max-delta - nil t nil nil nil nil pixelwise)))) + window t window nil nil nil pixelwise)))) ;; When fitting horizontally, assume that WINDOW's ;; start position remains unaltered. WINDOW can't get ;; wider than its frame's pixel width, its height @@ -7306,13 +7500,16 @@ accessible position." (unless pixelwise (setq width (/ (+ width char-width -1) char-width))) (unless (= width body-width) + (window-preserve-size window t) (window-resize-no-error window (- (max min-width (min max-width (+ total-width (- width body-width)))) total-width) - t window pixelwise))))))))) + t window pixelwise) + (when preserve-size + (window-preserve-size window t t)))))))))) (defun window-safely-shrinkable-p (&optional window) "Return t if WINDOW can be shrunk without shrinking other windows. @@ -7606,6 +7803,9 @@ With arg N, put point N/10 of the way from the true end." (defvar mouse-autoselect-window-timer nil "Timer used by delayed window autoselection.") +(defvar mouse-autoselect-window-position-1 nil + "First mouse position recorded by delayed window autoselection.") + (defvar mouse-autoselect-window-position nil "Last mouse position recorded by delayed window autoselection.") @@ -7630,6 +7830,7 @@ Optional argument FORCE means cancel unconditionally." (memq (nth 4 (event-end last-input-event)) '(handle end-scroll))))) (setq mouse-autoselect-window-state nil) + (setq mouse-autoselect-window-position-1 nil) (when (timerp mouse-autoselect-window-timer) (cancel-timer mouse-autoselect-window-timer)) (remove-hook 'pre-command-hook 'mouse-autoselect-window-cancel))) @@ -7671,21 +7872,32 @@ is active. This function is run by `mouse-autoselect-window-timer'." ;; A menu / popup dialog is active or the mouse is not on the ;; text region of WINDOW: Suspend autoselection temporarily. (mouse-autoselect-window-start mouse-position nil t)) - ((eq mouse-autoselect-window-state 'suspend) + ((or (eq mouse-autoselect-window-state 'suspend) + ;; When the mouse is at its first recorded position, restart + ;; delayed autoselection. This works around a scenario with + ;; two two-window frames with identical dimensions: select the + ;; first window of the first frame, switch to the second + ;; frame, move the mouse to its second window, minimize the + ;; second frame. Now the second window of the first frame + ;; gets selected although the mouse never really "moved" into + ;; that window. + (and (numberp mouse-autoselect-window) + (equal (mouse-position) mouse-autoselect-window-position-1))) ;; Delayed autoselection was temporarily suspended, reenable it. (mouse-autoselect-window-start mouse-position)) ((and window (not (eq window (selected-window))) (or (not (numberp mouse-autoselect-window)) - (and (> mouse-autoselect-window 0) - ;; If `mouse-autoselect-window' is positive, select - ;; window if the window is the same as before. + (and (>= mouse-autoselect-window 0) + ;; If `mouse-autoselect-window' is non-negative, + ;; select window if it's the same as before. (eq window mouse-autoselect-window-window)) - ;; Otherwise select window if the mouse is at the same - ;; position as before. Observe that the first test after - ;; starting autoselection usually fails since the value of - ;; `mouse-autoselect-window-position' recorded there is the - ;; position where the mouse has entered the new window and - ;; not necessarily where the mouse has stopped moving. + ;; Otherwise select window iff the mouse is at the same + ;; position as before. Observe that the first test + ;; after starting autoselection usually fails since the + ;; value of `mouse-autoselect-window-position' recorded + ;; there is the position where the mouse has entered the + ;; new window and not necessarily where the mouse has + ;; stopped moving. (equal mouse-position mouse-autoselect-window-position)) ;; The minibuffer is a candidate window if it's active. (or (not (window-minibuffer-p window)) @@ -7729,14 +7941,14 @@ is active. This function is run by `mouse-autoselect-window-timer'." (not (minibuffer-window-active-p window))) ;; Don't switch when autoselection shall be delayed. (and (numberp mouse-autoselect-window) - (not (zerop mouse-autoselect-window)) (not (eq mouse-autoselect-window-state 'select)) - (progn + (let ((position (mouse-position))) ;; Cancel any delayed autoselection. (mouse-autoselect-window-cancel t) ;; Start delayed autoselection from current mouse ;; position and window. - (mouse-autoselect-window-start (mouse-position) window) + (setq mouse-autoselect-window-position-1 position) + (mouse-autoselect-window-start position window) ;; Executing a command cancels delayed autoselection. (add-hook 'pre-command-hook 'mouse-autoselect-window-cancel)))) diff --git a/lisp/winner.el b/lisp/winner.el index 8644501265d..f244003b066 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -112,10 +112,7 @@ You may want to include buffer names such as *Help*, *Apropos*, ;; Save current configuration. ;; (Called below by `winner-save-old-configurations'). (defun winner-remember () - (let ((entry (assq (selected-frame) winner-currents))) - (if entry (setcdr entry (winner-conf)) - (push (cons (selected-frame) (winner-conf)) - winner-currents)))) + (setf (alist-get (selected-frame) winner-currents) (winner-conf))) ;; Consult `winner-currents'. (defun winner-configuration (&optional frame) diff --git a/lisp/woman.el b/lisp/woman.el index 462efe11a63..611ba743652 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -414,18 +414,12 @@ (substring arg 0 (match-end 1)) arg)))) +(require 'cl-lib) + (eval-when-compile ; to avoid compiler warnings (require 'dired) - (require 'cl-lib) (require 'apropos)) -(defun woman-mapcan (fn x) - "Return concatenated list of FN applied to successive `car' elements of X. -FN must return a list, cons or nil. Useful for splicing into a list." - ;; Based on the Standard Lisp function MAPCAN but with args swapped! - ;; More concise implementation than the recursive one. -- dak - (apply #'nconc (mapcar fn x))) - (defun woman-parse-colon-path (paths) "Explode search path string PATHS into a list of directory names. Allow Cygwin colon-separated search paths on Microsoft platforms. @@ -440,7 +434,7 @@ As a special case, if PATHS is nil then replace it by calling (mapcar 'woman-Cyg-to-Win (woman-parse-man.conf))) ((string-match-p ";" paths) ;; Assume DOS-style path-list... - (woman-mapcan ; splice list into list + (cl-mapcan ; splice list into list (lambda (x) (if x (list x) @@ -451,14 +445,14 @@ As a special case, if PATHS is nil then replace it by calling (list paths)) (t ;; Assume UNIX/Cygwin-style path-list... - (woman-mapcan ; splice list into list + (cl-mapcan ; splice list into list (lambda (x) (mapcar 'woman-Cyg-to-Win (if x (list x) (woman-parse-man.conf)))) (let ((path-separator ":")) (parse-colon-path paths))))) ;; Assume host-default-style path-list... - (woman-mapcan ; splice list into list + (cl-mapcan ; splice list into list (lambda (x) (if x (list x) (woman-parse-man.conf))) (parse-colon-path (or paths ""))))) diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index ce2ca70b357..b87c1a28937 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -42,14 +42,6 @@ (defvar xterm-mouse-debug-buffer nil) -(defvar xterm-mouse-last) - -;; Mouse events symbols must have an 'event-kind property with -;; the value 'mouse-click. -(dolist (event-type '(mouse-1 mouse-2 mouse-3 - M-down-mouse-1 M-down-mouse-2 M-down-mouse-3)) - (put event-type 'event-kind 'mouse-click)) - (defun xterm-mouse-translate (_event) "Read a click and release event from XTerm." (xterm-mouse-translate-1)) @@ -63,61 +55,48 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." (defun xterm-mouse-translate-1 (&optional extension) (save-excursion - (save-window-excursion ;FIXME: Why? - (deactivate-mark) ;FIXME: Why? - (let* ((xterm-mouse-last nil) - (down (xterm-mouse-event extension)) - (down-command (nth 0 down)) - (down-data (nth 1 down)) - (down-where (nth 1 down-data)) - (down-binding (key-binding (if (symbolp down-where) - (vector down-where down-command) - (vector down-command)))) - (is-down (string-match "down" (symbol-name (car down))))) - - ;; Retrieve the expected preface for the up-event. - (when is-down - (unless (cond ((null extension) - (and (eq (read-event) ?\e) - (eq (read-event) ?\[) - (eq (read-event) ?M))) - ((eq extension 1006) - (and (eq (read-event) ?\e) - (eq (read-event) ?\[) - (eq (read-event) ?<)))) - (error "Unexpected escape sequence from XTerm"))) - - ;; Process the up-event. - (let* ((click (if is-down (xterm-mouse-event extension) down)) - (click-data (nth 1 click)) - (click-where (nth 1 click-data))) - (cond - ((null down) nil) - ((memq down-binding '(nil ignore)) - (if (and (symbolp click-where) - (consp click-where)) - (vector (list click-where click-data) click) - (vector click))) + (let* ((event (xterm-mouse-event extension)) + (ev-command (nth 0 event)) + (ev-data (nth 1 event)) + (ev-where (nth 1 ev-data)) + (vec (vector event)) + (is-down (string-match "down-" (symbol-name ev-command)))) + + ;; Mouse events symbols must have an 'event-kind property with + ;; the value 'mouse-click. + (when ev-command (put ev-command 'event-kind 'mouse-click)) + + (cond + ((null event) nil) ;Unknown/bogus byte sequence! + (is-down + (setf (terminal-parameter nil 'xterm-mouse-last-down) event) + vec) + (t + (let* ((down (terminal-parameter nil 'xterm-mouse-last-down)) + (down-data (nth 1 down)) + (down-where (nth 1 down-data))) + (setf (terminal-parameter nil 'xterm-mouse-last-down) nil) + (cond + ((null down) + ;; This is an "up-only" event. Pretend there was an up-event + ;; right before and keep the up-event for later. + (push event unread-command-events) + (vector (cons (intern (replace-regexp-in-string + "\\`\\([ACMHSs]-\\)*" "\\&down-" + (symbol-name ev-command) t)) + (cdr event)))) + ((equal ev-where down-where) vec) (t - (setq unread-command-events - (append (if (eq down-where click-where) - (list click) - (list - ;; Cheat `mouse-drag-region' with move event. - (list 'mouse-movement click-data) - ;; Generate a drag event. - (if (symbolp down-where) - 0 - (list (intern (format "drag-mouse-%d" - (1+ xterm-mouse-last))) - down-data click-data)))) - unread-command-events)) - (if xterm-mouse-debug-buffer - (print unread-command-events xterm-mouse-debug-buffer)) - (if (and (symbolp down-where) - (consp down-where)) - (vector (list down-where down-data) down) - (vector down))))))))) + (let ((drag (if (symbolp ev-where) + 0 ;FIXME: Why?!? + (list (intern (replace-regexp-in-string + "\\`\\([ACMHSs]-\\)*" "\\&drag-" + (symbol-name ev-command) t)) + down-data ev-data)))) + (if (null track-mouse) + (vector drag) + (push drag unread-command-events) + (vector (list 'mouse-movement ev-data)))))))))))) ;; These two variables have been converted to terminal parameters. ;; @@ -158,23 +137,21 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." (defun xterm-mouse--read-event-sequence-1000 () (let* ((code (- (read-event) 32)) (type - ;; For buttons > 3, the release-event looks differently - ;; (see xc/programs/xterm/button.c, function EditorButton), - ;; and come in a release-event only, no down-event. - (cond ((>= code 64) - (format "mouse-%d" (- code 60))) - ((memq code '(8 9 10)) - (setq xterm-mouse-last (- code 8)) - (format "M-down-mouse-%d" (- code 7))) - ((and (= code 11) xterm-mouse-last) - (format "M-mouse-%d" (1+ xterm-mouse-last))) - ((and (= code 3) xterm-mouse-last) - ;; For buttons > 5 xterm only reports a button-release event. - ;; Drop them since they're not usable and can be spurious. - (format "mouse-%d" (1+ xterm-mouse-last))) - ((memq code '(0 1 2)) - (setq xterm-mouse-last code) - (format "down-mouse-%d" (+ 1 code))))) + ;; For buttons > 3, the release-event looks differently + ;; (see xc/programs/xterm/button.c, function EditorButton), + ;; and come in a release-event only, no down-event. + (cond ((>= code 64) + (format "mouse-%d" (- code 60))) + ((memq code '(8 9 10)) + (format "M-down-mouse-%d" (- code 7))) + ((memq code '(3 11)) + (let ((down (car (terminal-parameter + nil 'xterm-mouse-last-down)))) + (when (and down (string-match "[0-9]" (symbol-name down))) + (format (if (eq code 3) "mouse-%s" "M-mouse-%s") + (match-string 0 (symbol-name down)))))) + ((memq code '(0 1 2)) + (format "down-mouse-%d" (+ 1 code))))) (x (- (read-event) 33)) (y (- (read-event) 33))) (and type (wholenump x) (wholenump y) @@ -211,10 +188,20 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." (if down "down-" "") (if wheel (- code 60) - (1+ (setq xterm-mouse-last (mod code 4))))))) + (1+ (mod code 4)))))) (1- (string-to-number (apply 'string (nreverse x-bytes)))) (1- (string-to-number (apply 'string (nreverse y-bytes))))))) +(defun xterm-mouse--set-click-count (event click-count) + (setcdr (cdr event) (list click-count)) + (let ((name (symbol-name (car event)))) + (when (string-match "\\(.*?\\)\\(\\(?:down-\\)?mouse-.*\\)" name) + (setcar event + (intern (concat (match-string 1 name) + (if (= click-count 2) + "double-" "triple-") + (match-string 2 name))))))) + (defun xterm-mouse-event (&optional extension) "Convert XTerm mouse event to Emacs mouse event. EXTENSION, if non-nil, means to use an extension to the usual @@ -240,18 +227,42 @@ which is the \"1006\" extension implemented in Xterm >= 277." (w (window-at x y)) (ltrb (window-edges w)) (left (nth 0 ltrb)) - (top (nth 1 ltrb))) - (set-terminal-parameter nil 'xterm-mouse-x x) - (set-terminal-parameter nil 'xterm-mouse-y y) - (setq - last-input-event - (list type - (let ((event (if w + (top (nth 1 ltrb)) + (posn (if w (posn-at-x-y (- x left) (- y top) w t) (append (list nil 'menu-bar) - (nthcdr 2 (posn-at-x-y x y)))))) - (setcar (nthcdr 3 event) timestamp) - event))))))) + (nthcdr 2 (posn-at-x-y x y))))) + (event (list type posn))) + (setcar (nthcdr 3 posn) timestamp) + + ;; Try to handle double/triple clicks. + (let* ((last-click (terminal-parameter nil 'xterm-mouse-last-click)) + (last-type (nth 0 last-click)) + (last-name (symbol-name last-type)) + (last-time (nth 1 last-click)) + (click-count (nth 2 last-click)) + (this-time (float-time)) + (name (symbol-name type))) + (cond + ((not (string-match "down-" name)) + ;; For up events, make the up side match the down side. + (setq this-time last-time) + (when (and click-count (> click-count 1) + (string-match "down-" last-name) + (equal name (replace-match "" t t last-name))) + (xterm-mouse--set-click-count event click-count))) + ((not last-time) nil) + ((and (> double-click-time (* 1000 (- this-time last-time))) + (equal last-name (replace-match "" t t name))) + (setq click-count (1+ click-count)) + (xterm-mouse--set-click-count event click-count)) + (t (setq click-count 1))) + (set-terminal-parameter nil 'xterm-mouse-last-click + (list type this-time click-count))) + + (set-terminal-parameter nil 'xterm-mouse-x x) + (set-terminal-parameter nil 'xterm-mouse-y y) + (setq last-input-event event))))) ;;;###autoload (define-minor-mode xterm-mouse-mode @@ -267,69 +278,79 @@ single clicks are supported. When turned on, the normal xterm mouse functionality for such clicks is still available by holding down the SHIFT key while pressing the mouse button." :global t :group 'mouse - (let ((do-hook (if xterm-mouse-mode 'add-hook 'remove-hook))) - (funcall do-hook 'terminal-init-xterm-hook - 'turn-on-xterm-mouse-tracking-on-terminal) - (funcall do-hook 'delete-terminal-functions - 'turn-off-xterm-mouse-tracking-on-terminal) - (funcall do-hook 'suspend-tty-functions - 'turn-off-xterm-mouse-tracking-on-terminal) - (funcall do-hook 'resume-tty-functions - 'turn-on-xterm-mouse-tracking-on-terminal) - (funcall do-hook 'suspend-hook 'turn-off-xterm-mouse-tracking) - (funcall do-hook 'suspend-resume-hook 'turn-on-xterm-mouse-tracking) - (funcall do-hook 'kill-emacs-hook 'turn-off-xterm-mouse-tracking)) + (funcall (if xterm-mouse-mode 'add-hook 'remove-hook) + 'terminal-init-xterm-hook + 'turn-on-xterm-mouse-tracking-on-terminal) (if xterm-mouse-mode ;; Turn it on (progn (setq mouse-position-function #'xterm-mouse-position-function) - (turn-on-xterm-mouse-tracking)) + (mapc #'turn-on-xterm-mouse-tracking-on-terminal (terminal-list))) ;; Turn it off - (turn-off-xterm-mouse-tracking 'force) + (mapc #'turn-off-xterm-mouse-tracking-on-terminal (terminal-list)) (setq mouse-position-function nil))) -(defun turn-on-xterm-mouse-tracking () - "Enable Emacs mouse tracking in xterm." - (dolist (terminal (terminal-list)) - (turn-on-xterm-mouse-tracking-on-terminal terminal))) +(defconst xterm-mouse-tracking-enable-sequence + "\e[?1000h\e[?1006h" + "Control sequence to enable xterm mouse tracking. +Enables basic tracking, then extended tracking on +terminals that support it.") -(defun turn-off-xterm-mouse-tracking (&optional _force) - "Disable Emacs mouse tracking in xterm." - (dolist (terminal (terminal-list)) - (turn-off-xterm-mouse-tracking-on-terminal terminal))) +(defconst xterm-mouse-tracking-disable-sequence + "\e[?1006l\e[?1000l" + "Reset the modes set by `xterm-mouse-tracking-enable-sequence'.") (defun turn-on-xterm-mouse-tracking-on-terminal (&optional terminal) "Enable xterm mouse tracking on TERMINAL." (when (and xterm-mouse-mode (eq t (terminal-live-p terminal)) ;; Avoid the initial terminal which is not a termcap device. - ;; FIXME: is there more elegant way to detect the initial terminal? + ;; FIXME: is there more elegant way to detect the initial + ;; terminal? (not (string= (terminal-name terminal) "initial_terminal"))) (unless (terminal-parameter terminal 'xterm-mouse-mode) ;; Simulate selecting a terminal by selecting one of its frames + ;; so that we can set the terminal-local `input-decode-map'. (with-selected-frame (car (frames-on-display-list terminal)) (define-key input-decode-map "\e[M" 'xterm-mouse-translate) (define-key input-decode-map "\e[<" 'xterm-mouse-translate-extended)) - (set-terminal-parameter terminal 'xterm-mouse-mode t)) - (send-string-to-terminal "\e[?1000h" terminal) - ;; Request extended mouse support, if available (xterm >= 277). - (send-string-to-terminal "\e[?1006h" terminal))) + (condition-case err + (send-string-to-terminal xterm-mouse-tracking-enable-sequence + terminal) + ;; FIXME: This should use a dedicated error signal. + (error (if (equal (cadr err) "Terminal is currently suspended") + nil ;The sequence will be sent upon resume. + (signal (car err) (cdr err))))) + (push xterm-mouse-tracking-enable-sequence + (terminal-parameter nil 'tty-mode-set-strings)) + (push xterm-mouse-tracking-disable-sequence + (terminal-parameter nil 'tty-mode-reset-strings)) + (set-terminal-parameter terminal 'xterm-mouse-mode t)))) (defun turn-off-xterm-mouse-tracking-on-terminal (terminal) "Disable xterm mouse tracking on TERMINAL." ;; Only send the disable command to those terminals to which we've already ;; sent the enable command. (when (and (terminal-parameter terminal 'xterm-mouse-mode) - (eq t (terminal-live-p terminal)) - ;; Avoid the initial terminal which is not a termcap device. - ;; FIXME: is there more elegant way to detect the initial terminal? - (not (string= (terminal-name terminal) "initial_terminal"))) + (eq t (terminal-live-p terminal))) ;; We could remove the key-binding and unset the `xterm-mouse-mode' ;; terminal parameter, but it seems less harmful to send this escape ;; command too many times (or to catch an unintended key sequence), than ;; to send it too few times (or to fail to let xterm-mouse events ;; pass by untranslated). - (send-string-to-terminal "\e[?1000l" terminal) - (send-string-to-terminal "\e[?1006l" terminal))) + (condition-case err + (send-string-to-terminal xterm-mouse-tracking-disable-sequence + terminal) + ;; FIXME: This should use a dedicated error signal. + (error (if (equal (cadr err) "Terminal is currently suspended") + nil + (signal (car err) (cdr err))))) + (setf (terminal-parameter nil 'tty-mode-set-strings) + (remq xterm-mouse-tracking-enable-sequence + (terminal-parameter nil 'tty-mode-set-strings))) + (setf (terminal-parameter nil 'tty-mode-reset-strings) + (remq xterm-mouse-tracking-disable-sequence + (terminal-parameter nil 'tty-mode-reset-strings))) + (set-terminal-parameter terminal 'xterm-mouse-mode nil))) (provide 'xt-mouse) |